diff options
452 files changed, 14810 insertions, 6281 deletions
diff --git a/INSTALL.md b/INSTALL.md index 1061c5187a..24053b4793 100644 --- a/INSTALL.md +++ b/INSTALL.md @@ -27,7 +27,7 @@ on Unix. For detailed instructions on how to Binary releases for Windows can be found at <http://www.erlang.org/download.html>. -Before reading the above mensioned documents you are in any case advised to +Before reading the above mentioned documents you are in any case advised to read this document first, since it covers building Erlang/OTP in general as well as other important information. @@ -424,7 +424,7 @@ as before, but the build process will take a much longer time. ### Building in Git ### When building in a Git working directory you also have to have a GNU `autoconf` -of at least version 2.59 on your system. This since you need to generate the +of at least version 2.59 on your system, because you need to generate the `configure` scripts before you can start building. The `configure` scripts are generated by invoking `./otp_build autoconf` in @@ -436,7 +436,7 @@ when checking out a branch. Regenerated `configure` scripts imply that you have to run `configure` and build again. > *NOTE*: Running `./otp_build autoconf` is **not** needed when building -> an unmodified version the released source. +> an unmodified version of the released source. Other useful information can be found at our github wiki: <http://wiki.github.com/erlang/otp> diff --git a/erts/configure.in b/erts/configure.in index fac07f8b6a..03e27c9dad 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -1673,6 +1673,15 @@ esac AC_C_BIGENDIAN +dnl fdatasync syscall (Unix only) +AC_CHECK_FUNCS([fdatasync]) + +dnl Find which C libraries are required to use fdatasync +dnl TODO: Remove check once SunOS >= 5.11 is required by erts. +dnl fdatasync requires linking against -lrt on SunOS <= 5.10. +dnl OpenSolaris 2009.06 is SunOS 5.11 and does not require -lrt. +AC_SEARCH_LIBS(fdatasync, [rt]) + dnl ---------------------------------------------------------------------- dnl Checks for library functions. dnl ---------------------------------------------------------------------- @@ -1860,12 +1869,6 @@ fi dnl Need by run_erl. AC_CHECK_FUNCS([openpty]) -dnl fdatasync syscall (Unix only) -AC_CHECK_FUNCS([fdatasync]) - -dnl Find which C libraries are required to use fdatasync -AC_SEARCH_LIBS(fdatasync, [rt]) - AC_CHECK_HEADERS(net/if_dl.h ifaddrs.h netpacket/packet.h) AC_CHECK_FUNCS([getifaddrs]) @@ -3722,7 +3725,7 @@ case "$erl_xcomp_without_sysroot-$with_ssl" in SSL_RUNTIME_LIBDIR="$rdir/lib" SSL_LIBDIR="$dir/lib" SSL_CRYPTO_LIBNAME=libeay32 - SSL_CRYPTO_LIBNAME=ssleay32 + SSL_SSL_LIBNAME=ssleay32 elif test -f "$dir/lib/openssl.lib"; then SSL_RUNTIME_LIBDIR="$rdir/lib" SSL_LIBDIR="$dir/lib" @@ -3904,7 +3907,7 @@ dnl so it is - be adoptable elif test -f "$with_ssl/lib/libeay32.lib"; then SSL_LIBDIR="$with_ssl/lib" SSL_CRYPTO_LIBNAME=libeay32 - SSL_CRYPTO_LIBNAME=ssleay32 + SSL_SSL_LIBNAME=ssleay32 else # This probably wont work, but that's what the user said, so... SSL_LIBDIR="$with_ssl/lib" diff --git a/erts/doc/specs/.gitignore b/erts/doc/specs/.gitignore new file mode 100644 index 0000000000..322eebcb06 --- /dev/null +++ b/erts/doc/specs/.gitignore @@ -0,0 +1 @@ +specs_*.xml diff --git a/erts/doc/src/Makefile b/erts/doc/src/Makefile index 6578923fe1..cfa5527474 100644 --- a/erts/doc/src/Makefile +++ b/erts/doc/src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1997-2010. All Rights Reserved. +# Copyright Ericsson AB 1997-2011. All Rights Reserved. # # The contents of this file are subject to the Erlang Public License, # Version 1.1, (the "License"); you may not use this file except in @@ -16,6 +16,9 @@ # # %CopyrightEnd% # + +SPECS_ESRC = ../../preloaded/src/ + include $(ERL_TOP)/make/target.mk include $(ERL_TOP)/make/$(TARGET)/otp.mk @@ -43,6 +46,12 @@ XML_REF1_FILES = epmd.xml \ run_erl.xml \ start.xml +XML_REF3_EFILES = \ + erl_prim_loader.xml \ + erlang.xml \ + init.xml \ + zlib.xml + XML_REF3_FILES = \ driver_entry.xml \ erl_nif.xml \ @@ -98,18 +107,26 @@ HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf +SPECS_FILES = $(XML_REF3_EFILES:%.xml=$(SPECDIR)/specs_%.xml) + +TOP_SPECS_FILE = specs.xml + # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- XML_FLAGS += +KERNEL_SRC=$(ERL_TOP)/lib/kernel/src +KERNEL_INCLUDE=$(ERL_TOP)/lib/kernel/include +SPECS_FLAGS = -I$(KERNEL_SRC) -I$(KERNEL_INCLUDE) + # ---------------------------------------------------- # Targets # ---------------------------------------------------- $(HTMLDIR)/%.gif: %.gif $(INSTALL_DATA) $< $@ -docs: pdf html man $(INFO_FILE) +docs: man pdf html $(INFO_FILE) $(TOP_PDF_FILE): $(XML_FILES) @@ -132,8 +149,25 @@ clean: rm -f $(MAN1DIR)/* rm -f $(MAN3DIR)/* rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) + rm -f $(SPECDIR)/* rm -f errs core *~ +$(SPECDIR)/specs_driver_entry.xml: + escript $(SPECS_EXTRACTOR) $(SPECS_FLAGS) \ + -o$(dir $@) -module driver_entry +$(SPECDIR)/specs_erl_nif.xml: + escript $(SPECS_EXTRACTOR) $(SPECS_FLAGS) \ + -o$(dir $@) -module erl_nif +$(SPECDIR)/specs_erl_set_memory_block.xml: + escript $(SPECS_EXTRACTOR) $(SPECS_FLAGS) \ + -o$(dir $@) -module erl_set_memory_block +$(SPECDIR)/specs_erl_driver.xml: + escript $(SPECS_EXTRACTOR) $(SPECS_FLAGS) \ + -o$(dir $@) -module erl_driver +$(SPECDIR)/specs_erts_alloc.xml: + escript $(SPECS_EXTRACTOR) $(SPECS_FLAGS) \ + -o$(dir $@) -module erts_alloc + # ---------------------------------------------------- # Release Target # ---------------------------------------------------- diff --git a/erts/doc/src/epmd.xml b/erts/doc/src/epmd.xml index 411e627c85..3e7005410f 100644 --- a/erts/doc/src/epmd.xml +++ b/erts/doc/src/epmd.xml @@ -120,7 +120,7 @@ <item> <p>Let this instance of <c>epmd</c> listen only on the comma-separated list of IP addresses and on the loopback address - (which is implicitely added to the list if it has not been + (which is implicitly added to the list if it has not been specified). This can also be set using the <c><![CDATA[ERL_EPMD_ADDRESS]]></c> environment variable, see the section <seealso marker="#environment_variables">Environment @@ -243,7 +243,7 @@ <p>This environment variable may be set to a comma-separated list of IP addresses, in which case the <c>epmd</c> daemon will listen only on the specified address(es) and on the - loopback address (which is implicitely added to the list if it + loopback address (which is implicitly added to the list if it has not been specified). The default behaviour is to listen on all available IP addresses.</p> </item> diff --git a/erts/doc/src/erl.xml b/erts/doc/src/erl.xml index 514ee5ffaf..02082e57c6 100644 --- a/erts/doc/src/erl.xml +++ b/erts/doc/src/erl.xml @@ -1010,7 +1010,7 @@ list of IP addresses, in which case the <seealso marker="epmd">epmd</seealso> daemon will listen only on the specified address(es) and on the - loopback address (which is implicitely added to the list if it + loopback address (which is implicitly added to the list if it has not been specified).</p> </item> <tag><c><![CDATA[ERL_EPMD_PORT]]></c></tag> diff --git a/erts/doc/src/erl_prim_loader.xml b/erts/doc/src/erl_prim_loader.xml index ccaa9b725f..fa3daaeecc 100644 --- a/erts/doc/src/erl_prim_loader.xml +++ b/erts/doc/src/erl_prim_loader.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2009</year> + <year>1996</year><year>2011</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -55,33 +55,31 @@ <c>-loader_debug</c> are also experimental</p></warning> </description> + <datatypes> + <datatype> + <name name="host"/> + </datatype> + </datatypes> + <funcs> <func> - <name>start(Id, Loader, Hosts) -> {ok, Pid} | {error, What}</name> + <name name="start" arity="3"/> <fsummary>Start the Erlang low level loader</fsummary> - <type> - <v>Id = term()</v> - <v>Loader = atom() | string()</v> - <v>Hosts = [Host]</v> - <v>Host = atom()</v> - <v>Pid = pid()</v> - <v>What = term()</v> - </type> <desc> <p>Starts the Erlang low level loader. This function is called by the <c>init</c> process (and module). The <c>init</c> - process reads the command line flags <c>-id Id</c>, - <c>-loader Loader</c>, and <c>-hosts Hosts</c>. These are + process reads the command line flags <c>-id <anno>Id</anno></c>, + <c>-loader <anno>Loader</anno></c>, and <c>-hosts <anno>Hosts</anno></c>. These are the arguments supplied to the <c>start/3</c> function.</p> <p>If <c>-loader</c> is not given, the default loader is <c>efile</c> which tells the system to read from the file system.</p> - <p>If <c>-loader</c> is <c>inet</c>, the <c>-id Id</c>, - <c>-hosts Hosts</c>, and <c>-setcookie Cookie</c> flags must - also be supplied. <c>Hosts</c> identifies hosts which this + <p>If <c>-loader</c> is <c>inet</c>, the <c>-id <anno>Id</anno></c>, + <c>-hosts <anno>Hosts</anno></c>, and <c>-setcookie Cookie</c> flags must + also be supplied. <c><anno>Hosts</anno></c> identifies hosts which this node can contact in order to load modules. One Erlang runtime system with a <c>erl_boot_server</c> process must be - started on each of hosts given in <c>Hosts</c> in order to + started on each of hosts given in <c><anno>Hosts</anno></c> in order to answer the requests. See <seealso marker="kernel:erl_boot_server">erl_boot_server(3)</seealso>.</p> <p>If <c>-loader</c> is something else, the given port program @@ -90,35 +88,26 @@ </desc> </func> <func> - <name>get_file(Filename) -> {ok, Bin, FullName} | error</name> + <name name="get_file" arity="1"/> <fsummary>Get a file</fsummary> - <type> - <v>Filename = string()</v> - <v>Bin = binary()</v> - <v>FullName = string()</v> - </type> <desc> <p>This function fetches a file using the low level loader. - <c>Filename</c> is either an absolute file name or just the name + <c><anno>Filename</anno></c> is either an absolute file name or just the name of the file, for example <c>"lists.beam"</c>. If an internal path is set to the loader, this path is used to find the file. If a user supplied loader is used, the path can be stripped off if it is obsolete, and the loader does not use a path. - <c>FullName</c> is the complete name of the fetched file. - <c>Bin</c> is the contents of the file as a binary.</p> + <c><anno>FullName</anno></c> is the complete name of the fetched file. + <c><anno>Bin</anno></c> is the contents of the file as a binary.</p> - <p>The <c>Filename</c> can also be a file in an archive. For example - <c>/otp/root/lib/mnesia-4.4.7.ez/mnesia-4.4.7/ebin/mnesia_backup.beam</c> + <p>The <c><anno>Filename</anno></c> can also be a file in an archive. For example + <c>/otp/root/lib/mnesia-4.4.7.ez/mnesia-4.4.7/ebin/mnesia_backup.beam</c>. See <seealso marker="kernel:code">code(3)</seealso> about archive files.</p> </desc> </func> <func> - <name>get_path() -> {ok, Path}</name> + <name name="get_path" arity="0"/> <fsummary>Get the path set in the loader</fsummary> - <type> - <v>Path = [Dir]</v> - <v>Dir = string()</v> - </type> <desc> <p>This function gets the path set in the loader. The path is set by the <c>init</c> process according to information found @@ -126,35 +115,26 @@ </desc> </func> <func> - <name>list_dir(Dir) -> {ok, Filenames} | error</name> + <name name="list_dir" arity="1"/> <fsummary>List files in a directory</fsummary> - <type> - <v>Dir = name()</v> - <v>Filenames = [Filename]</v> - <v>Filename = string()</v> - </type> <desc> <p>Lists all the files in a directory. Returns - <c>{ok, Filenames}</c> if successful. Otherwise, it returns - <c>error</c>. <c>Filenames</c> is a list of + <c>{ok, <anno>Filenames</anno>}</c> if successful. Otherwise, it returns + <c>error</c>. <c><anno>Filenames</anno></c> is a list of the names of all the files in the directory. The names are not sorted.</p> - <p>The <c>Dir</c> can also be a directory in an archive. For example - <c>/otp/root/lib/mnesia-4.4.7.ez/mnesia-4.4.7/ebin</c> + <p>The <c><anno>Dir</anno></c> can also be a directory in an archive. For example + <c>/otp/root/lib/mnesia-4.4.7.ez/mnesia-4.4.7/ebin</c>. See <seealso marker="kernel:code">code(3)</seealso> about archive files.</p> </desc> </func> <func> - <name>read_file_info(Filename) -> {ok, FileInfo} | error</name> + <name name="read_file_info" arity="1"/> <fsummary>Get information about a file</fsummary> - <type> - <v>Filename = name()</v> - <v>FileInfo = #file_info{}</v> - </type> <desc> <p>Retrieves information about a file. Returns - <c>{ok, FileInfo}</c> if successful, otherwise - <c>error</c>. <c>FileInfo</c> is a record + <c>{ok, <anno>FileInfo</anno>}</c> if successful, otherwise + <c>error</c>. <c><anno>FileInfo</anno></c> is a record <c>file_info</c>, defined in the Kernel include file <c>file.hrl</c>. Include the following directive in the module from which the function is called:</p> @@ -162,18 +142,14 @@ -include_lib("kernel/include/file.hrl").</code> <p>See <seealso marker="kernel:file">file(3)</seealso> for more info about the record <c>file_info</c>.</p> - <p>The <c>Filename</c> can also be a file in an archive. For example - <c>/otp/root/lib/mnesia-4.4.7.ez/mnesia-4.4.7/ebin/mnesia_backup.beam</c> + <p>The <c><anno>Filename</anno></c> can also be a file in an archive. For example + <c>/otp/root/lib/mnesia-4.4.7.ez/mnesia-4.4.7/ebin/mnesia_backup.beam</c>. See <seealso marker="kernel:code">code(3)</seealso> about archive files.</p> </desc> </func> <func> - <name>set_path(Path) -> ok</name> + <name name="set_path" arity="1"/> <fsummary>Set the path of the loader</fsummary> - <type> - <v>Path = [Dir]</v> - <v>Dir = string()</v> - </type> <desc> <p>This function sets the path of the loader if <c>init</c> interprets a <c>path</c> command in the start script.</p> diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml index f98e15cb52..84d4160e6a 100644 --- a/erts/doc/src/erlang.xml +++ b/erts/doc/src/erlang.xml @@ -48,22 +48,24 @@ "Allowed in guard tests".</p> </description> - <section> - <title>DATA TYPES</title> - <marker id="iolist_definition"></marker> - <code type="none"> -ext_binary() - a binary data object, - structured according to the Erlang external term format - -iodata() = iolist() | binary() + <datatypes> + <datatype> + <name><marker id="type-ext_binary">ext_binary()</marker></name> + <desc> + <p>A binary data object, structured according to + the Erlang external term format.</p> + </desc> + </datatype> + <datatype> + <name name="timestamp"></name> + <desc><p>See <seealso marker="#now/0">now/0</seealso>.</p> + </desc> + </datatype> + </datatypes> -iolist() = [char() | binary() | iolist()] - a binary is allowed as the tail of the list</code> - </section> <funcs> <func> - <name>abs(Number) -> int() | float()</name> + <name>abs(Number) -> integer() | float()</name> <fsummary>Arithmetical absolute value</fsummary> <type> <v>Number = number()</v> @@ -80,7 +82,7 @@ iolist() = [char() | binary() | iolist()] </desc> </func> <func> - <name>erlang:adler32(Data) -> int()</name> + <name>erlang:adler32(Data) -> integer()</name> <fsummary>Compute adler32 checksum</fsummary> <type> <v>Data = iodata()</v> @@ -90,10 +92,10 @@ iolist() = [char() | binary() | iolist()] </desc> </func> <func> - <name>erlang:adler32(OldAdler, Data) -> int()</name> + <name>erlang:adler32(OldAdler, Data) -> integer()</name> <fsummary>Compute adler32 checksum</fsummary> <type> - <v>OldAdler = int()</v> + <v>OldAdler = integer()</v> <v>Data = iodata()</v> </type> <desc> @@ -112,11 +114,11 @@ iolist() = [char() | binary() | iolist()] </desc> </func> <func> - <name>erlang:adler32_combine(FirstAdler, SecondAdler, SecondSize) -> int()</name> + <name>erlang:adler32_combine(FirstAdler, SecondAdler, SecondSize) -> integer()</name> <fsummary>Combine two adler32 checksums</fsummary> <type> - <v>FirstAdler = SecondAdler = int()</v> - <v>SecondSize = int()</v> + <v>FirstAdler = SecondAdler = integer()</v> + <v>SecondSize = integer()</v> </type> <desc> <p>Combines two previously computed adler32 checksums. @@ -155,20 +157,16 @@ iolist() = [char() | binary() | iolist()] </desc> </func> <func> - <name>apply(Fun, Args) -> term() | empty()</name> + <name name="apply" arity="2"/> <fsummary>Apply a function to an argument list</fsummary> - <type> - <v>Fun = fun()</v> - <v>Args = [term()]</v> - </type> <desc> - <p>Call a fun, passing the elements in <c>Args</c> as + <p>Call a fun, passing the elements in <c><anno>Args</anno></c> as arguments.</p> <p>Note: If the number of elements in the arguments are known at compile-time, the call is better written as - <c>Fun(Arg1, Arg2, ... ArgN)</c>.</p> + <c><anno>Fun</anno>(Arg1, Arg2, ... ArgN)</c>.</p> <warning> - <p>Earlier, <c>Fun</c> could also be given as + <p>Earlier, <c><anno>Fun</anno></c> could also be given as <c>{Module, Function}</c>, equivalent to <c>apply(Module, Function, Args)</c>. This usage is deprecated and will stop working in a future release of @@ -177,15 +175,11 @@ iolist() = [char() | binary() | iolist()] </desc> </func> <func> - <name>apply(Module, Function, Args) -> term() | empty()</name> + <name name="apply" arity="3"/> <fsummary>Apply a function to an argument list</fsummary> - <type> - <v>Module = Function = atom()</v> - <v>Args = [term()]</v> - </type> <desc> <p>Returns the result of applying <c>Function</c> in - <c>Module</c> to <c>Args</c>. The applied function must + <c><anno>Module</anno></c> to <c><anno>Args</anno></c>. The applied function must be exported from <c>Module</c>. The arity of the function is the length of <c>Args</c>.</p> <pre> @@ -198,7 +192,7 @@ iolist() = [char() | binary() | iolist()] "Erlang"</pre> <p>Note: If the number of arguments are known at compile-time, the call is better written as - <c>Module:Function(Arg1, Arg2, ..., ArgN)</c>.</p> + <c><anno>Module</anno>:<anno>Function</anno>(Arg1, Arg2, ..., ArgN)</c>.</p> <p>Failure: <c>error_handler:undefined_function/3</c> is called if the applied function is not exported. The error handler can be redefined (see @@ -258,8 +252,8 @@ iolist() = [char() | binary() | iolist()] <type> <v>Subject = binary()</v> <v>PosLen = {Start,Length}</v> - <v>Start = int()</v> - <v>Length = int()</v> + <v>Start = integer() >= 0</v> + <v>Length = integer() >= 0</v> </type> <desc> <p>Extracts the part of the binary described by <c>PosLen</c>.</p> @@ -291,8 +285,8 @@ iolist() = [char() | binary() | iolist()] <fsummary>Extracts a part of a binary</fsummary> <type> <v>Subject = binary()</v> - <v>Start = int()</v> - <v>Length = int()</v> + <v>Start = integer() >= 0</v> + <v>Length = integer() >= 0</v> </type> <desc> <p>The same as <c>binary_part(Subject, {Pos, Len})</c>.</p> @@ -390,7 +384,7 @@ iolist() = [char() | binary() | iolist()] <name>binary_to_term(Binary) -> term()</name> <fsummary>Decode an Erlang external term format binary</fsummary> <type> - <v>Binary = ext_binary()</v> + <v>Binary = <seealso marker="#type-ext_binary">ext_binary()</seealso></v> </type> <desc> <p>Returns an Erlang term which is the result of decoding @@ -411,7 +405,7 @@ iolist() = [char() | binary() | iolist()] <fsummary>Decode an Erlang external term format binary</fsummary> <type> <v>Opts = [safe]</v> - <v>Binary = ext_binary()</v> + <v>Binary = <seealso marker="#type-ext_binary">ext_binary()</seealso></v> </type> <desc> <p>As <c>binary_to_term/1</c>, but takes options that affect decoding @@ -442,7 +436,7 @@ iolist() = [char() | binary() | iolist()] </desc> </func> <func> - <name>bit_size(Bitstring) -> int()</name> + <name>bit_size(Bitstring) -> integer() >= 0</name> <fsummary>Return the size of a bitstring</fsummary> <type> <v>Bitstring = bitstring()</v> @@ -461,7 +455,7 @@ iolist() = [char() | binary() | iolist()] <name>erlang:bump_reductions(Reductions) -> void()</name> <fsummary>Increment the reduction counter</fsummary> <type> - <v>Reductions = int()</v> + <v>Reductions = integer() >= 0</v> </type> <desc> <p>This implementation-dependent function increments @@ -478,7 +472,7 @@ iolist() = [char() | binary() | iolist()] </desc> </func> <func> - <name>byte_size(Bitstring) -> int()</name> + <name>byte_size(Bitstring) -> integer() >= 0</name> <fsummary>Return the size of a bitstring (or binary)</fsummary> <type> <v>Bitstring = bitstring()</v> @@ -500,7 +494,7 @@ iolist() = [char() | binary() | iolist()] <fsummary>Cancel a timer</fsummary> <type> <v>TimerRef = reference()</v> - <v>Time = int()</v> + <v>Time = integer() >= 0</v> </type> <desc> <p>Cancels a timer, where <c>TimerRef</c> was returned by @@ -524,7 +518,19 @@ iolist() = [char() | binary() | iolist()] </func> <func> - <name>check_process_code(Pid, Module) -> bool()</name> + <name>check_old_code(Module) -> boolean()</name> + <fsummary>Check if a module has old code</fsummary> + <type> + <v>Module = atom()</v> + </type> + <desc> + <p>Returns <c>true</c> if the <c>Module</c> has old code, + and <c>false</c> otherwise.</p> + <p>See also <seealso marker="kernel:code">code(3)</seealso>.</p> + </desc> + </func> + <func> + <name>check_process_code(Pid, Module) -> boolean()</name> <fsummary>Check if a process is executing old code for a module</fsummary> <type> <v>Pid = pid()</v> @@ -544,7 +550,7 @@ false</pre> </desc> </func> <func> - <name>concat_binary(ListOfBinaries)</name> + <name name="concat_binary" arity="1"/> <fsummary>Concatenate a list of binaries (deprecated)</fsummary> <desc> <p>Do not use; use @@ -553,7 +559,7 @@ false</pre> </desc> </func> <func> - <name>erlang:crc32(Data) -> int()</name> + <name>erlang:crc32(Data) -> integer() >= 0</name> <fsummary>Compute crc32 (IEEE 802.3) checksum</fsummary> <type> <v>Data = iodata()</v> @@ -563,10 +569,10 @@ false</pre> </desc> </func> <func> - <name>erlang:crc32(OldCrc, Data) -> int()</name> + <name>erlang:crc32(OldCrc, Data) -> integer() >= 0</name> <fsummary>Compute crc32 (IEEE 802.3) checksum</fsummary> <type> - <v>OldCrc = int()</v> + <v>OldCrc = integer() >= 0</v> <v>Data = iodata()</v> </type> <desc> @@ -585,11 +591,11 @@ false</pre> </desc> </func> <func> - <name>erlang:crc32_combine(FirstCrc, SecondCrc, SecondSize) -> int()</name> + <name>erlang:crc32_combine(FirstCrc, SecondCrc, SecondSize) -> integer() >= 0</name> <fsummary>Combine two crc32 (IEEE 802.3) checksums</fsummary> <type> - <v>FirstCrc = SecondCrc = int()</v> - <v>SecondSize = int()</v> + <v>FirstCrc = SecondCrc = integer() >= 0</v> + <v>SecondSize = integer() >= 0</v> </type> <desc> <p>Combines two previously computed crc32 checksums. @@ -609,10 +615,10 @@ false</pre> </desc> </func> <func> - <name>date() -> {Year, Month, Day}</name> + <name>date() -> Date</name> <fsummary>Current date</fsummary> <type> - <v>Year = Month = Day = int()</v> + <v>Date = <seealso marker="calendar#type-date">calendar:date()</seealso></v> </type> <desc> <p>Returns the current date as <c>{Year, Month, Day}</c>.</p> @@ -631,20 +637,20 @@ false</pre> <v>Options = [Opt]</v> <v>Packet = binary() | HttpPacket</v> <v>Rest = binary()</v> - <v>Length = int() | undefined</v> + <v>Length = integer() > 0 | undefined</v> <v>Reason = term()</v> <v> Type, Opt -- see below</v> <v></v> <v>HttpPacket = HttpRequest | HttpResponse | HttpHeader | http_eoh | HttpError</v> <v>HttpRequest = {http_request, HttpMethod, HttpUri, HttpVersion}</v> <v>HttpResponse = {http_response, HttpVersion, integer(), HttpString}</v> - <v>HttpHeader = {http_header, int(), HttpField, Reserved=term(), Value=HttpString}</v> + <v>HttpHeader = {http_header, integer(), HttpField, Reserved=term(), Value=HttpString}</v> <v>HttpError = {http_error, HttpString}</v> <v>HttpMethod = HttpMethodAtom | HttpString</v> <v>HttpMethodAtom = 'OPTIONS' | 'GET' | 'HEAD' | 'POST' | 'PUT' | 'DELETE' | 'TRACE'</v> - <v>HttpUri = '*' | {absoluteURI, http|https, Host=HttpString, Port=int()|undefined, Path=HttpString} | + <v>HttpUri = '*' | {absoluteURI, http|https, Host=HttpString, Port=integer()|undefined, Path=HttpString} | {scheme, Scheme=HttpString, HttpString} | {abs_path, HttpString} | HttpString</v> - <v>HttpVersion = {Major=int(), Minor=int()}</v> + <v>HttpVersion = {Major=integer(), Minor=integer()}</v> <v>HttpString = string() | binary()</v> <v>HttpField = HttpFieldAtom | HttpString</v> <v>HttpFieldAtom = 'Cache-Control' | 'Connection' | 'Date' | 'Pragma' | 'Transfer-Encoding' | 'Upgrade' | 'Via' | 'Accept' | 'Accept-Charset' | 'Accept-Encoding' | 'Accept-Language' | 'Authorization' | 'From' | 'Host' | 'If-Modified-Since' | 'If-Match' | 'If-None-Match' | 'If-Range' | 'If-Unmodified-Since' | 'Max-Forwards' | 'Proxy-Authorization' | 'Range' | 'Referer' | 'User-Agent' | 'Age' | 'Location' | 'Proxy-Authenticate' | 'Public' | 'Retry-After' | 'Server' | 'Vary' | 'Warning' | 'Www-Authenticate' | 'Allow' | 'Content-Base' | 'Content-Encoding' | 'Content-Language' | 'Content-Length' | 'Content-Location' | 'Content-Md5' | 'Content-Range' | 'Content-Type' | 'Etag' | 'Expires' | 'Last-Modified' | 'Accept-Ranges' | 'Set-Cookie' | 'Set-Cookie2' | 'X-Forwarded-For' | 'Cookie' | 'Keep-Alive' | 'Proxy-Connection'</v> @@ -719,14 +725,14 @@ false</pre> </taglist> <p>The following options are available:</p> <taglist> - <tag><c>{packet_size, int()}</c></tag> + <tag><c>{packet_size, integer()}</c></tag> <item><p>Sets the max allowed size of the packet body. If the packet header indicates that the length of the packet is longer than the max allowed length, the packet is considered invalid. Default is 0 which means no size limit.</p> </item> - <tag><c>{line_length, int()}</c></tag> + <tag><c>{line_length, integer()}</c></tag> <item><p>Applies only to line oriented protocols (<c>line</c>, <c>http</c>). Lines longer than this will be truncated.</p> @@ -800,7 +806,7 @@ false</pre> </desc> </func> <func> - <name>demonitor(MonitorRef, OptionList) -> true|false</name> + <name>demonitor(MonitorRef, OptionList) -> boolean()</name> <fsummary>Stop monitoring</fsummary> <type> <v>MonitorRef = reference()</v> @@ -867,14 +873,11 @@ false</pre> </desc> </func> <func> - <name>disconnect_node(Node) -> bool() | ignored</name> + <name name="disconnect_node" arity="1"/> <fsummary>Force the disconnection of a node</fsummary> - <type> - <v>Node = atom()</v> - </type> <desc> <p>Forces the disconnection of a node. This will appear to - the node <c>Node</c> as if the local node has crashed. This + the node <c><anno>Node</anno></c> as if the local node has crashed. This BIF is mainly used in the Erlang network authentication protocols. Returns <c>true</c> if disconnection succeeds, otherwise <c>false</c>. If the local node is not alive, @@ -1032,6 +1035,56 @@ b</pre> </desc> </func> <func> + <name>erlang:external_size(Term) -> integer() >= 0</name> + <fsummary>Calculate the maximum size for a term encoded in the Erlang + external term format</fsummary> + <type> + <v>Term = term()</v> + </type> + <desc> + <p>Calculates, without doing the encoding, the maximum byte size for + a term encoded in the Erlang external term format. The following + condition applies always:</p> + <p> + <pre> +> <input>Size1 = byte_size(term_to_binary(Term)),</input> +> <input>Size2 = erlang:external_size(Term),</input> +> <input>true = Size1 =< Size2.</input> +true + </pre> + </p> + <p>This is equivalent to a call to: <code>erlang:external_size(Term, []) + </code></p> + </desc> + </func> + <func> + <name>erlang:external_size(Term, [Option]) -> integer() >= 0</name> + <fsummary>Calculate the maximum size for a term encoded in the Erlang + external term format</fsummary> + <type> + <v>Term = term()</v> + <v>Option = {minor_version, Version}</v> + </type> + <desc> + <p>Calculates, without doing the encoding, the maximum byte size for + a term encoded in the Erlang external term format. The following + condition applies always:</p> + <p> + <pre> +> <input>Size1 = byte_size(term_to_binary(Term, Options)),</input> +> <input>Size2 = erlang:external_size(Term, Options),</input> +> <input>true = Size1 =< Size2.</input> +true + </pre> + </p> + <p>The option <c>{minor_version, Version}</c> specifies how floats + are encoded. See + <seealso marker="#term_to_binary/2">term_to_binary/2</seealso> for + a more detailed description. + </p> + </desc> + </func> + <func> <name>float(Number) -> float()</name> <fsummary>Convert a number to a float</fsummary> <type> @@ -1069,15 +1122,11 @@ b</pre> </desc> </func> <func> - <name>erlang:fun_info(Fun) -> [{Item, Info}]</name> + <name name="fun_info" arity="1"/> <fsummary>Information about a fun</fsummary> - <type> - <v>Fun = fun()</v> - <v>Item, Info -- see below</v> - </type> <desc> <p>Returns a list containing information about the fun - <c>Fun</c>. Each element of the list is a tuple. The order of + <c><anno>Fun</anno></c>. Each element of the list is a tuple. The order of the tuples is not defined, and more tuples may be added in a future release.</p> <warning> @@ -1176,7 +1225,7 @@ b</pre> <p>Returns information about <c>Fun</c> as specified by <c>Item</c>, in the form <c>{Item,Info}</c>.</p> <p>For any fun, <c>Item</c> can be any of the atoms - <c>module</c>, <c>name</c>, <c>arity</c>, or <c>env</c>.</p> + <c>module</c>, <c>name</c>, <c>arity</c>, <c>env</c>, or <c>type</c>.</p> <p>For a local fun, <c>Item</c> can also be any of the atoms <c>index</c>, <c>new_index</c>, <c>new_uniq</c>, <c>uniq</c>, and <c>pid</c>. For an external fun, the value @@ -1197,11 +1246,11 @@ b</pre> </desc> </func> <func> - <name>erlang:function_exported(Module, Function, Arity) -> bool()</name> + <name>erlang:function_exported(Module, Function, Arity) -> boolean()</name> <fsummary>Check if a function is exported and loaded</fsummary> <type> <v>Module = Function = atom()</v> - <v>Arity = int()</v> + <v>Arity = arity()</v> </type> <desc> <p>Returns <c>true</c> if the module <c>Module</c> is loaded @@ -1229,7 +1278,7 @@ b</pre> </desc> </func> <func> - <name>garbage_collect(Pid) -> bool()</name> + <name>garbage_collect(Pid) -> boolean()</name> <fsummary>Force an immediate garbage collection of a process</fsummary> <type> <v>Pid = pid()</v> @@ -1276,11 +1325,8 @@ b</pre> </desc> </func> <func> - <name>erlang:get_cookie() -> Cookie | nocookie</name> + <name name="get_cookie" arity="0"/> <fsummary>Get the magic cookie of the local node</fsummary> - <type> - <v>Cookie = atom()</v> - </type> <desc> <p>Returns the magic cookie of the local node, if the node is alive; otherwise the atom <c>nocookie</c>.</p> @@ -1311,7 +1357,7 @@ b</pre> <fsummary>Get the call stack back-trace of the last exception</fsummary> <type> <v>Module = Function = atom()</v> - <v>Arity = int()</v> + <v>Arity = arity()</v> <v>Args = [term()]</v> </type> <desc> @@ -1379,7 +1425,7 @@ os_prompt%</pre> <name>halt(Status)</name> <fsummary>Halt the Erlang runtime system</fsummary> <type> - <v>Status = int()>=0 | string()</v> + <v>Status = integer() >= 0 | string()</v> </type> <desc> <p><c>Status</c> must be a non-negative integer, or a string. @@ -1472,7 +1518,7 @@ os_prompt%</pre> <name>integer_to_list(Integer) -> string()</name> <fsummary>Text representation of an integer</fsummary> <type> - <v>Integer = int()</v> + <v>Integer = integer()</v> </type> <desc> <p>Returns a string which corresponds to the text @@ -1483,15 +1529,11 @@ os_prompt%</pre> </desc> </func> <func> - <name>integer_to_list(Integer, Base) -> string()</name> + <name name="integer_to_list" arity="2"/> <fsummary>Text representation of an integer</fsummary> - <type> - <v>Integer = int()</v> - <v>Base = 2..36</v> - </type> <desc> <p>Returns a string which corresponds to the text - representation of <c>Integer</c> in base <c>Base</c>.</p> + representation of <c><anno>Integer</anno></c> in base <c><anno>Base</anno></c>.</p> <pre> > <input>integer_to_list(1023, 16).</input> "3FF"</pre> @@ -1518,7 +1560,7 @@ os_prompt%</pre> </desc> </func> <func> - <name>iolist_size(Item) -> int()</name> + <name>iolist_size(Item) -> integer() >= 0</name> <fsummary>Size of an iolist</fsummary> <type> <v>Item = iolist() | binary()</v> @@ -1533,7 +1575,7 @@ os_prompt%</pre> </desc> </func> <func> - <name>is_alive() -> bool()</name> + <name>is_alive() -> boolean()</name> <fsummary>Check whether the local node is alive</fsummary> <desc> <p>Returns <c>true</c> if the local node is alive; that is, if @@ -1542,7 +1584,7 @@ os_prompt%</pre> </desc> </func> <func> - <name>is_atom(Term) -> bool()</name> + <name>is_atom(Term) -> boolean()</name> <fsummary>Check whether a term is an atom</fsummary> <type> <v>Term = term()</v> @@ -1554,7 +1596,7 @@ os_prompt%</pre> </desc> </func> <func> - <name>is_binary(Term) -> bool()</name> + <name>is_binary(Term) -> boolean()</name> <fsummary>Check whether a term is a binary</fsummary> <type> <v>Term = term()</v> @@ -1569,7 +1611,7 @@ os_prompt%</pre> </desc> </func> <func> - <name>is_bitstring(Term) -> bool()</name> + <name>is_bitstring(Term) -> boolean()</name> <fsummary>Check whether a term is a bitstring</fsummary> <type> <v>Term = term()</v> @@ -1582,7 +1624,7 @@ os_prompt%</pre> </desc> </func> <func> - <name>is_boolean(Term) -> bool()</name> + <name>is_boolean(Term) -> boolean()</name> <fsummary>Check whether a term is a boolean</fsummary> <type> <v>Term = term()</v> @@ -1595,11 +1637,11 @@ os_prompt%</pre> </desc> </func> <func> - <name>erlang:is_builtin(Module, Function, Arity) -> bool()</name> + <name>erlang:is_builtin(Module, Function, Arity) -> boolean()</name> <fsummary>Check if a function is a BIF implemented in C</fsummary> <type> <v>Module = Function = atom()</v> - <v>Arity = int()</v> + <v>Arity = arity()</v> </type> <desc> <p>Returns <c>true</c> if <c>Module:Function/Arity</c> is @@ -1608,7 +1650,7 @@ os_prompt%</pre> </desc> </func> <func> - <name>is_float(Term) -> bool()</name> + <name>is_float(Term) -> boolean()</name> <fsummary>Check whether a term is a float</fsummary> <type> <v>Term = term()</v> @@ -1620,7 +1662,7 @@ os_prompt%</pre> </desc> </func> <func> - <name>is_function(Term) -> bool()</name> + <name>is_function(Term) -> boolean()</name> <fsummary>Check whether a term is a fun</fsummary> <type> <v>Term = term()</v> @@ -1632,11 +1674,11 @@ os_prompt%</pre> </desc> </func> <func> - <name>is_function(Term, Arity) -> bool()</name> + <name>is_function(Term, Arity) -> boolean()</name> <fsummary>Check whether a term is a fun with a given arity</fsummary> <type> <v>Term = term()</v> - <v>Arity = int()</v> + <v>Arity = arity()</v> </type> <desc> <p>Returns <c>true</c> if <c>Term</c> is a fun that can be @@ -1653,7 +1695,7 @@ os_prompt%</pre> </desc> </func> <func> - <name>is_integer(Term) -> bool()</name> + <name>is_integer(Term) -> boolean()</name> <fsummary>Check whether a term is an integer</fsummary> <type> <v>Term = term()</v> @@ -1665,7 +1707,7 @@ os_prompt%</pre> </desc> </func> <func> - <name>is_list(Term) -> bool()</name> + <name>is_list(Term) -> boolean()</name> <fsummary>Check whether a term is a list</fsummary> <type> <v>Term = term()</v> @@ -1677,7 +1719,7 @@ os_prompt%</pre> </desc> </func> <func> - <name>is_number(Term) -> bool()</name> + <name>is_number(Term) -> boolean()</name> <fsummary>Check whether a term is a number</fsummary> <type> <v>Term = term()</v> @@ -1689,7 +1731,7 @@ os_prompt%</pre> </desc> </func> <func> - <name>is_pid(Term) -> bool()</name> + <name>is_pid(Term) -> boolean()</name> <fsummary>Check whether a term is a pid</fsummary> <type> <v>Term = term()</v> @@ -1701,7 +1743,7 @@ os_prompt%</pre> </desc> </func> <func> - <name>is_port(Term) -> bool()</name> + <name>is_port(Term) -> boolean()</name> <fsummary>Check whether a term is a port</fsummary> <type> <v>Term = term()</v> @@ -1713,7 +1755,7 @@ os_prompt%</pre> </desc> </func> <func> - <name>is_process_alive(Pid) -> bool()</name> + <name>is_process_alive(Pid) -> boolean()</name> <fsummary>Check whether a process is alive</fsummary> <type> <v>Pid = pid()</v> @@ -1728,7 +1770,7 @@ os_prompt%</pre> </desc> </func> <func> - <name>is_record(Term, RecordTag) -> bool()</name> + <name>is_record(Term, RecordTag) -> boolean()</name> <fsummary>Check whether a term appears to be a record</fsummary> <type> <v>Term = term()</v> @@ -1751,12 +1793,12 @@ os_prompt%</pre> </desc> </func> <func> - <name>is_record(Term, RecordTag, Size) -> bool()</name> + <name>is_record(Term, RecordTag, Size) -> boolean()</name> <fsummary>Check whether a term appears to be a record</fsummary> <type> <v>Term = term()</v> <v>RecordTag = atom()</v> - <v>Size = int()</v> + <v>Size = integer()</v> </type> <desc> <p><c>RecordTag</c> must be an atom. Returns <c>true</c> if @@ -1771,7 +1813,7 @@ os_prompt%</pre> </desc> </func> <func> - <name>is_reference(Term) -> bool()</name> + <name>is_reference(Term) -> boolean()</name> <fsummary>Check whether a term is a reference</fsummary> <type> <v>Term = term()</v> @@ -1783,7 +1825,7 @@ os_prompt%</pre> </desc> </func> <func> - <name>is_tuple(Term) -> bool()</name> + <name>is_tuple(Term) -> boolean()</name> <fsummary>Check whether a term is a tuple</fsummary> <type> <v>Term = term()</v> @@ -1795,7 +1837,7 @@ os_prompt%</pre> </desc> </func> <func> - <name>length(List) -> int()</name> + <name>length(List) -> integer() >= 0</name> <fsummary>Length of a list</fsummary> <type> <v>List = [term()]</v> @@ -1916,7 +1958,7 @@ os_prompt%</pre> </desc> </func> <func> - <name>list_to_integer(String) -> int()</name> + <name>list_to_integer(String) -> integer()</name> <fsummary>Convert from text representation to an integer</fsummary> <type> <v>String = string()</v> @@ -1932,19 +1974,15 @@ os_prompt%</pre> </desc> </func> <func> - <name>list_to_integer(String, Base) -> int()</name> + <name name="list_to_integer" arity="2"/> <fsummary>Convert from text representation to an integer</fsummary> - <type> - <v>String = string()</v> - <v>Base = 2..36</v> - </type> <desc> <p>Returns an integer whose text representation in base - <c>Base</c> is <c>String</c>.</p> + <c><anno>Base</anno></c> is <c><anno>String</anno></c>.</p> <pre> > <input>list_to_integer("3FF", 16).</input> 1023</pre> - <p>Failure: <c>badarg</c> if <c>String</c> contains a bad + <p>Failure: <c>badarg</c> if <c><anno>String</anno></c> contains a bad representation of an integer.</p> </desc> </func> @@ -2095,12 +2133,10 @@ os_prompt%</pre> </desc> </func> <func> - <name>erlang:localtime() -> {Date, Time}</name> + <name>erlang:localtime() -> DateTime</name> <fsummary>Current local date and time</fsummary> <type> - <v>Date = {Year, Month, Day}</v> - <v>Time = {Hour, Minute, Second}</v> - <v> Year = Month = Day = Hour = Minute = Second = int()</v> + <v>DateTime = <seealso marker="calendar#type-datetime">calendar:datetime()</seealso></v> </type> <desc> <p>Returns the current local date and time @@ -2113,17 +2149,12 @@ os_prompt%</pre> </desc> </func> <func> - <name>erlang:localtime_to_universaltime({Date1, Time1}) -> {Date2, Time2}</name> + <name name="localtime_to_universaltime" arity="1"/> <fsummary>Convert from local to Universal Time Coordinated (UTC) date and time</fsummary> - <type> - <v>Date1 = Date2 = {Year, Month, Day}</v> - <v>Time1 = Time2 = {Hour, Minute, Second}</v> - <v> Year = Month = Day = Hour = Minute = Second = int()</v> - </type> <desc> <p>Converts local date and time to Universal Time Coordinated (UTC), if this is supported by the underlying OS. Otherwise, - no conversion is done and <c>{Date1, Time1}</c> is returned.</p> + no conversion is done and <c>{<anno>Date1</anno>, <anno>Time1</anno>}</c> is returned.</p> <pre> > <input>erlang:localtime_to_universaltime({{1996,11,6},{14,45,17}}).</input> {{1996,11,6},{13,45,17}}</pre> @@ -2135,9 +2166,8 @@ os_prompt%</pre> <name>erlang:localtime_to_universaltime({Date1, Time1}, IsDst) -> {Date2, Time2}</name> <fsummary>Convert from local to Universal Time Coordinated (UTC) date and time</fsummary> <type> - <v>Date1 = Date2 = {Year, Month, Day}</v> - <v>Time1 = Time2 = {Hour, Minute, Second}</v> - <v> Year = Month = Day = Hour = Minute = Second = int()</v> + <v>Date1 = Date2 = <seealso marker="calendar#type-date">calendar:date()</seealso></v> + <v>Time1 = Time2 = <seealso marker="calendar#type-time">calendar:time()</seealso></v> <v>IsDst = true | false | undefined</v> </type> <desc> @@ -2177,7 +2207,7 @@ os_prompt%</pre> <name>erlang:make_tuple(Arity, InitialValue) -> tuple()</name> <fsummary>Create a new tuple of a given arity</fsummary> <type> - <v>Arity = int()</v> + <v>Arity = arity()</v> <v>InitialValue = term()</v> </type> <desc> @@ -2192,7 +2222,7 @@ os_prompt%</pre> <name>erlang:make_tuple(Arity, Default, InitList) -> tuple()</name> <fsummary>Create a new tuple with given arity and contents</fsummary> <type> - <v>Arity = int()</v> + <v>Arity = arity()</v> <v>Default = term()</v> <v>InitList = [{Position,term()}]</v> <v>Position = integer()</v> @@ -2211,14 +2241,11 @@ os_prompt%</pre> </desc> </func> <func> - <name>max(Term1, Term2) -> Maximum</name> + <name name="max" arity="2"/> <fsummary>Return the largest of two term</fsummary> - <type> - <v>Term1 = Term2 = Maximum = term()</v> - </type> <desc> - <p>Return the largest of <c>Term1</c> and <c>Term2</c>; - if the terms compares equal, <c>Term1</c> will be returned.</p> + <p>Return the largest of <c><anno>Term1</anno></c> and <c><anno>Term2</anno></c>; + if the terms compare equal, <c><anno>Term1</anno></c> will be returned.</p> </desc> </func> <func> @@ -2468,18 +2495,15 @@ os_prompt%</pre> </desc> </func> <func> - <name>min(Term1, Term2) -> Minimum</name> + <name name="min" arity="2"/> <fsummary>Return the smallest of two term</fsummary> - <type> - <v>Term1 = Term2 = Minimum = term()</v> - </type> <desc> - <p>Return the smallest of <c>Term1</c> and <c>Term2</c>; - if the terms compare equal, <c>Term1</c> will be returned.</p> + <p>Return the smallest of <c><anno>Term1</anno></c> and <c><anno>Term2</anno></c>; + if the terms compare equal, <c><anno>Term1</anno></c> will be returned.</p> </desc> </func> <func> - <name>module_loaded(Module) -> bool()</name> + <name>module_loaded(Module) -> boolean()</name> <fsummary>Check if a module is loaded</fsummary> <type> <v>Module = atom()</v> @@ -2602,7 +2626,7 @@ os_prompt%</pre> <fsummary>Monitor the status of a node</fsummary> <type> <v>Node = node()</v> - <v>Flag = bool()</v> + <v>Flag = boolean()</v> </type> <desc> <p>Monitors the status of the node <c>Node</c>. If <c>Flag</c> @@ -2628,7 +2652,7 @@ os_prompt%</pre> <fsummary>Monitor the status of a node</fsummary> <type> <v>Node = node()</v> - <v>Flag = bool()</v> + <v>Flag = boolean()</v> <v>Options = [Option]</v> <v>Option = allow_passive_connect</v> </type> @@ -2711,11 +2735,8 @@ os_prompt%</pre> </desc> </func> <func> - <name>nodes() -> Nodes</name> + <name name="nodes" arity="0"/> <fsummary>All visible nodes in the system</fsummary> - <type> - <v>Nodes = [node()]</v> - </type> <desc> <p>Returns a list of all visible nodes in the system, excluding the local node. Same as <c>nodes(visible)</c>.</p> @@ -2765,11 +2786,12 @@ os_prompt%</pre> </desc> </func> <func> - <name>now() -> {MegaSecs, Secs, MicroSecs}</name> - <fsummary>Elapsed time since 00:00 GMT</fsummary> + <name>now() -> timestamp()</name> <type> - <v>MegaSecs = Secs = MicroSecs = int()</v> + <v>timestamp() = {MegaSecs, Secs, MicroSecs}</v> + <v>MegaSecs = Secs = MicroSecs = integer() >= 0</v> </type> + <fsummary>Elapsed time since 00:00 GMT</fsummary> <desc> <p>Returns the tuple <c>{MegaSecs, Secs, MicroSecs}</c> which is the elapsed time since 00:00 GMT, January 1, 1970 (zero hour) @@ -2792,12 +2814,12 @@ os_prompt%</pre> <v>PortName = {spawn, Command} | {spawn_driver, Command} | {spawn_executable, FileName} | {fd, In, Out}</v> <v> Command = string()</v> <v> FileName = [ FileNameChar ] | binary()</v> - <v> FileNameChar = int() (1..255 or any Unicode codepoint, see description)</v> - <v> In = Out = int()</v> + <v> FileNameChar = integer() (1..255 or any Unicode codepoint, see description)</v> + <v> In = Out = integer()</v> <v>PortSettings = [Opt]</v> <v> Opt = {packet, N} | stream | {line, L} | {cd, Dir} | {env, Env} | {args, [ ArgString ]} | {arg0, ArgString} | exit_status | use_stdio | nouse_stdio | stderr_to_stdout | in | out | binary | eof</v> <v> N = 1 | 2 | 4</v> - <v> L = int()</v> + <v> L = integer()</v> <v> Dir = string()</v> <v> ArgString = [ FileNameChar ] | binary()</v> <v> Env = [{Name, Val}]</v> @@ -3283,7 +3305,7 @@ os_prompt%</pre> </desc> </func> <func> - <name>port_command(Port, Data, OptionList) -> true|false</name> + <name>port_command(Port, Data, OptionList) -> boolean()</name> <fsummary>Send data to a port</fsummary> <type> <v>Port = port() | atom()</v> @@ -3399,7 +3421,7 @@ os_prompt%</pre> <fsummary>Perform a synchronous control operation on a port</fsummary> <type> <v>Port = port() | atom()</v> - <v>Operation = int()</v> + <v>Operation = integer()</v> <v>Data = Res = iodata()</v> </type> <desc> @@ -3423,7 +3445,7 @@ os_prompt%</pre> <fsummary>Synchronous call to a port with term data</fsummary> <type> <v>Port = port() | atom()</v> - <v>Operation = int()</v> + <v>Operation = integer()</v> <v>Data = term()</v> </type> <desc> @@ -4109,7 +4131,7 @@ os_prompt%</pre> <v>Reason = term()</v> <v>Stacktrace = [{Module, Function, Arity | Args} | {Fun, Args}]</v> <v> Module = Function = atom()</v> - <v> Arity = int()</v> + <v> Arity = arity()</v> <v> Args = [term()]</v> <v> Fun = [fun()]</v> </type> @@ -4146,7 +4168,7 @@ os_prompt%</pre> </desc> </func> <func> - <name>erlang:read_timer(TimerRef) -> int() | false</name> + <name>erlang:read_timer(TimerRef) -> integer() >= 0 | false</name> <fsummary>Number of milliseconds remaining for a timer</fsummary> <type> <v>TimerRef = reference()</v> @@ -4262,7 +4284,7 @@ true</pre> </desc> </func> <func> - <name>round(Number) -> int()</name> + <name>round(Number) -> integer()</name> <fsummary>Return an integer by rounding a number</fsummary> <type> <v>Number = number()</v> @@ -4346,7 +4368,7 @@ true</pre> <name>erlang:send_after(Time, Dest, Msg) -> TimerRef</name> <fsummary>Start a timer</fsummary> <type> - <v>Time = int()</v> + <v>Time = integer() >= 0</v> <v> 0 <= Time <= 4294967295</v> <v>Dest = pid() | RegName </v> <v> LocalPid = pid() (of a process, alive or dead, on the local node)</v> @@ -4375,17 +4397,12 @@ true</pre> </desc> </func> <func> - <name>erlang:send_nosuspend(Dest, Msg) -> bool()</name> + <name name="send_nosuspend" arity="2"/> <fsummary>Try to send a message without ever blocking</fsummary> - <type> - <v>Dest = pid() | port() | RegName | {RegName, Node}</v> - <v> RegName = atom()</v> - <v> Node = node()</v> - <v>Msg = term()</v> - </type> + <type name="dst"/> <desc> <p>The same as - <seealso marker="#send/3">erlang:send(Dest, Msg, [nosuspend])</seealso>, but returns <c>true</c> if + <seealso marker="#send/3">erlang:send(<anno>Dest</anno>, <anno>Msg</anno>, [nosuspend])</seealso>, but returns <c>true</c> if the message was sent and <c>false</c> if the message was not sent because the sender would have had to be suspended.</p> <p>This function is intended for send operations towards an @@ -4393,7 +4410,7 @@ true</pre> (Erlang) process. If the connection to the remote node (usually not a real Erlang node, but a node written in C or Java) is overloaded, this function <em>will not send the message</em> but return <c>false</c> instead.</p> - <p>The same happens, if <c>Dest</c> refers to a local port that + <p>The same happens, if <c><anno>Dest</anno></c> refers to a local port that is busy. For all other destinations (allowed for the ordinary send operator <c>'!'</c>) this function sends the message and returns <c>true</c>.</p> @@ -4426,18 +4443,12 @@ true</pre> </desc> </func> <func> - <name>erlang:send_nosuspend(Dest, Msg, Options) -> bool()</name> + <name name="send_nosuspend" arity="3"/> <fsummary>Try to send a message without ever blocking</fsummary> - <type> - <v>Dest = pid() | port() | RegName | {RegName, Node}</v> - <v> RegName = atom()</v> - <v> Node = node()</v> - <v>Msg = term()</v> - <v>Option = noconnect</v> - </type> + <type name="dst"/> <desc> <p>The same as - <seealso marker="#send/3">erlang:send(Dest, Msg, [nosuspend | Options])</seealso>, + <seealso marker="#send/3">erlang:send(<anno>Dest</anno>, <anno>Msg</anno>, [nosuspend | <anno>Options</anno>])</seealso>, but with boolean return value.</p> <p>This function behaves like <seealso marker="#send_nosuspend/2">erlang:send_nosuspend/2)</seealso>, @@ -4462,17 +4473,13 @@ true</pre> </desc> </func> <func> - <name>erlang:set_cookie(Node, Cookie) -> true</name> + <name name="set_cookie" arity="2"/> <fsummary>Set the magic cookie of a node</fsummary> - <type> - <v>Node = node()</v> - <v>Cookie = atom()</v> - </type> <desc> - <p>Sets the magic cookie of <c>Node</c> to the atom - <c>Cookie</c>. If <c>Node</c> is the local node, the function + <p>Sets the magic cookie of <c><anno>Node</anno></c> to the atom + <c><anno>Cookie</anno></c>. If <c><anno>Node</anno></c> is the local node, the function also sets the cookie of all other unknown nodes to - <c>Cookie</c> (see + <c><anno>Cookie</anno></c> (see <seealso marker="doc/reference_manual:distributed">Distributed Erlang</seealso> in the Erlang Reference Manual).</p> <p>Failure: <c>function_clause</c> if the local node is not alive.</p> @@ -4497,7 +4504,7 @@ true</pre> </desc> </func> <func> - <name>size(Item) -> int()</name> + <name>size(Item) -> integer() >= 0</name> <fsummary>Size of a tuple or binary</fsummary> <type> <v>Item = tuple() | binary()</v> @@ -4512,28 +4519,21 @@ true</pre> </desc> </func> <func> - <name>spawn(Fun) -> pid()</name> + <name name="spawn" arity="1"/> <fsummary>Create a new process with a fun as entry point</fsummary> - <type> - <v>Fun = fun()</v> - </type> <desc> <p>Returns the pid of a new process started by the application - of <c>Fun</c> to the empty list <c>[]</c>. Otherwise works + of <c><anno>Fun</anno></c> to the empty list <c>[]</c>. Otherwise works like <seealso marker="#spawn/3">spawn/3</seealso>.</p> </desc> </func> <func> - <name>spawn(Node, Fun) -> pid()</name> + <name name="spawn" arity="2"/> <fsummary>Create a new process with a fun as entry point on a given node</fsummary> - <type> - <v>Node = node()</v> - <v>Fun = fun()</v> - </type> <desc> <p>Returns the pid of a new process started by the application - of <c>Fun</c> to the empty list <c>[]</c> on <c>Node</c>. If - <c>Node</c> does not exist, a useless pid is returned. + of <c><anno>Fun</anno></c> to the empty list <c>[]</c> on <c><anno>Node</anno></c>. If + <c><anno>Node</anno></c> does not exist, a useless pid is returned. Otherwise works like <seealso marker="#spawn/3">spawn/3</seealso>.</p> </desc> @@ -4564,47 +4564,35 @@ true</pre> </desc> </func> <func> - <name>spawn(Node, Module, Function, Args) -> pid()</name> + <name name="spawn" arity="4"/> <fsummary>Create a new process with a function as entry point on a given node</fsummary> - <type> - <v>Node = node()</v> - <v>Module = Function = atom()</v> - <v>Args = [term()]</v> - </type> <desc> <p>Returns the pid of a new process started by the application - of <c>Module:Function</c> to <c>Args</c> on <c>Node</c>. If - <c>Node</c> does not exists, a useless pid is returned. + of <c><anno>Module</anno>:<anno>Function</anno></c> to <c><anno>Args</anno></c> on <c>Node</c>. If + <c><anno>Node</anno></c> does not exists, a useless pid is returned. Otherwise works like <seealso marker="#spawn/3">spawn/3</seealso>.</p> </desc> </func> <func> - <name>spawn_link(Fun) -> pid()</name> + <name name="spawn_link" arity="1"/> <fsummary>Create and link to a new process with a fun as entry point</fsummary> - <type> - <v>Fun = fun()</v> - </type> <desc> <p>Returns the pid of a new process started by the application - of <c>Fun</c> to the empty list []. A link is created between + of <c><anno>Fun</anno></c> to the empty list []. A link is created between the calling process and the new process, atomically. Otherwise works like <seealso marker="#spawn/3">spawn/3</seealso>.</p> </desc> </func> <func> - <name>spawn_link(Node, Fun) -> pid()</name> + <name name="spawn_link" arity="2"/> <fsummary>Create and link to a new process with a fun as entry point on a specified node</fsummary> - <type> - <v>Node = node()</v> - <v>Fun = fun()</v> - </type> <desc> <p>Returns the pid of a new process started by the application - of <c>Fun</c> to the empty list [] on <c>Node</c>. A link is + of <c><anno>Fun</anno></c> to the empty list [] on <c><anno>Node</anno></c>. A link is created between the calling process and the new process, - atomically. If <c>Node</c> does not exist, a useless pid is + atomically. If <c><anno>Node</anno></c> does not exist, a useless pid is returned (and due to the link, an exit signal with exit reason <c>noconnection</c> will be received). Otherwise works like <seealso marker="#spawn/3">spawn/3</seealso>.</p> @@ -4626,47 +4614,35 @@ true</pre> </desc> </func> <func> - <name>spawn_link(Node, Module, Function, Args) -> pid()</name> + <name name="spawn_link" arity="4"/> <fsummary>Create and link to a new process with a function as entry point on a given node</fsummary> - <type> - <v>Node = node()</v> - <v>Module = Function = atom()</v> - <v>Args = [term()]</v> - </type> <desc> <p>Returns the pid of a new process started by the application - of <c>Module:Function</c> to <c>Args</c> on <c>Node</c>. A + of <c><anno>Module</anno>:<anno>Function</anno></c> to <c><anno>Args</anno></c> on <c>Node</c>. A link is created between the calling process and the new - process, atomically. If <c>Node</c> does not exist, a useless + process, atomically. If <c><anno>Node</anno></c> does not exist, a useless pid is returned (and due to the link, an exit signal with exit reason <c>noconnection</c> will be received). Otherwise works like <seealso marker="#spawn/3">spawn/3</seealso>.</p> </desc> </func> <func> - <name>spawn_monitor(Fun) -> {pid(),reference()}</name> + <name name="spawn_monitor" arity="1"/> <fsummary>Create and monitor a new process with a fun as entry point</fsummary> - <type> - <v>Fun = fun()</v> - </type> <desc> <p>Returns the pid of a new process started by the application - of <c>Fun</c> to the empty list [] and reference for a monitor + of <c><anno>Fun</anno></c> to the empty list [] and reference for a monitor created to the new process. Otherwise works like <seealso marker="#spawn/3">spawn/3</seealso>.</p> </desc> </func> <func> - <name>spawn_monitor(Module, Function, Args) -> {pid(),reference()}</name> + <name name="spawn_monitor" arity="3"/> <fsummary>Create and monitor a new process with a function as entry point</fsummary> - <type> - <v>Module = Function = atom()</v> - <v>Args = [term()]</v> - </type> <desc> <p>A new process is started by the application - of <c>Module:Function</c> to <c>Args</c>, and the process is + of <c><anno>Module</anno>:<anno>Function</anno></c> to <c><anno>Args</anno></c>, and the process is monitored at the same time. Returns the pid and a reference for the monitor. Otherwise works like @@ -4674,19 +4650,11 @@ true</pre> </desc> </func> <func> - <name>spawn_opt(Fun, [Option]) -> pid() | {pid(),reference()}</name> + <name name="spawn_opt" arity="2"/> <fsummary>Create a new process with a fun as entry point</fsummary> - <type> - <v>Fun = fun()</v> - <v>Option = link | monitor | {priority, Level} | {fullsweep_after, Number} | {min_heap_size, Size} | {min_bin_vheap_size, VSize}</v> - <v> Level = low | normal | high</v> - <v> Number = int()</v> - <v> Size = int()</v> - <v> VSize = int()</v> - </type> <desc> <p>Returns the pid of a new process started by the application - of <c>Fun</c> to the empty list <c>[]</c>. Otherwise + of <c><anno>Fun</anno></c> to the empty list <c>[]</c>. Otherwise works like <seealso marker="#spawn_opt/4">spawn_opt/4</seealso>.</p> <p>If the option <c>monitor</c> is given, the newly created @@ -4695,37 +4663,19 @@ true</pre> </desc> </func> <func> - <name>spawn_opt(Node, Fun, [Option]) -> pid()</name> + <name name="spawn_opt" arity="3"/> <fsummary>Create a new process with a fun as entry point on a given node</fsummary> - <type> - <v>Node = node()</v> - <v>Fun = fun()</v> - <v>Option = link | {priority, Level} | {fullsweep_after, Number} | {min_heap_size, Size} | {min_bin_vheap_size, VSize}</v> - <v> Level = low | normal | high</v> - <v> Number = int()</v> - <v> Size = int()</v> - <v> VSize = int()</v> - </type> <desc> <p>Returns the pid of a new process started by the application - of <c>Fun</c> to the empty list <c>[]</c> on <c>Node</c>. If - <c>Node</c> does not exist, a useless pid is returned. + of <c><anno>Fun</anno></c> to the empty list <c>[]</c> on <c><anno>Node</anno></c>. If + <c><anno>Node</anno></c> does not exist, a useless pid is returned. Otherwise works like <seealso marker="#spawn_opt/4">spawn_opt/4</seealso>.</p> </desc> </func> <func> - <name>spawn_opt(Module, Function, Args, [Option]) -> pid() | {pid(),reference()}</name> + <name name="spawn_opt" arity="4"/> <fsummary>Create a new process with a function as entry point</fsummary> - <type> - <v>Module = Function = atom()</v> - <v>Args = [term()]</v> - <v>Option = link | monitor | {priority, Level} | {fullsweep_after, Number} | {min_heap_size, Size} | {min_bin_vheap_size, VSize}</v> - <v> Level = low | normal | high</v> - <v> Number = int()</v> - <v> Size = int()</v> - <v> VSize = int()</v> - </type> <desc> <p>Works exactly like <seealso marker="#spawn/3">spawn/3</seealso>, except that an @@ -4744,17 +4694,17 @@ true</pre> <p>Monitor the new process (just like <seealso marker="#monitor/2">monitor/2</seealso> does).</p> </item> - <tag><c>{priority, Level}</c></tag> + <tag><c>{priority, <anno>Level</anno>}</c></tag> <item> <p>Sets the priority of the new process. Equivalent to executing - <seealso marker="#process_flag_priority">process_flag(priority, Level)</seealso> in the start function of the new process, + <seealso marker="#process_flag_priority">process_flag(priority, <anno>Level</anno>)</seealso> in the start function of the new process, except that the priority will be set before the process is selected for execution for the first time. For more information on priorities see <seealso marker="#process_flag_priority">process_flag(priority, Level)</seealso>.</p> </item> - <tag><c>{fullsweep_after, Number}</c></tag> + <tag><c>{fullsweep_after, <anno>Number</anno>}</c></tag> <item> <p>This option is only useful for performance tuning. In general, you should not use this option unless you @@ -4776,18 +4726,18 @@ true</pre> <p>Here are a few cases when it could be useful to change <c>fullsweep_after</c>. Firstly, if binaries that are no longer used should be thrown away as soon as possible. - (Set <c>Number</c> to zero.) Secondly, a process that + (Set <c><anno>Number</anno></c> to zero.) Secondly, a process that mostly have short-lived data will be fullsweeped seldom or never, meaning that the old heap will contain mostly garbage. To ensure a fullsweep once in a while, set - <c>Number</c> to a suitable value such as 10 or 20. + <c><anno>Number</anno></c> to a suitable value such as 10 or 20. Thirdly, in embedded systems with limited amount of RAM and no virtual memory, one might want to preserve memory - by setting <c>Number</c> to zero. (The value may be set + by setting <c><anno>Number</anno></c> to zero. (The value may be set globally, see <seealso marker="#system_flag/2">erlang:system_flag/2</seealso>.)</p> </item> - <tag><c>{min_heap_size, Size}</c></tag> + <tag><c>{min_heap_size, <anno>Size</anno>}</c></tag> <item> <p>This option is only useful for performance tuning. In general, you should not use this option unless you @@ -4802,9 +4752,9 @@ true</pre> slow down the system due to worse data locality. Therefore, it is recommended to use this option only for fine-tuning an application and to measure the execution - time with various <c>Size</c> values.</p> + time with various <c><anno>Size</anno></c> values.</p> </item> - <tag><c>{min_bin_vheap_size, VSize}</c></tag> + <tag><c>{min_bin_vheap_size, <anno>VSize</anno>}</c></tag> <item> <p>This option is only useful for performance tuning. In general, you should not use this option unless you @@ -4818,29 +4768,19 @@ true</pre> Setting too high value, however, might waste memory. Therefore, it is recommended to use this option only for fine-tuning an application and to measure the execution - time with various <c>VSize</c> values.</p> + time with various <c><anno>VSize</anno></c> values.</p> </item> </taglist> </desc> </func> <func> - <name>spawn_opt(Node, Module, Function, Args, [Option]) -> pid()</name> + <name name="spawn_opt" arity="5"/> <fsummary>Create a new process with a function as entry point on a given node</fsummary> - <type> - <v>Node = node()</v> - <v>Module = Function = atom()</v> - <v>Args = [term()]</v> - <v>Option = link | {priority, Level} | {fullsweep_after, Number} | {min_heap_size, Size} | {min_bin_vheap_size, VSize}</v> - <v> Level = low | normal | high</v> - <v> Number = int()</v> - <v> Size = int()</v> - <v> VSize = int()</v> - </type> <desc> <p>Returns the pid of a new process started by the application - of <c>Module:Function</c> to <c>Args</c> on <c>Node</c>. If - <c>Node</c> does not exist, a useless pid is returned. + of <c><anno>Module</anno>:<anno>Function</anno></c> to <c><anno>Args</anno></c> on <c>Node</c>. If + <c><anno>Node</anno></c> does not exist, a useless pid is returned. Otherwise works like <seealso marker="#spawn_opt/4">spawn_opt/4</seealso>.</p> </desc> @@ -4874,7 +4814,7 @@ true</pre> <name>erlang:start_timer(Time, Dest, Msg) -> TimerRef</name> <fsummary>Start a timer</fsummary> <type> - <v>Time = int()</v> + <v>Time = integer() >= 0</v> <v> 0 <= Time <= 4294967295</v> <v>Dest = LocalPid | RegName </v> <v> LocalPid = pid() (of a process, alive or dead, on the local node)</v> @@ -4983,7 +4923,7 @@ true</pre> </desc> </func> <func> - <name>erlang:suspend_process(Suspendee, OptList) -> true | false</name> + <name>erlang:suspend_process(Suspendee, OptList) -> boolean()</name> <fsummary>Suspend a process</fsummary> <type> <v>Suspendee = pid()</v> @@ -5083,15 +5023,12 @@ true</pre> </desc> </func> <func> - <name>erlang:suspend_process(Suspendee) -> true</name> + <name name="suspend_process" arity="1"/> <fsummary>Suspend a process</fsummary> - <type> - <v>Suspendee = pid()</v> - </type> <desc> - <p>Suspends the process identified by <c>Suspendee</c>. The + <p>Suspends the process identified by <c><anno>Suspendee</anno></c>. The same as calling - <seealso marker="#suspend_process/2">erlang:suspend_process(Suspendee, [])</seealso>. For more information see the documentation of <seealso marker="#suspend_process/2">erlang:suspend_process/2</seealso>. + <seealso marker="#suspend_process/2">erlang:suspend_process(<anno>Suspendee</anno>, [])</seealso>. For more information see the documentation of <seealso marker="#suspend_process/2">erlang:suspend_process/2</seealso>. </p> <warning> <p>This BIF is intended for debugging only.</p> @@ -5416,7 +5353,7 @@ true</pre> <p>Types:</p> <list type="bulleted"> <item><c>Allocator = undefined | glibc</c></item> - <item><c>Version = [int()]</c></item> + <item><c>Version = [integer()]</c></item> <item><c>Features = [atom()]</c></item> <item><c>Settings = [{Subsystem, [{Parameter, Value}]}]</c></item> <item><c>Subsystem = atom()</c></item> @@ -5682,7 +5619,7 @@ true</pre> </item> <tag><c>fullsweep_after</c></tag> <item> - <p>Returns <c>{fullsweep_after, int()}</c> which is the + <p>Returns <c>{fullsweep_after, integer()}</c> which is the <c>fullsweep_after</c> garbage collection setting used by default. For more information see <c>garbage_collection</c> described below.</p> @@ -6050,7 +5987,7 @@ true</pre> <v> MonitorPid = pid()</v> <v> Options = [Option]</v> <v> Option = {long_gc, Time} | {large_heap, Size} | busy_port | busy_dist_port</v> - <v> Time = Size = int()</v> + <v> Time = Size = integer()</v> </type> <desc> <p>Returns the current system monitoring settings set by @@ -6084,7 +6021,7 @@ true</pre> <type> <v>MonitorPid = pid()</v> <v>Option = {long_gc, Time} | {large_heap, Size} | busy_port | busy_dist_port</v> - <v> Time = Size = int()</v> + <v> Time = Size = integer()</v> <v>MonSettings = {OldMonitorPid, [Option]}</v> <v> OldMonitorPid = pid()</v> </type> @@ -6314,7 +6251,7 @@ true</pre> <name>time() -> {Hour, Minute, Second}</name> <fsummary>Current time</fsummary> <type> - <v>Hour = Minute = Second = int()</v> + <v>Hour = Minute = Second = integer() >= 0</v> </type> <desc> <p>Returns the current time as <c>{Hour, Minute, Second}</c>.</p> @@ -6342,11 +6279,11 @@ true</pre> </desc> </func> <func> - <name>erlang:trace(PidSpec, How, FlagList) -> int()</name> + <name>erlang:trace(PidSpec, How, FlagList) -> integer() >= 0</name> <fsummary>Set trace flags for a process or processes</fsummary> <type> <v>PidSpec = pid() | existing | new | all</v> - <v>How = bool()</v> + <v>How = boolean()</v> <v>FlagList = [Flag]</v> <v> Flag -- see below</v> </type> @@ -6747,7 +6684,7 @@ true</pre> <type> <v>PidOrFunc = pid() | new | {Module, Function, Arity} | on_load</v> <v> Module = Function = atom()</v> - <v> Arity = int()</v> + <v> Arity = arity()</v> <v>Item, Res -- see below</v> </type> <desc> @@ -6850,7 +6787,7 @@ true</pre> </desc> </func> <func> - <name>erlang:trace_pattern(MFA, MatchSpec) -> int()</name> + <name>erlang:trace_pattern(MFA, MatchSpec) -> integer() >= 0</name> <fsummary>Set trace patterns for global call tracing</fsummary> <desc> <p>The same as @@ -6859,7 +6796,7 @@ true</pre> </desc> </func> <func> - <name>erlang:trace_pattern(MFA, MatchSpec, FlagList) -> int()</name> + <name>erlang:trace_pattern(MFA, MatchSpec, FlagList) -> integer() >= 0</name> <fsummary>Set trace patterns for tracing of function calls</fsummary> <type> <v>MFA, MatchSpec, FlagList -- see below</v> @@ -7039,7 +6976,7 @@ true</pre> </desc> </func> <func> - <name>trunc(Number) -> int()</name> + <name>trunc(Number) -> integer()</name> <fsummary>Return an integer by the truncating a number</fsummary> <type> <v>Number = number()</v> @@ -7053,7 +6990,7 @@ true</pre> </desc> </func> <func> - <name>tuple_size(Tuple) -> int()</name> + <name>tuple_size(Tuple) -> integer() >= 0</name> <fsummary>Return the size of a tuple</fsummary> <type> <v>Tuple = tuple()</v> @@ -7081,12 +7018,10 @@ true</pre> </desc> </func> <func> - <name>erlang:universaltime() -> {Date, Time}</name> + <name>erlang:universaltime() -> DateTime</name> <fsummary>Current date and time according to Universal Time Coordinated (UTC)</fsummary> <type> - <v>Date = {Year, Month, Day}</v> - <v>Time = {Hour, Minute, Second}</v> - <v> Year = Month = Day = Hour = Minute = Second = int()</v> + <v>DateTime = <seealso marker="calendar#type-datetime">calendar:datetime()</seealso></v> </type> <desc> <p>Returns the current date and time according to Universal @@ -7104,9 +7039,8 @@ true</pre> <name>erlang:universaltime_to_localtime({Date1, Time1}) -> {Date2, Time2}</name> <fsummary>Convert from Universal Time Coordinated (UTC) to local date and time</fsummary> <type> - <v>Date1 = Date2 = {Year, Month, Day}</v> - <v>Time1 = Time2 = {Hour, Minute, Second}</v> - <v> Year = Month = Day = Hour = Minute = Second = int()</v> + <v>Date1 = Date2 = <seealso marker="calendar#type-date">calendar:date()</seealso></v> + <v>Time1 = Time2 = <seealso marker="calendar#type-time">calendar:time()</seealso></v> </type> <desc> <p>Converts Universal Time Coordinated (UTC) date and time to @@ -7193,7 +7127,7 @@ true</pre> </desc> </func> <func> - <name>erlang:yield() -> true</name> + <name name="yield" arity="0"/> <fsummary>Let other processes get a chance to execute</fsummary> <desc> <p>Voluntarily let other processes (if any) get a chance to diff --git a/erts/doc/src/erlsrv.xml b/erts/doc/src/erlsrv.xml index 0dfad2a112..919caa9542 100644 --- a/erts/doc/src/erlsrv.xml +++ b/erts/doc/src/erlsrv.xml @@ -273,7 +273,7 @@ </desc> </func> <func> - <name>erlsrv {start | stop | disable | enable} <service-name></name> + <name>erlsrv {start | start_disabled | stop | disable | enable} <service-name></name> <fsummary>Manipulate the current service status.</fsummary> <desc> <p>These commands are only added for convenience, the normal @@ -287,6 +287,21 @@ service actually is stopped. Enabling a service sets it in automatic mode, that is started at boot. This command cannot set the service to manual. </p> + + <p>The <c>start_disabled</c> command operates on a service + regardless of if it's enabled/disabled or started/stopped. It + does this by first enabling it (regardless of if it's enabled + or not), then starting it (if it's not already started) and + then disabling it. The result will be a disabled but started + service, regardless of its earlier state. This is useful for + starting services temporarily during a release upgrade. The + difference between using <c>start_disabled</c> and the + sequence <c>enable</c>, <c>start</c> and <c>disable</c> is + that all other <c>erlsrv</c> commands are locked out during + the sequence of operations in <c>start_disable</c>, making the + operation atomic from an <c>erlsrv</c> user's point of + view.</p> + </desc> </func> <func> diff --git a/erts/doc/src/erts_alloc.xml b/erts/doc/src/erts_alloc.xml index 51a4a2bca0..90347824d5 100644 --- a/erts/doc/src/erts_alloc.xml +++ b/erts/doc/src/erts_alloc.xml @@ -78,14 +78,20 @@ segments are allocated, cached segments are used if possible instead of creating new segments. This in order to reduce the number of system calls made.</item> + <tag><c>sbmbc_alloc</c></tag> + <item>Allocator used by other allocators for allocation of carriers + where only small blocks are placed. Currently this allocator is + disabled by default.</item> </taglist> <p><c>sys_alloc</c> and <c>fix_alloc</c> are always enabled and cannot be disabled. <c>mseg_alloc</c> is always enabled if it is available and an allocator that uses it is enabled. All other allocators can be <seealso marker="#M_e">enabled or disabled</seealso>. By default all allocators are enabled. - When an allocator is disabled, <c>sys_alloc</c> - is used instead of the disabled allocator.</p> + When an allocator is disabled, <c>sys_alloc</c> is used instead of + the disabled allocator. <c>sbmbc_alloc</c> is an exception. If + <c>sbmbc_alloc</c> is disabled, other allocators will not handle + small blocks in separate carriers.</p> <p>The main idea with the <c>erts_alloc</c> library is to separate memory blocks that are used differently into different memory areas, and by this achieving less memory fragmentation. By @@ -103,15 +109,20 @@ following does <em>not</em> apply to them.</p> <p>An allocator manages multiple areas, called carriers, in which memory blocks are placed. A carrier is either placed in a - separate memory segment (allocated via <c>mseg_alloc</c>) or in - the heap segment (allocated via <c>sys_alloc</c>). Multiblock + separate memory segment (allocated via <c>mseg_alloc</c>), in + the heap segment (allocated via <c>sys_alloc</c>), or inside + another carrier (in case it is a carrier created by + <c>sbmbc_alloc</c>). Multiblock carriers are used for storage of several blocks. Singleblock carriers are used for storage of one block. Blocks that are larger than the value of the singleblock carrier threshold (<seealso marker="#M_sbct">sbct</seealso>) parameter are placed - in singleblock carriers. Blocks smaller than the value of the - <c>sbct</c> parameter are placed in multiblock - carriers. Normally an allocator creates a "main multiblock + in singleblock carriers. Blocks that are smaller than the value + of the <c>sbct</c> parameter are placed in multiblock + carriers. Blocks that are smaller than the small block multiblock + carrier threshold (<seealso marker="#M_sbmbct">sbmbct</seealso>) + will be placed in multiblock carriers only used for small blocks. + Normally an allocator creates a "main multiblock carrier". Main multiblock carriers are never deallocated. The size of the main multiblock carrier is determined by the value of the <seealso marker="#M_mmbcs">mmbcs</seealso> parameter.</p> @@ -133,8 +144,11 @@ <c>sbct</c> parameter should be larger than the value of the <c>lmbcs</c> parameter, the allocator may have to create multiblock carriers that are larger than the value of the - <c>lmbcs</c> parameter, though. Singleblock carriers allocated - via <c>mseg_alloc</c> are sized to whole pages.</p> + <c>lmbcs</c> parameter, though. The size of multiblock carriers + for small blocks is determined by the small block multiblock + carrier size (<seealso marker="#M_sbmbcs">sbmbcs</seealso>). + Singleblock carriers allocated via <c>mseg_alloc</c> are sized + to whole pages.</p> <p>Sizes of carriers allocated via <c>sys_alloc</c> are decided based on the value of the <c>sys_alloc</c> carrier size (<seealso marker="#Muycs">ycs</seealso>) parameter. The size of @@ -166,6 +180,14 @@ used. The time complexity is proportional to log N, where N is the number of free blocks.</p> </item> + <tag>Address order first fit</tag> + <item> + <p>Strategy: Find the block with the lowest address that satisfies the + requested block size.</p> + <p>Implementation: A balanced binary search tree is + used. The time complexity is proportional to log N, where + N is the number of free blocks.</p> + </item> <tag>Good fit</tag> <item> <p>Strategy: Try to find the best fit, but settle for the best fit @@ -194,6 +216,11 @@ </taglist> </section> + <note><p> + Currently only allocators using the best fit and the address order + best fit strategies are able to use "small block multi block carriers". + </p></note> + <section> <marker id="flags"></marker> <title>System Flags Effecting erts_alloc</title> @@ -215,6 +242,7 @@ the currently present allocators:</p> <list type="bulleted"> <item><c>B: binary_alloc</c></item> + <item><c>C: sbmbc_alloc</c></item> <item><c>D: std_alloc</c></item> <item><c>E: ets_alloc</c></item> <item><c>F: fix_alloc</c></item> @@ -300,11 +328,11 @@ subsystem identifier, only the specific allocator identified will be effected:</p> <taglist> - <tag><marker id="M_as"><c><![CDATA[+M<S>as bf|aobf|gf|af]]></c></marker></tag> + <tag><marker id="M_as"><c><![CDATA[+M<S>as bf|aobf|aoff|gf|af]]></c></marker></tag> <item> Allocation strategy. Valid strategies are <c>bf</c> (best fit), - <c>aobf</c> (address order best fit), <c>gf</c> (good fit), - and <c>af</c> (a fit). See + <c>aobf</c> (address order best fit), <c>aoff</c> (address order first fit), + <c>gf</c> (good fit), and <c>af</c> (a fit). See <seealso marker="#strategy">the description of allocation strategies</seealso> in "the <c>alloc_util</c> framework" section.</item> <tag><marker id="M_asbcst"><c><![CDATA[+M<S>asbcst <size>]]></c></marker></tag> <item> @@ -395,6 +423,20 @@ threshold will be placed in singleblock carriers. Blocks smaller than this threshold will be placed in multiblock carriers.</item> + <tag><marker id="M_sbmbcs"><c><![CDATA[+M<S>sbmbcs <size>]]></c></marker></tag> + <item> + Small block multiblock carrier size (in bytes). Memory blocks smaller + than the small block multiblock carrier threshold + (<seealso marker="#M_sbmbct">sbmbct</seealso>) will be placed in + multiblock carriers used for small blocks only. This parameter + determines the size of such carriers. + </item> + <tag><marker id="M_sbmbct"><c><![CDATA[+M<S>sbmbct <size>]]></c></marker></tag> + <item> + Small block multiblock carrier threshold (in bytes). Memory blocks + smaller than this threshold will be placed in multiblock carriers + used for small blocks only. + </item> <tag><marker id="M_smbcs"><c><![CDATA[+M<S>smbcs <size>]]></c></marker></tag> <item> Smallest (<c>mseg_alloc</c>) multiblock carrier size (in diff --git a/erts/doc/src/init.xml b/erts/doc/src/init.xml index b0d0cda4fa..d5c43f6e57 100644 --- a/erts/doc/src/init.xml +++ b/erts/doc/src/init.xml @@ -47,15 +47,12 @@ </description> <funcs> <func> - <name>boot(BootArgs) -> void()</name> + <name name="boot" arity="1"/> <fsummary>Start the Erlang runtime system</fsummary> - <type> - <v>BootArgs = [binary()]</v> - </type> <desc> <p>Starts the Erlang runtime system. This function is called when the emulator is started and coordinates system start-up.</p> - <p><c>BootArgs</c> are all command line arguments except + <p><c><anno>BootArgs</anno></c> are all command line arguments except the emulator flags, that is, flags and plain arguments. See <seealso marker="erts:erl">erl(1)</seealso>.</p> <p><c>init</c> itself interprets some of the flags, see @@ -67,17 +64,12 @@ </desc> </func> <func> - <name>get_argument(Flag) -> {ok, Arg} | error</name> + <name name="get_argument" arity="1"/> <fsummary>Get the values associated with a command line user flag</fsummary> - <type> - <v>Flag = atom()</v> - <v>Arg = [Values]</v> - <v> Values = [string()]</v> - </type> <desc> <p>Returns all values associated with the command line user flag - <c>Flag</c>. If <c>Flag</c> is provided several times, each - <c>Values</c> is returned in preserved order.</p> + <c><anno>Flag</anno></c>. If <c><anno>Flag</anno></c> is provided several times, each + <c><anno>Values</anno></c> is returned in preserved order.</p> <pre> % <input>erl -a b c -a d</input> ... @@ -113,48 +105,37 @@ </desc> </func> <func> - <name>get_arguments() -> Flags</name> + <name name="get_arguments" arity="0"/> <fsummary>Get all command line user flags</fsummary> - <type> - <v>Flags = [{Flag, Values}]</v> - <v> Flag = atom()</v> - <v> Values = [string()]</v> - </type> <desc> <p>Returns all command line flags, as well as the system defined flags, see <c>get_argument/1</c>.</p> </desc> </func> <func> - <name>get_plain_arguments() -> [Arg]</name> + <name name="get_plain_arguments" arity="0"/> <fsummary>Get all non-flag command line arguments</fsummary> - <type> - <v>Arg = string()</v> - </type> <desc> <p>Returns any plain command line arguments as a list of strings (possibly empty).</p> </desc> </func> <func> - <name>get_status() -> {InternalStatus, ProvidedStatus}</name> + <name name="get_status" arity="0"/> <fsummary>Get system status information</fsummary> - <type> - <v>InternalStatus = starting | started | stopping</v> - <v>ProvidedStatus = term()</v> - </type> + <type name="internal_status"/> <desc> <p>The current status of the <c>init</c> process can be inspected. During system startup (initialization), - <c>InternalStatus</c> is <c>starting</c>, and - <c>ProvidedStatus</c> indicates how far the boot script has + <c><anno>InternalStatus</anno></c> is <c>starting</c>, and + <c><anno>ProvidedStatus</anno></c> indicates how far the boot script has been interpreted. Each <c>{progress, Info}</c> term - interpreted in the boot script affects <c>ProvidedStatus</c>, - that is, <c>ProvidedStatus</c> gets the value of <c>Info</c>.</p> + interpreted in the boot script affects <c><anno>ProvidedStatus</anno></c>, + that is, <c><anno>ProvidedStatus</anno></c> gets the value of <c>Info</c>.</p> </desc> </func> <func> - <name>reboot() -> void()</name> + <name name="reboot" arity="0"/> <fsummary>Take down and restart an Erlang node smoothly</fsummary> <desc> <p>All applications are taken down smoothly, all code is @@ -168,7 +149,7 @@ </desc> </func> <func> - <name>restart() -> void()</name> + <name name="restart" arity="0"/> <fsummary>Restart the running Erlang node</fsummary> <desc> <p>The system is restarted <em>inside</em> the running Erlang @@ -183,20 +164,17 @@ </desc> </func> <func> - <name>script_id() -> Id</name> + <name name="script_id" arity="0"/> <fsummary>Get the identity of the used boot script</fsummary> - <type> - <v>Id = term()</v> - </type> <desc> <p>Get the identity of the boot script used to boot the system. - <c>Id</c> can be any Erlang term. In the delivered boot - scripts, <c>Id</c> is <c>{Name, Vsn}</c>. <c>Name</c> and + <c><anno>Id</anno></c> can be any Erlang term. In the delivered boot + scripts, <c><anno>Id</anno></c> is <c>{Name, Vsn}</c>. <c>Name</c> and <c>Vsn</c> are strings.</p> </desc> </func> <func> - <name>stop() -> void()</name> + <name name="stop" arity="0"/> <fsummary>Take down an Erlang node smoothly</fsummary> <desc> <p>All applications are taken down smoothly, all code is @@ -210,15 +188,12 @@ </desc> </func> <func> - <name>stop(Status) -> void()</name> + <name name="stop" arity="1"/> <fsummary>Take down an Erlang node smoothly</fsummary> - <type> - <v>Status = int()>=0 | string()</v> - </type> <desc> <p>All applications are taken down smoothly, all code is unloaded, and all ports are closed before the system - terminates by calling <c>halt(Status)</c>. If the + terminates by calling <c>halt(<anno>Status</anno>)</c>. If the <c>-heart</c> command line flag was given, the <c>heart</c> program is terminated before the Erlang node terminates. Refer to <c>heart(3)</c> for more diff --git a/erts/doc/src/specs.xml b/erts/doc/src/specs.xml new file mode 100644 index 0000000000..e5c2f4783f --- /dev/null +++ b/erts/doc/src/specs.xml @@ -0,0 +1,7 @@ +<?xml version="1.0" encoding="latin1" ?> +<specs xmlns:xi="http://www.w3.org/2001/XInclude"> + <xi:include href="../specs/specs_erl_prim_loader.xml"/> + <xi:include href="../specs/specs_erlang.xml"/> + <xi:include href="../specs/specs_init.xml"/> + <xi:include href="../specs/specs_zlib.xml"/> +</specs> diff --git a/erts/doc/src/start_erl.xml b/erts/doc/src/start_erl.xml index 21cc901f52..6f6930af7e 100644 --- a/erts/doc/src/start_erl.xml +++ b/erts/doc/src/start_erl.xml @@ -69,12 +69,29 @@ <c><![CDATA[erl]]></c> program. Everything <em>after</em><c><![CDATA[++]]></c> is interpreted as options to <c><![CDATA[start_erl]]></c> itself.</item> <tag>-reldir <release root></tag> - <item>Mandatory if the environment variable <c><![CDATA[RELDIR]]></c> is not - specified. Tells start_erl where the root of the - release tree is placed in the file-system - (like <Erlang root>\\releases). The - <c><![CDATA[start_erl.data]]></c> file is expected to be placed in - this directory (if not otherwise specified).</item> + + <item>Mandatory if the environment variable + <c><![CDATA[RELDIR]]></c> is not specified and no + <c>-rootdir</c> option is given. Tells start_erl where the + root of the release tree is placed in the file-system (typically + <Erlang root>\\releases). The + <c><![CDATA[start_erl.data]]></c> file is expected to be + placed in this directory (if not otherwise specified). If + only the <c>-rootdir</c> option is given, the directory is + assumed to be <Erlang root>\\releases.</item> + + <tag>-rootdir <Erlang root directory></tag> + + <item>Mandatory if <c>-reldir</c> is not given and there is + no <c><![CDATA[RELDIR]]></c> in the environment. This + specifies the Erlang installation root directory (under + which the <c>lib</c>, <c>releases</c> and + <c>erts-<Version></c> directories are placed). If only + <c>-reldir</c> (or the environment variable + <c><![CDATA[RELDIR]]></c>) is given, the Erlang root is assumed to + be the directory exactly one level above the release + directory.</item> + <tag>-data <data file name></tag> <item>Optional, specifies another data file than start_erl.data in the <release root>. It is specified relative to the diff --git a/erts/doc/src/zlib.xml b/erts/doc/src/zlib.xml index b1e768bce9..8917ab5c3a 100644 --- a/erts/doc/src/zlib.xml +++ b/erts/doc/src/zlib.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>2005</year><year>2010</year> + <year>2005</year><year>2011</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -76,96 +76,92 @@ list_to_binary([Compressed|Last])</pre> </taglist> </description> - <section> - <title>DATA TYPES</title> - <code type="none"> -iodata = iolist() | binary() - -iolist = [char() | binary() | iolist()] - a binary is allowed as the tail of the list - -zstream = a zlib stream, see open/0</code> - </section> + <datatypes> + <datatype> + <name name="zstream"/> + <desc> + <p>A zlib stream, see <seealso marker="#open/0">open/0</seealso>. + </p> + </desc> + </datatype> + <datatype> + <name name="zlevel"/> + </datatype> + <datatype> + <name name="zmemlevel"/> + </datatype> + <datatype> + <name name="zmethod"/> + </datatype> + <datatype> + <name name="zstrategy"/> + </datatype> + <datatype> + <name name="zwindowbits"/> + <desc> + <p>Normally in the range <c>-15..-9 | 9..15</c>.</p> + </desc> + </datatype> + </datatypes> <funcs> <func> - <name>open() -> Z </name> + <name name="open" arity="0"/> <fsummary>Open a stream and return a stream reference</fsummary> - <type> - <v>Z = zstream()</v> - </type> <desc> <p>Open a zlib stream.</p> </desc> </func> <func> - <name>close(Z) -> ok</name> + <name name="close" arity="1"/> <fsummary>Close a stream</fsummary> - <type> - <v>Z = zstream()</v> - </type> <desc> - <p>Closes the stream referenced by <c>Z</c>.</p> + <p>Closes the stream referenced by <c><anno>Z</anno></c>.</p> </desc> </func> <func> - <name>deflateInit(Z) -> ok</name> + <name name="deflateInit" arity="1"/> <fsummary>Initialize a session for compression</fsummary> - <type> - <v>Z = zstream()</v> - </type> <desc> - <p>Same as <c>zlib:deflateInit(Z, default)</c>.</p> + <p>Same as <c>zlib:deflateInit(<anno>Z</anno>, default)</c>.</p> </desc> </func> <func> - <name>deflateInit(Z, Level) -> ok</name> + <name name="deflateInit" arity="2"/> <fsummary>Initialize a session for compression</fsummary> - <type> - <v>Z = zstream()</v> - <v>Level = none | default | best_speed | best_compression | 0..9</v> - </type> <desc> <p>Initialize a zlib stream for compression.</p> - <p><c>Level</c> decides the compression level to be used, 0 + <p><c><anno>Level</anno></c> decides the compression level to be used, 0 (<c>none</c>), gives no compression at all, 1 (<c>best_speed</c>) gives best speed and 9 (<c>best_compression</c>) gives best compression.</p> </desc> </func> <func> - <name>deflateInit(Z, Level, Method, WindowBits, MemLevel, Strategy) -> ok</name> + <name name="deflateInit" arity="6"/> <fsummary>Initialize a session for compression</fsummary> - <type> - <v>Z = zstream()</v> - <v>Level = none | default | best_speed | best_compression | 0..9</v> - <v>Method = deflated</v> - <v>WindowBits = 9..15|-9..-15</v> - <v>MemLevel = 1..9</v> - <v>Strategy = default|filtered|huffman_only</v> - </type> <desc> <p>Initiates a zlib stream for compression.</p> - <p>The <c>Level</c> parameter decides the compression level to be + <p>The <c><anno>Level</anno></c> parameter decides the compression level to be used, 0 (<c>none</c>), gives no compression at all, 1 (<c>best_speed</c>) gives best speed and 9 (<c>best_compression</c>) gives best compression.</p> - <p>The <c>Method</c> parameter decides which compression method to use, + <p>The <c><anno>Method</anno></c> parameter decides which compression method to use, currently the only supported method is <c>deflated</c>.</p> - <p>The <c>WindowBits</c> parameter is the base two logarithm + <p>The <c><anno>WindowBits</anno></c> parameter is the base two logarithm of the window size (the size of the history buffer). It should be in the range 9 through 15. Larger values of this parameter result in better compression at the expense of memory usage. The default value is 15 if - <c>deflateInit/2</c>. A negative <c>WindowBits</c> + <c>deflateInit/2</c>. A negative <c><anno>WindowBits</anno></c> value suppresses the zlib header (and checksum) from the stream. Note that the zlib source mentions this only as a undocumented feature.</p> - <p>The <c>MemLevel</c> parameter specifies how much memory + <p>The <c><anno>MemLevel</anno></c> parameter specifies how much memory should be allocated for the internal compression - state. <c>MemLevel</c>=1 uses minimum memory but is slow and - reduces compression ratio; <c>MemLevel</c>=9 uses maximum + state. <c><anno>MemLevel</anno></c>=1 uses minimum memory but is slow and + reduces compression ratio; <c><anno>MemLevel</anno></c>=9 uses maximum memory for optimal speed. The default value is 8.</p> - <p>The <c>Strategy</c> parameter is used to tune the + <p>The <c><anno>Strategy</anno></c> parameter is used to tune the compression algorithm. Use the value <c>default</c> for normal data, <c>filtered</c> for data produced by a filter (or predictor), or <c>huffman_only</c> to force Huffman @@ -175,54 +171,43 @@ zstream = a zlib stream, see open/0</code> tuned to compress them better. The effect of <c>filtered</c>is to force more Huffman coding and less string matching; it is somewhat intermediate between - <c>default</c> and <c>huffman_only</c>. The <c>Strategy</c> + <c>default</c> and <c>huffman_only</c>. The <c><anno>Strategy</anno></c> parameter only affects the compression ratio but not the correctness of the compressed output even if it is not set appropriately.</p> </desc> </func> <func> - <name>deflate(Z, Data) -> Compressed</name> + <name name="deflate" arity="2"/> <fsummary>Compress data</fsummary> - <type> - <v>Z = zstream()</v> - <v>Data = iodata()</v> - <v>Compressed = iolist()</v> - </type> <desc> - <p>Same as <c>deflate(Z, Data, none)</c>.</p> + <p>Same as <c>deflate(<anno>Z</anno>, <anno>Data</anno>, none)</c>.</p> </desc> </func> <func> - <name>deflate(Z, Data, Flush) -> </name> + <name name="deflate" arity="3"/> <fsummary>Compress data</fsummary> - <type> - <v>Z = zstream()</v> - <v>Data = iodata()</v> - <v>Flush = none | sync | full | finish</v> - <v>Compressed = iolist()</v> - </type> <desc> <p><c>deflate/3</c> compresses as much data as possible, and stops when the input buffer becomes empty. It may introduce some output latency (reading input without producing any output) except when forced to flush.</p> - <p>If the parameter <c>Flush</c> is set to <c>sync</c>, all + <p>If the parameter <c><anno>Flush</anno></c> is set to <c>sync</c>, all pending output is flushed to the output buffer and the output is aligned on a byte boundary, so that the decompressor can get all input data available so far. Flushing may degrade compression for some compression algorithms and so it should be used only when necessary.</p> - <p>If <c>Flush</c> is set to <c>full</c>, all output is flushed as with + <p>If <c><anno>Flush</anno></c> is set to <c>full</c>, all output is flushed as with <c>sync</c>, and the compression state is reset so that decompression can restart from this point if previous compressed data has been damaged or if random access is desired. Using <c>full</c> too often can seriously degrade the compression.</p> - <p>If the parameter <c>Flush</c> is set to <c>finish</c>, + <p>If the parameter <c><anno>Flush</anno></c> is set to <c>finish</c>, pending input is processed, pending output is flushed and <c>deflate/3</c> returns. Afterwards the only possible operations on the stream are <c>deflateReset/1</c> or <c>deflateEnd/1</c>.</p> - <p><c>Flush</c> can be set to <c>finish</c> immediately after + <p><c><anno>Flush</anno></c> can be set to <c>finish</c> immediately after <c>deflateInit</c> if all compression is to be done in one step.</p> <pre> @@ -234,13 +219,8 @@ list_to_binary([B1,B2])</pre> </desc> </func> <func> - <name>deflateSetDictionary(Z, Dictionary) -> Adler32</name> + <name name="deflateSetDictionary" arity="2"/> <fsummary>Initialize the compression dictionary</fsummary> - <type> - <v>Z = zstream()</v> - <v>Dictionary = binary()</v> - <v>Adler32 = integer()</v> - </type> <desc> <p>Initializes the compression dictionary from the given byte sequence without producing any compressed output. This @@ -253,11 +233,8 @@ list_to_binary([B1,B2])</pre> </desc> </func> <func> - <name>deflateReset(Z) -> ok</name> + <name name="deflateReset" arity="1"/> <fsummary>Reset the deflate session</fsummary> - <type> - <v>Z = zstream()</v> - </type> <desc> <p>This function is equivalent to <c>deflateEnd/1</c> followed by <c>deflateInit/[1|2|6]</c>, but does not free @@ -267,34 +244,26 @@ list_to_binary([B1,B2])</pre> </desc> </func> <func> - <name>deflateParams(Z, Level, Strategy) -> ok </name> + <name name="deflateParams" arity="3"/> <fsummary>Dynamicly update deflate parameters</fsummary> - <type> - <v>Z = zstream()</v> - <v>Level = none | default | best_speed | best_compression | 0..9</v> - <v>Strategy = default|filtered|huffman_only</v> - </type> <desc> <p>Dynamically update the compression level and compression - strategy. The interpretation of <c>Level</c> and - <c>Strategy</c> is as in <c>deflateInit/6</c>. This can be + strategy. The interpretation of <c><anno>Level</anno></c> and + <c><anno>Strategy</anno></c> is as in <c>deflateInit/6</c>. This can be used to switch between compression and straight copy of the input data, or to switch to a different kind of input data requiring a different strategy. If the compression level is changed, the input available so far is compressed with the old level (and may be flushed); the new level will take effect only at the next call of <c>deflate/3</c>.</p> - <p>Before the call of deflateParams, the stream state must be set as for + <p>Before the call of <c>deflateParams</c>, the stream state must be set as for a call of <c>deflate/3</c>, since the currently available input may have to be compressed and flushed.</p> </desc> </func> <func> - <name>deflateEnd(Z) -> ok</name> + <name name="deflateEnd" arity="1"/> <fsummary>End deflate session</fsummary> - <type> - <v>Z = zstream()</v> - </type> <desc> <p>End the deflate session and cleans all data used. Note that this function will throw an <c>data_error</c> @@ -304,43 +273,31 @@ list_to_binary([B1,B2])</pre> </desc> </func> <func> - <name>inflateInit(Z) -> ok </name> + <name name="inflateInit" arity="1"/> <fsummary>Initialize a session for decompression</fsummary> - <type> - <v>Z = zstream()</v> - </type> <desc> <p>Initialize a zlib stream for decompression.</p> </desc> </func> <func> - <name>inflateInit(Z, WindowBits) -> ok </name> + <name name="inflateInit" arity="2"/> <fsummary>Initialize a session for decompression</fsummary> - <type> - <v>Z = zstream()</v> - <v>WindowBits = 9..15|-9..-15</v> - </type> <desc> <p>Initialize decompression session on zlib stream.</p> - <p>The <c>WindowBits</c> parameter is the base two logarithm + <p>The <c><anno>WindowBits</anno></c> parameter is the base two logarithm of the maximum window size (the size of the history buffer). It should be in the range 9 through 15. The default value is 15 if <c>inflateInit/1</c> is used. If a compressed stream with a larger window size is given as input, inflate() will throw the <c>data_error</c> - exception. A negative <c>WindowBits</c> value makes zlib ignore the + exception. A negative <c><anno>WindowBits</anno></c> value makes zlib ignore the zlib header (and checksum) from the stream. Note that the zlib source mentions this only as a undocumented feature.</p> </desc> </func> <func> - <name>inflate(Z, Data) -> DeCompressed </name> + <name name="inflate" arity="2"/> <fsummary>Decompress data</fsummary> - <type> - <v>Z = zstream()</v> - <v>Data = iodata()</v> - <v>DeCompressed = iolist()</v> - </type> <desc> <p><c>inflate/2</c> decompresses as much data as possible. It may some introduce some output latency (reading @@ -353,12 +310,8 @@ list_to_binary([B1,B2])</pre> </desc> </func> <func> - <name>inflateSetDictionary(Z, Dictionary) -> ok</name> + <name name="inflateSetDictionary" arity="2"/> <fsummary>Initialize the decompression dictionary</fsummary> - <type> - <v>Z = zstream()</v> - <v>Dictionary = binary()</v> - </type> <desc> <p>Initializes the decompression dictionary from the given uncompressed byte sequence. This function must be called @@ -381,11 +334,8 @@ unpack(Z, Compressed, Dict) -> </desc> </func> <func> - <name>inflateReset(Z) -> ok</name> + <name name="inflateReset" arity="1"/> <fsummary>>Reset the inflate session</fsummary> - <type> - <v>Z = zstream()</v> - </type> <desc> <p>This function is equivalent to <c>inflateEnd/1</c> followed by <c>inflateInit/1</c>, but does not free and reallocate all @@ -394,11 +344,8 @@ unpack(Z, Compressed, Dict) -> </desc> </func> <func> - <name>inflateEnd(Z) -> ok</name> + <name name="inflateEnd" arity="1"/> <fsummary>End inflate session</fsummary> - <type> - <v>Z = zstream()</v> - </type> <desc> <p>End the inflate session and cleans all data used. Note that this function will throw a <c>data_error</c> exception @@ -407,198 +354,132 @@ unpack(Z, Compressed, Dict) -> </desc> </func> <func> - <name>setBufSize(Z, Size) -> ok</name> + <name name="setBufSize" arity="2"/> <fsummary>Set buffer size</fsummary> - <type> - <v>Z = zstream()</v> - <v>Size = integer()</v> - </type> <desc> <p>Sets the intermediate buffer size.</p> </desc> </func> <func> - <name>getBufSize(Z) -> Size</name> + <name name="getBufSize" arity="1"/> <fsummary>Get buffer size</fsummary> - <type> - <v>Z = zstream()</v> - <v>Size = integer()</v> - </type> <desc> <p>Get the size of intermediate buffer.</p> </desc> </func> <func> - <name>crc32(Z) -> CRC</name> + <name name="crc32" arity="1"/> <fsummary>Get current CRC</fsummary> - <type> - <v>Z = zstream()</v> - <v>CRC = integer()</v> - </type> <desc> <p>Get the current calculated CRC checksum.</p> </desc> </func> <func> - <name>crc32(Z, Binary) -> CRC</name> + <name name="crc32" arity="2"/> <fsummary>Calculate CRC</fsummary> - <type> - <v>Z = zstream()</v> - <v>Binary = binary()</v> - <v>CRC = integer()</v> - </type> <desc> - <p>Calculate the CRC checksum for <c>Binary</c>.</p> + <p>Calculate the CRC checksum for <c><anno>Data</anno></c>.</p> </desc> </func> <func> - <name>crc32(Z, PrevCRC, Binary) -> CRC </name> + <name name="crc32" arity="3"/> <fsummary>Calculate CRC</fsummary> - <type> - <v>Z = zstream()</v> - <v>PrevCRC = integer()</v> - <v>Binary = binary()</v> - <v>CRC = integer()</v> - </type> - <desc> - <p>Update a running CRC checksum for <c>Binary</c>. - If <c>Binary</c> is the empty binary, this function returns + <desc> + <p>Update a running CRC checksum for <c><anno>Data</anno></c>. + If <c><anno>Data</anno></c> is the empty binary or the empty iolist, this function returns the required initial value for the crc.</p> <pre> -Crc = lists:foldl(fun(Bin,Crc0) -> - zlib:crc32(Z, Crc0, Bin), - end, zlib:crc32(Z,<< >>), Bins)</pre> +Crc = lists:foldl(fun(Data,Crc0) -> + zlib:crc32(Z, Crc0, Data), + end, zlib:crc32(Z,<< >>), Datas)</pre> </desc> </func> <func> - <name>crc32_combine(Z, CRC1, CRC2, Size2) -> CRC </name> + <name name="crc32_combine" arity="4"/> <fsummary>Combine two CRC's</fsummary> - <type> - <v>Z = zstream()</v> - <v>CRC = integer()</v> - <v>CRC1 = integer()</v> - <v>CRC2 = integer()</v> - <v>Size2 = integer()</v> - </type> - <desc> - <p>Combine two CRC checksums into one. For two binaries, - <c>Bin1</c> and <c>Bin2</c> with sizes of <c>Size1</c> and - <c>Size2</c>, with CRC checksums <c>CRC1</c> and - <c>CRC2</c>. <c>crc32_combine/4</c> returns the <c>CRC</c> - checksum of <c><<Bin1/binary,Bin2/binary>></c>, requiring - only <c>CRC1</c>, <c>CRC2</c>, and <c>Size2</c>. + <desc> + <p>Combine two CRC checksums into one. For two binaries or iolists, + <c>Data1</c> and <c>Data2</c> with sizes of <c>Size1</c> and + <c><anno>Size2</anno></c>, with CRC checksums <c><anno>CRC1</anno></c> and + <c><anno>CRC2</anno></c>. <c>crc32_combine/4</c> returns the <c><anno>CRC</anno></c> + checksum of <c>[Data1,Data2]</c>, requiring + only <c><anno>CRC1</anno></c>, <c><anno>CRC2</anno></c>, and <c><anno>Size2</anno></c>. </p> </desc> </func> <func> - <name>adler32(Z, Binary) -> Checksum</name> + <name name="adler32" arity="2"/> <fsummary>Calculate the adler checksum</fsummary> - <type> - <v>Z = zstream()</v> - <v>Binary = binary()</v> - <v>Checksum = integer()</v> - </type> <desc> - <p>Calculate the Adler-32 checksum for <c>Binary</c>.</p> + <p>Calculate the Adler-32 checksum for <c><anno>Data</anno></c>.</p> </desc> </func> <func> - <name>adler32(Z, PrevAdler, Binary) -> Checksum</name> + <name name="adler32" arity="3"/> <fsummary>Calculate the adler checksum</fsummary> - <type> - <v>Z = zstream()</v> - <v>PrevAdler = integer()</v> - <v>Binary = binary()</v> - <v>Checksum = integer()</v> - </type> - <desc> - <p>Update a running Adler-32 checksum for <c>Binary</c>. - If <c>Binary</c> is the empty binary, this function returns + <desc> + <p>Update a running Adler-32 checksum for <c><anno>Data</anno></c>. + If <c><anno>Data</anno></c> is the empty binary or the empty iolist, this function returns the required initial value for the checksum.</p> <pre> -Crc = lists:foldl(fun(Bin,Crc0) -> - zlib:adler32(Z, Crc0, Bin), - end, zlib:adler32(Z,<< >>), Bins)</pre> +Crc = lists:foldl(fun(Data,Crc0) -> + zlib:adler32(Z, Crc0, Data), + end, zlib:adler32(Z,<< >>), Datas)</pre> </desc> </func> <func> - <name>adler32_combine(Z, Adler1, Adler2, Size2) -> Adler </name> + <name name="adler32_combine" arity="4"/> <fsummary>Combine two Adler-32 checksums</fsummary> - <type> - <v>Z = zstream()</v> - <v>Adler = integer()</v> - <v>Adler1 = integer()</v> - <v>Adler2 = integer()</v> - <v>Size2 = integer()</v> - </type> - <desc> - <p>Combine two Adler-32 checksums into one. For two binaries, - <c>Bin1</c> and <c>Bin2</c> with sizes of <c>Size1</c> and - <c>Size2</c>, with Adler-32 checksums <c>Adler1</c> and - <c>Adler2</c>. <c>adler32_combine/4</c> returns the <c>Adler</c> - checksum of <c><<Bin1/binary,Bin2/binary>></c>, requiring - only <c>Adler1</c>, <c>Adler2</c>, and <c>Size2</c>. + <desc> + <p>Combine two Adler-32 checksums into one. For two binaries or iolists, + <c>Data1</c> and <c>Data2</c> with sizes of <c>Size1</c> and + <c><anno>Size2</anno></c>, with Adler-32 checksums <c><anno>Adler1</anno></c> and + <c><anno>Adler2</anno></c>. <c>adler32_combine/4</c> returns the <c><anno>Adler</anno></c> + checksum of <c>[Data1,Data2]</c>, requiring + only <c><anno>Adler1</anno></c>, <c><anno>Adler2</anno></c>, and <c><anno>Size2</anno></c>. </p> </desc> </func> <func> - <name>compress(Binary) -> Compressed </name> - <fsummary>Compress a binary with standard zlib functionality</fsummary> - <type> - <v>Binary = Compressed = binary()</v> - </type> + <name name="compress" arity="1"/> + <fsummary>Compress data with standard zlib functionality</fsummary> <desc> - <p>Compress a binary (with zlib headers and checksum).</p> + <p>Compress data (with zlib headers and checksum).</p> </desc> </func> <func> - <name>uncompress(Binary) -> Decompressed</name> - <fsummary>Uncompress a binary with standard zlib functionality</fsummary> - <type> - <v>Binary = Decompressed = binary()</v> - </type> + <name name="uncompress" arity="1"/> + <fsummary>Uncompress data with standard zlib functionality</fsummary> <desc> - <p>Uncompress a binary (with zlib headers and checksum).</p> + <p>Uncompress data (with zlib headers and checksum).</p> </desc> </func> <func> - <name>zip(Binary) -> Compressed</name> - <fsummary>Compress a binary without the zlib headers</fsummary> - <type> - <v>Binary = Compressed = binary()</v> - </type> + <name name="zip" arity="1"/> + <fsummary>Compress data without the zlib headers</fsummary> <desc> - <p>Compress a binary (without zlib headers and checksum).</p> + <p>Compress data (without zlib headers and checksum).</p> </desc> </func> <func> - <name>unzip(Binary) -> Decompressed</name> - <fsummary>Uncompress a binary without the zlib headers</fsummary> - <type> - <v>Binary = Decompressed = binary()</v> - </type> + <name name="unzip" arity="1"/> + <fsummary>Uncompress data without the zlib headers</fsummary> <desc> - <p>Uncompress a binary (without zlib headers and checksum).</p> + <p>Uncompress data (without zlib headers and checksum).</p> </desc> </func> <func> - <name>gzip(Data) -> Compressed</name> - <fsummary>Compress a binary with gz header</fsummary> - <type> - <v>Binary = Compressed = binary()</v> - </type> + <name name="gzip" arity="1"/> + <fsummary>Compress data with gz header</fsummary> <desc> - <p>Compress a binary (with gz headers and checksum).</p> + <p>Compress data (with gz headers and checksum).</p> </desc> </func> <func> - <name>gunzip(Bin) -> Decompressed</name> - <fsummary>Uncompress a binary with gz header</fsummary> - <type> - <v>Binary = Decompressed = binary()</v> - </type> + <name name="gunzip" arity="1"/> + <fsummary>Uncompress data with gz header</fsummary> <desc> - <p>Uncompress a binary (with gz headers and checksum).</p> + <p>Uncompress data (with gz headers and checksum).</p> </desc> </func> </funcs> diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in index d9362a2a8f..b658e79378 100644 --- a/erts/emulator/Makefile.in +++ b/erts/emulator/Makefile.in @@ -742,7 +742,7 @@ RUN_OBJS = \ $(OBJDIR)/erl_bif_re.o $(OBJDIR)/erl_unicode.o \ $(OBJDIR)/packet_parser.o $(OBJDIR)/safe_hash.o \ $(OBJDIR)/erl_zlib.o $(OBJDIR)/erl_nif.o \ - $(OBJDIR)/erl_bif_binary.o + $(OBJDIR)/erl_bif_binary.o $(OBJDIR)/erl_ao_firstfit_alloc.o ifeq ($(TARGET),win32) DRV_OBJS = \ diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c index d76a7d8e9f..2561d7a630 100644 --- a/erts/emulator/beam/beam_bif_load.c +++ b/erts/emulator/beam/beam_bif_load.c @@ -162,6 +162,23 @@ BIF_RETTYPE code_make_stub_module_3(BIF_ALIST_3) return res; } +BIF_RETTYPE +check_old_code_1(BIF_ALIST_1) +{ + Module* modp; + + if (is_not_atom(BIF_ARG_1)) { + BIF_ERROR(BIF_P, BADARG); + } + modp = erts_get_module(BIF_ARG_1); + if (modp == NULL) { /* Doesn't exist. */ + BIF_RET(am_false); + } else if (modp->old_code == NULL) { /* No old code. */ + BIF_RET(am_false); + } + BIF_RET(am_true); +} + Eterm check_process_code_2(BIF_ALIST_2) { @@ -175,6 +192,13 @@ check_process_code_2(BIF_ALIST_2) Eterm res; if (internal_pid_index(BIF_ARG_1) >= erts_max_processes) goto error; + modp = erts_get_module(BIF_ARG_2); + if (modp == NULL) { /* Doesn't exist. */ + return am_false; + } else if (modp->old_code == NULL) { /* No old code. */ + return am_false; + } + #ifdef ERTS_SMP rp = erts_pid2proc_suspend(BIF_P, ERTS_PROC_LOCK_MAIN, BIF_ARG_1, ERTS_PROC_LOCK_MAIN); @@ -188,7 +212,6 @@ check_process_code_2(BIF_ALIST_2) ERTS_BIF_YIELD2(bif_export[BIF_check_process_code_2], BIF_P, BIF_ARG_1, BIF_ARG_2); } - modp = erts_get_module(BIF_ARG_2); res = check_process_code(rp, modp); #ifdef ERTS_SMP if (BIF_P != rp) { @@ -412,11 +435,6 @@ check_process_code(Process* rp, Module* modp) #endif #define INSIDE(a) (start <= (a) && (a) < end) - if (modp == NULL) { /* Doesn't exist. */ - return am_false; - } else if (modp->old_code == NULL) { /* No old code. */ - return am_false; - } /* * Pick up limits for the module. diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index fb90a7d4f7..937b3d9e53 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -3561,7 +3561,7 @@ void process_main(void) * Operands: NotUsed Live Dst */ do_bs_init_bits_known: - num_bytes = (num_bits+7) >> 3; + num_bytes = ((Uint64)num_bits+(Uint64)7) >> 3; if (num_bits & 7) { alloc += ERL_SUB_BIN_SIZE; } diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index 57fe25453d..eb10ae59a8 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -332,20 +332,22 @@ typedef struct { Eterm* func_tab[1]; /* Pointers to each function. */ } LoadedCode; -#define GetTagAndValue(Stp, Tag, Val) \ - do { \ - BeamInstr __w; \ - GetByte(Stp, __w); \ - Tag = __w & 0x07; \ - if ((__w & 0x08) == 0) { \ - Val = __w >> 4; \ - } else if ((__w & 0x10) == 0) { \ - Val = ((__w >> 5) << 8); \ - GetByte(Stp, __w); \ - Val |= __w; \ - } else { \ - if (!get_int_val(Stp, __w, &(Val))) goto load_error; \ - } \ +#define GetTagAndValue(Stp, Tag, Val) \ + do { \ + BeamInstr __w; \ + GetByte(Stp, __w); \ + Tag = __w & 0x07; \ + if ((__w & 0x08) == 0) { \ + Val = __w >> 4; \ + } else if ((__w & 0x10) == 0) { \ + Val = ((__w >> 5) << 8); \ + GetByte(Stp, __w); \ + Val |= __w; \ + } else { \ + int __res = get_tag_and_value(Stp, __w, (Tag), &(Val)); \ + if (__res < 0) goto load_error; \ + Tag = (unsigned) __res; \ + } \ } while (0) @@ -489,8 +491,8 @@ static void load_printf(int line, LoaderState* context, char *fmt, ...); static int transform_engine(LoaderState* st); static void id_to_string(Uint id, char* s); static void new_genop(LoaderState* stp); -static int get_int_val(LoaderState* stp, Uint len_code, BeamInstr* result); -static int get_erlang_integer(LoaderState* stp, Uint len_code, BeamInstr* result); +static int get_tag_and_value(LoaderState* stp, Uint len_code, + unsigned tag, BeamInstr* result); static int new_label(LoaderState* stp); static void new_literal_patch(LoaderState* stp, int pos); static void new_string_patch(LoaderState* stp, int pos); @@ -1470,46 +1472,15 @@ load_code(LoaderState* stp) last_op->arity = 0; ASSERT(arity <= MAX_OPARGS); -#define GetValue(Stp, First, Val) \ - do { \ - if (((First) & 0x08) == 0) { \ - Val = (First) >> 4; \ - } else if (((First) & 0x10) == 0) { \ - BeamInstr __w; \ - GetByte(Stp, __w); \ - Val = (((First) >> 5) << 8) | __w; \ - } else { \ - if (!get_int_val(Stp, (First), &(Val))) goto load_error; \ - } \ - } while (0) - for (arg = 0; arg < arity; arg++) { - BeamInstr first; - - GetByte(stp, first); - last_op->a[arg].type = first & 0x07; + GetTagAndValue(stp, last_op->a[arg].type, last_op->a[arg].val); switch (last_op->a[arg].type) { case TAG_i: - if ((first & 0x08) == 0) { - last_op->a[arg].val = first >> 4; - } else if ((first & 0x10) == 0) { - BeamInstr w; - GetByte(stp, w); - ASSERT(first < 0x800); - last_op->a[arg].val = ((first >> 5) << 8) | w; - } else { - int i = get_erlang_integer(stp, first, &(last_op->a[arg].val)); - if (i < 0) { - goto load_error; - } - last_op->a[arg].type = i; - } - break; case TAG_u: - GetValue(stp, first, last_op->a[arg].val); + case TAG_q: + case TAG_o: break; case TAG_x: - GetValue(stp, first, last_op->a[arg].val); if (last_op->a[arg].val == 0) { last_op->a[arg].type = TAG_r; } else if (last_op->a[arg].val >= MAX_REG) { @@ -1518,7 +1489,6 @@ load_code(LoaderState* stp) } break; case TAG_y: - GetValue(stp, first, last_op->a[arg].val); if (last_op->a[arg].val >= MAX_REG) { LoadError1(stp, "invalid y register number: %u", last_op->a[arg].val); @@ -1526,7 +1496,6 @@ load_code(LoaderState* stp) last_op->a[arg].val += CP_SIZE; break; case TAG_a: - GetValue(stp, first, last_op->a[arg].val); if (last_op->a[arg].val == 0) { last_op->a[arg].type = TAG_n; } else if (last_op->a[arg].val >= stp->num_atoms) { @@ -1536,7 +1505,6 @@ load_code(LoaderState* stp) } break; case TAG_f: - GetValue(stp, first, last_op->a[arg].val); if (last_op->a[arg].val == 0) { last_op->a[arg].type = TAG_p; } else if (last_op->a[arg].val >= stp->num_labels) { @@ -1544,7 +1512,6 @@ load_code(LoaderState* stp) } break; case TAG_h: - GetValue(stp, first, last_op->a[arg].val); if (last_op->a[arg].val > 65535) { LoadError1(stp, "invalid range for character data type: %u", last_op->a[arg].val); @@ -1552,11 +1519,9 @@ load_code(LoaderState* stp) break; case TAG_z: { - BeamInstr ext_tag; unsigned tag; - GetValue(stp, first, ext_tag); - switch (ext_tag) { + switch (last_op->a[arg].val) { case 0: /* Floating point number */ { Eterm* hp; @@ -1648,7 +1613,8 @@ load_code(LoaderState* stp) break; } default: - LoadError1(stp, "invalid extended tag %d", ext_tag); + LoadError1(stp, "invalid extended tag %d", + last_op->a[arg].val); break; } } @@ -1659,7 +1625,6 @@ load_code(LoaderState* stp) } last_op->arity++; } -#undef GetValue ASSERT(arity == last_op->arity); @@ -2562,13 +2527,8 @@ should_gen_heap_bin(LoaderState* stp, GenOpArg Src) static int binary_too_big(LoaderState* stp, GenOpArg Size) { - return Size.type == TAG_u && ((Size.val >> (8*sizeof(Uint)-3)) != 0); -} - -static int -binary_too_big_bits(LoaderState* stp, GenOpArg Size) -{ - return Size.type == TAG_u && (((Size.val+7)/8) >> (8*sizeof(Uint)-3) != 0); + return Size.type == TAG_o || + (Size.type == TAG_u && ((Size.val >> (8*sizeof(Uint)-3)) != 0)); } static GenOp* @@ -4317,41 +4277,9 @@ load_printf(int line, LoaderState* context, char *fmt,...) erts_send_error_to_logger(context->group_leader, dsbufp); } - -static int -get_int_val(LoaderState* stp, Uint len_code, BeamInstr* result) -{ - Uint count; - Uint val; - - len_code >>= 5; - ASSERT(len_code < 8); - if (len_code == 7) { - LoadError0(stp, "can't load integers bigger than 8 bytes yet\n"); - } - count = len_code + 2; - if (count == 5) { - Uint msb; - GetByte(stp, msb); - if (msb == 0) { - count--; - } - GetInt(stp, 4, *result); - } else if (count <= 4) { - GetInt(stp, count, val); - *result = ((val << 8*(sizeof(val)-count)) >> 8*(sizeof(val)-count)); - } else { - LoadError1(stp, "too big integer; %d bytes\n", count); - } - return 1; - - load_error: - return 0; -} - - static int -get_erlang_integer(LoaderState* stp, Uint len_code, BeamInstr* result) +get_tag_and_value(LoaderState* stp, Uint len_code, + unsigned tag, BeamInstr* result) { Uint count; Sint val; @@ -4371,17 +4299,62 @@ get_erlang_integer(LoaderState* stp, Uint len_code, BeamInstr* result) if (len_code < 7) { count = len_code + 2; } else { - Uint tag; + unsigned sztag; UWord len_word; ASSERT(len_code == 7); - GetTagAndValue(stp, tag, len_word); - VerifyTag(stp, TAG_u, tag); + GetTagAndValue(stp, sztag, len_word); + VerifyTag(stp, sztag, TAG_u); count = len_word + 9; } /* - * Handle values up to the size of an int, meaning either a small or bignum. + * The value for tags except TAG_i must be an unsigned integer + * fitting in an Uint. If it does not fit, we'll indicate overflow + * by changing the tag to TAG_o. + */ + + if (tag != TAG_i) { + if (count == sizeof(Uint)+1) { + Uint msb; + + /* + * The encoded value has one more byte than an Uint. + * It will still fit in an Uint if the most significant + * byte is 0. + */ + GetByte(stp, msb); + GetInt(stp, sizeof(Uint), *result); + if (msb != 0) { + /* Overflow: Negative or too big. */ + return TAG_o; + } + } else if (count == sizeof(Uint)) { + /* + * The value must be positive (or the encoded value would + * have been one byte longer). + */ + GetInt(stp, count, *result); + } else if (count < sizeof(Uint)) { + GetInt(stp, count, *result); + + /* + * If the sign bit is set, the value is negative + * (not allowed). + */ + if (*result & ((Uint)1 << (count*8-1))) { + return TAG_o; + } + } else { + GetInt(stp, count, *result); + return TAG_o; + } + return tag; + } + + /* + * TAG_i: First handle values up to the size of an Uint (i.e. either + * a small or a bignum). */ if (count <= sizeof(val)) { diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab index d9dd80fa8b..831c0b1ce6 100644 --- a/erts/emulator/beam/bif.tab +++ b/erts/emulator/beam/bif.tab @@ -87,6 +87,8 @@ bif erlang:exit/2 bif 'erl.lang.proc':signal/2 ebif_signal_2 exit_2 bif erlang:external_size/1 bif 'erl.lang.term':external_size/1 ebif_external_size_1 +bif erlang:external_size/2 +bif 'erl.lang.term':external_size/2 ebif_external_size_2 ubif erlang:float/1 ubif 'erl.lang.number':to_float/1 ebif_to_float_1 float_1 bif erlang:float_to_list/1 @@ -802,6 +804,12 @@ bif prim_file:internal_name2native/1 bif prim_file:internal_native2name/1 bif prim_file:internal_normalize_utf8/1 bif file:native_name_encoding/0 + +# +# New in R14B04. +# +bif erlang:check_old_code/1 + # # Obsolete # diff --git a/erts/emulator/beam/erl_afit_alloc.c b/erts/emulator/beam/erl_afit_alloc.c index e8b594bb47..d397cd8848 100644 --- a/erts/emulator/beam/erl_afit_alloc.c +++ b/erts/emulator/beam/erl_afit_alloc.c @@ -43,9 +43,9 @@ /* Prototypes of callback functions */ static Block_t * get_free_block (Allctr_t *, Uint, - Block_t *, Uint); -static void link_free_block (Allctr_t *, Block_t *); -static void unlink_free_block (Allctr_t *, Block_t *); + Block_t *, Uint, Uint32); +static void link_free_block (Allctr_t *, Block_t *, Uint32); +static void unlink_free_block (Allctr_t *, Block_t *, Uint32); static Eterm info_options (Allctr_t *, char *, int *, @@ -72,6 +72,8 @@ erts_afalc_start(AFAllctr_t *afallctr, is a struct). */ Allctr_t *allctr = (Allctr_t *) afallctr; + init->sbmbct = 0; /* Small mbc not supported by afit */ + sys_memcpy((void *) afallctr, (void *) &nulled_state, sizeof(AFAllctr_t)); allctr->mbc_header_size = sizeof(Carrier_t); @@ -105,7 +107,8 @@ erts_afalc_start(AFAllctr_t *afallctr, } static Block_t * -get_free_block(Allctr_t *allctr, Uint size, Block_t *cand_blk, Uint cand_size) +get_free_block(Allctr_t *allctr, Uint size, Block_t *cand_blk, Uint cand_size, + Uint32 flags) { AFAllctr_t *afallctr = (AFAllctr_t *) allctr; @@ -123,7 +126,7 @@ get_free_block(Allctr_t *allctr, Uint size, Block_t *cand_blk, Uint cand_size) } static void -link_free_block(Allctr_t *allctr, Block_t *block) +link_free_block(Allctr_t *allctr, Block_t *block, Uint32 flags) { AFFreeBlock_t *blk = (AFFreeBlock_t *) block; AFAllctr_t *afallctr = (AFAllctr_t *) allctr; @@ -144,7 +147,7 @@ link_free_block(Allctr_t *allctr, Block_t *block) } static void -unlink_free_block(Allctr_t *allctr, Block_t *block) +unlink_free_block(Allctr_t *allctr, Block_t *block, Uint32 flags) { AFFreeBlock_t *blk = (AFFreeBlock_t *) block; AFAllctr_t *afallctr = (AFAllctr_t *) allctr; diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c index cda404af5e..bbc8a445a7 100644 --- a/erts/emulator/beam/erl_alloc.c +++ b/erts/emulator/beam/erl_alloc.c @@ -50,6 +50,9 @@ #include "erl_bestfit_alloc.h" #define GET_ERL_AF_ALLOC_IMPL #include "erl_afit_alloc.h" +#define GET_ERL_AOFF_ALLOC_IMPL +#include "erl_ao_firstfit_alloc.h" + #define ERTS_ALC_DEFAULT_MAX_THR_PREF 16 @@ -85,15 +88,19 @@ typedef union { char align_bfa[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(BFAllctr_t))]; AFAllctr_t afa; char align_afa[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(AFAllctr_t))]; + AOFFAllctr_t aoffa; + char align_aoffa[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(AOFFAllctr_t))]; } ErtsAllocatorState_t; -static ErtsAllocatorState_t sl_alloc_state; +static ErtsAllocatorState_t sbmbc_alloc_state; static ErtsAllocatorState_t std_alloc_state; static ErtsAllocatorState_t ll_alloc_state; #if HALFWORD_HEAP -static ErtsAllocatorState_t std_alloc_low_state; -static ErtsAllocatorState_t ll_alloc_low_state; +static ErtsAllocatorState_t sbmbc_low_alloc_state; +static ErtsAllocatorState_t std_low_alloc_state; +static ErtsAllocatorState_t ll_low_alloc_state; #endif +static ErtsAllocatorState_t sl_alloc_state; static ErtsAllocatorState_t temp_alloc_state; static ErtsAllocatorState_t eheap_alloc_state; static ErtsAllocatorState_t binary_alloc_state; @@ -120,7 +127,8 @@ static void *fix_core_alloc(Uint size) enum allctr_type { GOODFIT, BESTFIT, - AFIT + AFIT, + AOFIRSTFIT }; struct au_init { @@ -132,6 +140,7 @@ struct au_init { GFAllctrInit_t gf; BFAllctrInit_t bf; AFAllctrInit_t af; + AOFFAllctrInit_t aoff; } init; struct { int mmbcs; @@ -145,7 +154,8 @@ struct au_init { ERTS_DEFAULT_ALLCTR_INIT, \ ERTS_DEFAULT_GF_ALLCTR_INIT, \ ERTS_DEFAULT_BF_ALLCTR_INIT, \ - ERTS_DEFAULT_AF_ALLCTR_INIT \ + ERTS_DEFAULT_AF_ALLCTR_INIT, \ + ERTS_DEFAULT_AOFF_ALLCTR_INIT \ } typedef struct { @@ -162,6 +172,7 @@ typedef struct { char *mtrace; char *nodename; } instr; + struct au_init sbmbc_alloc; struct au_init sl_alloc; struct au_init std_alloc; struct au_init ll_alloc; @@ -171,8 +182,9 @@ typedef struct { struct au_init ets_alloc; struct au_init driver_alloc; #if HALFWORD_HEAP - struct au_init std_alloc_low; - struct au_init ll_alloc_low; + struct au_init sbmbc_low_alloc; + struct au_init std_low_alloc; + struct au_init ll_low_alloc; #endif } erts_alc_hndl_args_init_t; @@ -185,6 +197,34 @@ do { \ } while (0) static void +set_default_sbmbc_alloc_opts(struct au_init *ip) +{ + SET_DEFAULT_ALLOC_OPTS(ip); + ip->enable = 0; + ip->thr_spec = 0; + ip->atype = BESTFIT; + ip->init.bf.ao = 1; + ip->init.util.ramv = 0; + ip->init.util.mmsbc = 0; + ip->init.util.mmmbc = 500; + ip->init.util.sbct = ~((UWord) 0); + ip->init.util.name_prefix = "sbmbc_"; + ip->init.util.alloc_no = ERTS_ALC_A_SBMBC; +#ifndef SMALL_MEMORY + ip->init.util.mmbcs = 2*1024*1024; /* Main carrier size */ +#else + ip->init.util.mmbcs = 1*1024*1024; /* Main carrier size */ +#endif + ip->init.util.ts = ERTS_ALC_MTA_SBMBC; + ip->init.util.asbcst = 0; + ip->init.util.rsbcst = 0; + ip->init.util.rsbcmt = 0; + ip->init.util.rmbcmt = 0; + ip->init.util.sbmbct = 0; + ip->init.util.sbmbcs = 0; +} + +static void set_default_sl_alloc_opts(struct au_init *ip) { SET_DEFAULT_ALLOC_OPTS(ip); @@ -202,6 +242,7 @@ set_default_sl_alloc_opts(struct au_init *ip) ip->init.util.ts = ERTS_ALC_MTA_SHORT_LIVED; ip->init.util.rsbcst = 80; #if HALFWORD_HEAP + ip->init.util.force = 1; ip->init.util.low_mem = 1; #endif @@ -249,6 +290,8 @@ set_default_ll_alloc_opts(struct au_init *ip) ip->init.util.rsbcst = 0; ip->init.util.rsbcmt = 0; ip->init.util.rmbcmt = 0; + ip->init.util.sbmbct = 0; + ip->init.util.sbmbcs = 0; } static void @@ -269,6 +312,7 @@ set_default_temp_alloc_opts(struct au_init *ip) ip->init.util.rsbcst = 90; ip->init.util.rmbcmt = 100; #if HALFWORD_HEAP + ip->init.util.force = 1; ip->init.util.low_mem = 1; #endif } @@ -291,6 +335,7 @@ set_default_eheap_alloc_opts(struct au_init *ip) ip->init.util.ts = ERTS_ALC_MTA_EHEAP; ip->init.util.rsbcst = 50; #if HALFWORD_HEAP + ip->init.util.force = 1; ip->init.util.low_mem = 1; #endif } @@ -436,10 +481,13 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) hdbg_init(); #endif + erts_have_sbmbc_alloc = 0; + erts_sys_alloc_init(); init_thr_ix(erts_no_schedulers); erts_init_utils_mem(); + set_default_sbmbc_alloc_opts(&init.sbmbc_alloc); set_default_sl_alloc_opts(&init.sl_alloc); set_default_std_alloc_opts(&init.std_alloc); set_default_ll_alloc_opts(&init.ll_alloc); @@ -453,6 +501,7 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) handle_args(argc, argv, &init); if (erts_no_schedulers <= 1) { + init.sbmbc_alloc.thr_spec = 0; init.sl_alloc.thr_spec = 0; init.std_alloc.thr_spec = 0; init.ll_alloc.thr_spec = 0; @@ -464,6 +513,7 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) if (init.erts_alloc_config) { /* Adjust flags that erts_alloc_config won't like */ + init.sbmbc_alloc.thr_spec = 0; init.temp_alloc.thr_spec = 0; init.sl_alloc.thr_spec = 0; init.std_alloc.thr_spec = 0; @@ -480,6 +530,7 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) init.temp_alloc.thr_spec = erts_no_schedulers; /* Others must use thread preferred interface */ + adjust_tpref(&init.sbmbc_alloc, erts_no_schedulers); adjust_tpref(&init.sl_alloc, erts_no_schedulers); adjust_tpref(&init.std_alloc, erts_no_schedulers); adjust_tpref(&init.ll_alloc, erts_no_schedulers); @@ -497,6 +548,7 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) * The following allocators cannot be run with afit strategy. * Make sure they don't... */ + refuse_af_strategy(&init.sbmbc_alloc); refuse_af_strategy(&init.sl_alloc); refuse_af_strategy(&init.std_alloc); refuse_af_strategy(&init.ll_alloc); @@ -518,6 +570,7 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) erts_afalc_init(); erts_bfalc_init(); erts_gfalc_init(); + erts_aoffalc_init(); for (i = ERTS_ALC_A_MIN; i <= ERTS_ALC_A_MAX; i++) { erts_allctrs[i].alloc = NULL; @@ -551,19 +604,30 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) #if HALFWORD_HEAP /* Init low memory variants by cloning */ - init.std_alloc_low = init.std_alloc; - init.std_alloc_low.init.util.alloc_no = ERTS_ALC_A_STANDARD_LOW; - init.std_alloc_low.init.util.low_mem = 1; - - init.ll_alloc_low = init.ll_alloc; - init.ll_alloc_low.init.util.alloc_no = ERTS_ALC_A_LONG_LIVED_LOW; - init.ll_alloc_low.init.util.low_mem = 1; - - set_au_allocator(ERTS_ALC_A_STANDARD_LOW, &init.std_alloc_low); - set_au_allocator(ERTS_ALC_A_LONG_LIVED_LOW, &init.ll_alloc_low); + init.sbmbc_low_alloc = init.sbmbc_alloc; + init.sbmbc_low_alloc.init.util.name_prefix = "sbmbc_low_"; + init.sbmbc_low_alloc.init.util.alloc_no = ERTS_ALC_A_SBMBC_LOW; + init.sbmbc_low_alloc.init.util.low_mem = 1; + + init.std_low_alloc = init.std_alloc; + init.std_low_alloc.init.util.name_prefix = "std_low_"; + init.std_low_alloc.init.util.alloc_no = ERTS_ALC_A_STANDARD_LOW; + init.std_low_alloc.init.util.force = 1; + init.std_low_alloc.init.util.low_mem = 1; + + init.ll_low_alloc = init.ll_alloc; + init.ll_low_alloc.init.util.name_prefix = "ll_low_"; + init.ll_low_alloc.init.util.alloc_no = ERTS_ALC_A_LONG_LIVED_LOW; + init.ll_low_alloc.init.util.force = 1; + init.ll_low_alloc.init.util.low_mem = 1; + + set_au_allocator(ERTS_ALC_A_SBMBC_LOW, &init.sbmbc_low_alloc); + set_au_allocator(ERTS_ALC_A_STANDARD_LOW, &init.std_low_alloc); + set_au_allocator(ERTS_ALC_A_LONG_LIVED_LOW, &init.ll_low_alloc); #endif /* HALFWORD */ set_au_allocator(ERTS_ALC_A_TEMPORARY, &init.temp_alloc); + set_au_allocator(ERTS_ALC_A_SBMBC, &init.sbmbc_alloc); set_au_allocator(ERTS_ALC_A_SHORT_LIVED, &init.sl_alloc); set_au_allocator(ERTS_ALC_A_STANDARD, &init.std_alloc); set_au_allocator(ERTS_ALC_A_LONG_LIVED, &init.ll_alloc); @@ -593,6 +657,20 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) erts_mtrace_init(init.instr.mtrace, init.instr.nodename); + /* sbmbc_alloc() needs to be started first */ + start_au_allocator(ERTS_ALC_A_SBMBC, + &init.sbmbc_alloc, + &sbmbc_alloc_state); +#if HALFWORD_HEAP + start_au_allocator(ERTS_ALC_A_SBMBC_LOW, + &init.sbmbc_low_alloc, + &sbmbc_low_alloc_state); + erts_have_sbmbc_alloc = (init.sbmbc_alloc.enable + && init.sbmbc_low_alloc.enable); +#else + erts_have_sbmbc_alloc = init.sbmbc_alloc.enable; +#endif + start_au_allocator(ERTS_ALC_A_TEMPORARY, &init.temp_alloc, &temp_alloc_state); @@ -610,11 +688,11 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) &ll_alloc_state); #if HALFWORD_HEAP start_au_allocator(ERTS_ALC_A_LONG_LIVED_LOW, - &init.ll_alloc_low, - &ll_alloc_low_state); + &init.ll_low_alloc, + &ll_low_alloc_state); start_au_allocator(ERTS_ALC_A_STANDARD_LOW, - &init.std_alloc_low, - &std_alloc_low_state); + &init.std_low_alloc, + &std_low_alloc_state); #endif start_au_allocator(ERTS_ALC_A_EHEAP, &init.eheap_alloc, @@ -680,14 +758,11 @@ set_au_allocator(ErtsAlcType_t alctr_n, struct au_init *init) ErtsAllocatorInfo_t *ai = &erts_allctrs_info[alctr_n]; ErtsAllocatorThrSpec_t *tspec = &erts_allctr_thr_spec[alctr_n]; -#if HALFWORD_HEAP - /* If halfword heap, silently ignore any disabling of internal - * allocators for low memory + /* + * Some allocators are forced on if halfword heap is used. */ - if (init->init.util.low_mem) { + if (init->init.util.force) init->enable = 1; - } -#endif if (!init->enable) { af->alloc = erts_sys_alloc; @@ -837,6 +912,12 @@ start_au_allocator(ErtsAlcType_t alctr_n, &init->init.af, &init->init.util); break; + case AOFIRSTFIT: + as = (void *) erts_aoffalc_start((AOFFAllctr_t *) as0, + &init->init.aoff, + &init->init.util); + break; + default: as = NULL; ASSERT(0); @@ -947,6 +1028,20 @@ get_kb_value(char *param_end, char** argv, int* ip) } static Uint +get_byte_value(char *param_end, char** argv, int* ip) +{ + Sint tmp; + char *rest; + char *param = argv[*ip]+1; + char *value = get_value(param_end, argv, ip); + errno = 0; + tmp = (Sint) strtol(value, &rest, 10); + if (errno != 0 || rest == value || tmp < 0) + bad_value(param, param_end, value); + return (Uint) tmp; +} + +static Uint get_amount_value(char *param_end, char** argv, int* ip) { Sint tmp; @@ -1017,6 +1112,9 @@ handle_au_arg(struct au_init *auip, else if (strcmp("af", alg) == 0) { auip->atype = AFIT; } + else if (strcmp("aoff", alg) == 0) { + auip->atype = AOFIRSTFIT; + } else { bad_value(param, sub_param + 1, alg); } @@ -1085,6 +1183,12 @@ handle_au_arg(struct au_init *auip, if(has_prefix("sbct", sub_param)) { auip->init.util.sbct = get_kb_value(sub_param + 4, argv, ip); } + else if (has_prefix("sbmbcs", sub_param)) { + auip->init.util.sbmbcs = get_byte_value(sub_param + 6, argv, ip); + } + else if (has_prefix("sbmbct", sub_param)) { + auip->init.util.sbmbct = get_byte_value(sub_param + 6, argv, ip); + } else if (has_prefix("smbcs", sub_param)) { auip->default_.smbcs = 0; auip->init.util.smbcs = get_kb_value(sub_param + 5, argv, ip); @@ -1123,6 +1227,7 @@ static void handle_args(int *argc, char **argv, erts_alc_hndl_args_init_t *init) { struct au_init *aui[] = { + &init->sbmbc_alloc, &init->binary_alloc, &init->std_alloc, &init->ets_alloc, @@ -1150,6 +1255,9 @@ handle_args(int *argc, char **argv, erts_alc_hndl_args_init_t *init) case 'B': handle_au_arg(&init->binary_alloc, &argv[i][3], argv, &i); break; + case 'C': + handle_au_arg(&init->sbmbc_alloc, &argv[i][3], argv, &i); + break; case 'D': handle_au_arg(&init->std_alloc, &argv[i][3], argv, &i); break; @@ -1856,12 +1964,16 @@ erts_memory(int *print_to_p, void *print_to_arg, void *proc, Eterm earg) return am_badarg; } - /* All alloc_util allocators *have* to be enabled */ + /* All alloc_util allocators except sbmbc_alloc *have* to be enabled */ for (ai = ERTS_ALC_A_MIN; ai <= ERTS_ALC_A_MAX; ai++) { switch (ai) { case ERTS_ALC_A_SYSTEM: case ERTS_ALC_A_FIXED_SIZE: + case ERTS_ALC_A_SBMBC: +#if HALFWORD_HEAP + case ERTS_ALC_A_SBMBC_LOW: +#endif break; default: if (!erts_allctrs_info[ai].enabled @@ -1901,6 +2013,12 @@ erts_memory(int *print_to_p, void *print_to_arg, void *proc, Eterm earg) * Often not thread safe and usually never * contain any allocated memory. */ + case ERTS_ALC_A_SBMBC: + /* Included in other allocators */ +#if HALFWORD_HEAP + case ERTS_ALC_A_SBMBC_LOW: + /* Included in other allocators */ +#endif continue; case ERTS_ALC_A_EHEAP: save = &size.processes; @@ -2882,6 +3000,7 @@ unsigned long erts_alc_test(unsigned long op, case 0x2: return erts_bfalc_test(op, a1, a2); case 0x3: return erts_afalc_test(op, a1, a2); case 0x4: return erts_mseg_test(op, a1, a2, a3); + case 0x5: return erts_aoffalc_test(op, a1, a2); case 0xf: switch (op) { case 0xf00: @@ -2925,6 +3044,7 @@ unsigned long erts_alc_test(unsigned long op, init.atype = GOODFIT; init.init.util.name_prefix = (char *) a1; init.init.util.ts = a2 ? 1 : 0; + init.init.util.sbmbct = 0; if ((char **) a3) { char **argv = (char **) a3; @@ -2960,6 +3080,14 @@ unsigned long erts_alc_test(unsigned long op, &init.init.af, &init.init.util); break; + case AOFIRSTFIT: + allctr = erts_aoffalc_start((AOFFAllctr_t *) + erts_alloc(ERTS_ALC_T_UNDEF, + sizeof(AOFFAllctr_t)), + &init.init.aoff, + &init.init.util); + break; + default: ASSERT(0); allctr = NULL; diff --git a/erts/emulator/beam/erl_alloc.h b/erts/emulator/beam/erl_alloc.h index ce792d4d17..c35a60da22 100644 --- a/erts/emulator/beam/erl_alloc.h +++ b/erts/emulator/beam/erl_alloc.h @@ -99,6 +99,14 @@ unsigned long erts_alc_test(unsigned long, #define ERTS_ALC_MIN_LONG_LIVED_TIME (10*60*1000) +#if HALFWORD_HEAP +#define ERTS_IS_SBMBC_ALLOCATOR_NO__(NO) \ + ((NO) == ERTS_ALC_A_SBMBC || (NO) == ERTS_ALC_A_SBMBC_LOW) +#else +#define ERTS_IS_SBMBC_ALLOCATOR_NO__(NO) \ + ((NO) == ERTS_ALC_A_SBMBC) +#endif + typedef struct { int alloc_util; int enabled; diff --git a/erts/emulator/beam/erl_alloc.types b/erts/emulator/beam/erl_alloc.types index c6cc0e1fac..eda0831441 100644 --- a/erts/emulator/beam/erl_alloc.types +++ b/erts/emulator/beam/erl_alloc.types @@ -65,6 +65,11 @@ allocator SYSTEM true sys_alloc +allocator SBMBC true sbmbc_alloc ++if halfword +allocator SBMBC_LOW true sbmbc_low_alloc ++endif + +if smp allocator TEMPORARY true temp_alloc @@ -76,8 +81,8 @@ allocator ETS true ets_alloc allocator FIXED_SIZE true fix_alloc +if halfword -allocator LONG_LIVED_LOW true ll_alloc_low -allocator STANDARD_LOW true std_alloc_low +allocator LONG_LIVED_LOW true ll_low_alloc +allocator STANDARD_LOW true std_low_alloc +endif +else # Non smp build @@ -91,8 +96,8 @@ allocator ETS false ets_alloc allocator FIXED_SIZE false fix_alloc +if halfword -allocator LONG_LIVED_LOW false ll_alloc_low -allocator STANDARD_LOW false std_alloc_low +allocator LONG_LIVED_LOW false ll_low_alloc +allocator STANDARD_LOW false std_low_alloc +endif +endif @@ -134,6 +139,7 @@ class SYSTEM system_data # # <TYPE> <ALLOCATOR> <CLASS> <DESCRIPTION> +type SBMBC SBMBC SYSTEM small_block_mbc type PROC FIXED_SIZE PROCESSES proc type ATOM FIXED_SIZE ATOM atom_entry type MODULE FIXED_SIZE CODE module_entry @@ -330,6 +336,7 @@ type SSB SHORT_LIVED PROCESSES ssb +if halfword +type SBMBC_LOW SBMBC_LOW SYSTEM small_block_mbc_low type DDLL_PROCESS STANDARD_LOW SYSTEM ddll_processes type MONITOR_LH STANDARD_LOW PROCESSES monitor_lh type NLINK_LH STANDARD_LOW PROCESSES nlink_lh diff --git a/erts/emulator/beam/erl_alloc_util.c b/erts/emulator/beam/erl_alloc_util.c index cc04ef65bf..d51ed0c36d 100644 --- a/erts/emulator/beam/erl_alloc_util.c +++ b/erts/emulator/beam/erl_alloc_util.c @@ -66,6 +66,7 @@ static int atoms_initialized = 0; static int initialized = 0; +int erts_have_sbmbc_alloc; #if HAVE_ERTS_MSEG @@ -85,8 +86,6 @@ static int initialized = 0; #undef ASSERT #define ASSERT ASSERT_EXPR -#define ERTS_ALCU_FLG_FAIL_REALLOC_MOVE ((UWord) 1) - #if 0 /* Can be useful for debugging */ #define MBC_REALLOC_ALWAYS_MOVES @@ -275,14 +274,26 @@ static void check_blk_carrier(Allctr_t *, Block_t *); #ifdef DEBUG #define DEBUG_CHECK_CARRIER_NO_SZ(AP) \ - ASSERT(((AP)->sbcs.curr_mseg.no && (AP)->sbcs.curr_mseg.size) \ - || (!(AP)->sbcs.curr_mseg.no && !(AP)->sbcs.curr_mseg.size));\ - ASSERT(((AP)->sbcs.curr_sys_alloc.no && (AP)->sbcs.curr_sys_alloc.size)\ - || (!(AP)->sbcs.curr_sys_alloc.no && !(AP)->sbcs.curr_sys_alloc.size));\ - ASSERT(((AP)->mbcs.curr_mseg.no && (AP)->mbcs.curr_mseg.size) \ - || (!(AP)->mbcs.curr_mseg.no && !(AP)->mbcs.curr_mseg.size));\ - ASSERT(((AP)->mbcs.curr_sys_alloc.no && (AP)->mbcs.curr_sys_alloc.size)\ - || (!(AP)->mbcs.curr_sys_alloc.no && !(AP)->mbcs.curr_sys_alloc.size)) + ASSERT(((AP)->sbcs.curr.norm.mseg.no \ + && (AP)->sbcs.curr.norm.mseg.size) \ + || (!(AP)->sbcs.curr.norm.mseg.no \ + && !(AP)->sbcs.curr.norm.mseg.size)); \ + ASSERT(((AP)->sbcs.curr.norm.sys_alloc.no \ + && (AP)->sbcs.curr.norm.sys_alloc.size) \ + || (!(AP)->sbcs.curr.norm.sys_alloc.no \ + && !(AP)->sbcs.curr.norm.sys_alloc.size)); \ + ASSERT(((AP)->mbcs.curr.norm.mseg.no \ + && (AP)->mbcs.curr.norm.mseg.size) \ + || (!(AP)->mbcs.curr.norm.mseg.no \ + && !(AP)->mbcs.curr.norm.mseg.size)); \ + ASSERT(((AP)->mbcs.curr.norm.sys_alloc.no \ + && (AP)->mbcs.curr.norm.sys_alloc.size) \ + || (!(AP)->mbcs.curr.norm.sys_alloc.no \ + && !(AP)->mbcs.curr.norm.sys_alloc.size)); \ + ASSERT(((AP)->sbmbcs.curr.small_block.no \ + && (AP)->sbmbcs.curr.small_block.size) \ + || (!(AP)->sbmbcs.curr.small_block.no \ + && !(AP)->sbmbcs.curr.small_block.size)) #else #define DEBUG_CHECK_CARRIER_NO_SZ(AP) @@ -292,27 +303,27 @@ static void check_blk_carrier(Allctr_t *, Block_t *); (AP)->sbcs.blocks.curr.size += (BSZ); \ if ((AP)->sbcs.blocks.max.size < (AP)->sbcs.blocks.curr.size) \ (AP)->sbcs.blocks.max.size = (AP)->sbcs.blocks.curr.size; \ - if ((AP)->sbcs.max.no < ((AP)->sbcs.curr_mseg.no \ - + (AP)->sbcs.curr_sys_alloc.no)) \ - (AP)->sbcs.max.no = ((AP)->sbcs.curr_mseg.no \ - + (AP)->sbcs.curr_sys_alloc.no); \ - if ((AP)->sbcs.max.size < ((AP)->sbcs.curr_mseg.size \ - + (AP)->sbcs.curr_sys_alloc.size)) \ - (AP)->sbcs.max.size = ((AP)->sbcs.curr_mseg.size \ - + (AP)->sbcs.curr_sys_alloc.size) + if ((AP)->sbcs.max.no < ((AP)->sbcs.curr.norm.mseg.no \ + + (AP)->sbcs.curr.norm.sys_alloc.no)) \ + (AP)->sbcs.max.no = ((AP)->sbcs.curr.norm.mseg.no \ + + (AP)->sbcs.curr.norm.sys_alloc.no); \ + if ((AP)->sbcs.max.size < ((AP)->sbcs.curr.norm.mseg.size \ + + (AP)->sbcs.curr.norm.sys_alloc.size)) \ + (AP)->sbcs.max.size = ((AP)->sbcs.curr.norm.mseg.size \ + + (AP)->sbcs.curr.norm.sys_alloc.size) #define STAT_MSEG_SBC_ALLOC(AP, CSZ, BSZ) \ do { \ - (AP)->sbcs.curr_mseg.no++; \ - (AP)->sbcs.curr_mseg.size += (CSZ); \ + (AP)->sbcs.curr.norm.mseg.no++; \ + (AP)->sbcs.curr.norm.mseg.size += (CSZ); \ STAT_SBC_ALLOC((AP), (BSZ)); \ DEBUG_CHECK_CARRIER_NO_SZ((AP)); \ } while (0) #define STAT_SYS_ALLOC_SBC_ALLOC(AP, CSZ, BSZ) \ do { \ - (AP)->sbcs.curr_sys_alloc.no++; \ - (AP)->sbcs.curr_sys_alloc.size += (CSZ); \ + (AP)->sbcs.curr.norm.sys_alloc.no++; \ + (AP)->sbcs.curr.norm.sys_alloc.size += (CSZ); \ STAT_SBC_ALLOC((AP), (BSZ)); \ DEBUG_CHECK_CARRIER_NO_SZ((AP)); \ } while (0) @@ -324,85 +335,111 @@ do { \ #define STAT_MSEG_SBC_FREE(AP, CSZ, BSZ) \ do { \ - ASSERT((AP)->sbcs.curr_mseg.no > 0); \ - (AP)->sbcs.curr_mseg.no--; \ - ASSERT((AP)->sbcs.curr_mseg.size >= (CSZ)); \ - (AP)->sbcs.curr_mseg.size -= (CSZ); \ + ASSERT((AP)->sbcs.curr.norm.mseg.no > 0); \ + (AP)->sbcs.curr.norm.mseg.no--; \ + ASSERT((AP)->sbcs.curr.norm.mseg.size >= (CSZ)); \ + (AP)->sbcs.curr.norm.mseg.size -= (CSZ); \ STAT_SBC_FREE((AP), (BSZ)); \ DEBUG_CHECK_CARRIER_NO_SZ((AP)); \ } while (0) #define STAT_SYS_ALLOC_SBC_FREE(AP, CSZ, BSZ) \ do { \ - ASSERT((AP)->sbcs.curr_sys_alloc.no > 0); \ - (AP)->sbcs.curr_sys_alloc.no--; \ - ASSERT((AP)->sbcs.curr_sys_alloc.size >= (CSZ)); \ - (AP)->sbcs.curr_sys_alloc.size -= (CSZ); \ + ASSERT((AP)->sbcs.curr.norm.sys_alloc.no > 0); \ + (AP)->sbcs.curr.norm.sys_alloc.no--; \ + ASSERT((AP)->sbcs.curr.norm.sys_alloc.size >= (CSZ)); \ + (AP)->sbcs.curr.norm.sys_alloc.size -= (CSZ); \ STAT_SBC_FREE((AP), (BSZ)); \ DEBUG_CHECK_CARRIER_NO_SZ((AP)); \ } while (0) #define STAT_MBC_ALLOC(AP) \ - if ((AP)->mbcs.max.no < ((AP)->mbcs.curr_mseg.no \ - + (AP)->mbcs.curr_sys_alloc.no)) \ - (AP)->mbcs.max.no = ((AP)->mbcs.curr_mseg.no \ - + (AP)->mbcs.curr_sys_alloc.no); \ - if ((AP)->mbcs.max.size < ((AP)->mbcs.curr_mseg.size \ - + (AP)->mbcs.curr_sys_alloc.size)) \ - (AP)->mbcs.max.size = ((AP)->mbcs.curr_mseg.size \ - + (AP)->mbcs.curr_sys_alloc.size) + if ((AP)->mbcs.max.no < ((AP)->mbcs.curr.norm.mseg.no \ + + (AP)->mbcs.curr.norm.sys_alloc.no)) \ + (AP)->mbcs.max.no = ((AP)->mbcs.curr.norm.mseg.no \ + + (AP)->mbcs.curr.norm.sys_alloc.no); \ + if ((AP)->mbcs.max.size < ((AP)->mbcs.curr.norm.mseg.size \ + + (AP)->mbcs.curr.norm.sys_alloc.size)) \ + (AP)->mbcs.max.size = ((AP)->mbcs.curr.norm.mseg.size \ + + (AP)->mbcs.curr.norm.sys_alloc.size) + +#define STAT_SBMBC_ALLOC(AP, CSZ) \ +do { \ + (AP)->sbmbcs.curr.small_block.no++; \ + (AP)->sbmbcs.curr.small_block.size += (CSZ); \ + if ((AP)->sbmbcs.max.no < (AP)->sbmbcs.curr.small_block.no) \ + (AP)->sbmbcs.max.no = (AP)->sbmbcs.curr.small_block.no; \ + if ((AP)->sbmbcs.max.size < (AP)->sbmbcs.curr.small_block.size) \ + (AP)->sbmbcs.max.size = (AP)->sbmbcs.curr.small_block.size; \ + DEBUG_CHECK_CARRIER_NO_SZ((AP)); \ +} while (0) #define STAT_MSEG_MBC_ALLOC(AP, CSZ) \ do { \ - (AP)->mbcs.curr_mseg.no++; \ - (AP)->mbcs.curr_mseg.size += (CSZ); \ + (AP)->mbcs.curr.norm.mseg.no++; \ + (AP)->mbcs.curr.norm.mseg.size += (CSZ); \ STAT_MBC_ALLOC((AP)); \ DEBUG_CHECK_CARRIER_NO_SZ((AP)); \ } while (0) #define STAT_SYS_ALLOC_MBC_ALLOC(AP, CSZ) \ do { \ - (AP)->mbcs.curr_sys_alloc.no++; \ - (AP)->mbcs.curr_sys_alloc.size += (CSZ); \ + (AP)->mbcs.curr.norm.sys_alloc.no++; \ + (AP)->mbcs.curr.norm.sys_alloc.size += (CSZ); \ STAT_MBC_ALLOC((AP)); \ DEBUG_CHECK_CARRIER_NO_SZ((AP)); \ } while (0) +#define STAT_SBMBC_FREE(AP, CSZ) \ +do { \ + ASSERT((AP)->sbmbcs.curr.small_block.no > 0); \ + (AP)->sbmbcs.curr.small_block.no--; \ + ASSERT((AP)->sbmbcs.curr.small_block.size >= (CSZ)); \ + (AP)->sbmbcs.curr.small_block.size -= (CSZ); \ + DEBUG_CHECK_CARRIER_NO_SZ((AP)); \ +} while (0) + #define STAT_MSEG_MBC_FREE(AP, CSZ) \ do { \ - ASSERT((AP)->mbcs.curr_mseg.no > 0); \ - (AP)->mbcs.curr_mseg.no--; \ - ASSERT((AP)->mbcs.curr_mseg.size >= (CSZ)); \ - (AP)->mbcs.curr_mseg.size -= (CSZ); \ + ASSERT((AP)->mbcs.curr.norm.mseg.no > 0); \ + (AP)->mbcs.curr.norm.mseg.no--; \ + ASSERT((AP)->mbcs.curr.norm.mseg.size >= (CSZ)); \ + (AP)->mbcs.curr.norm.mseg.size -= (CSZ); \ DEBUG_CHECK_CARRIER_NO_SZ((AP)); \ } while (0) #define STAT_SYS_ALLOC_MBC_FREE(AP, CSZ) \ do { \ - ASSERT((AP)->mbcs.curr_sys_alloc.no > 0); \ - (AP)->mbcs.curr_sys_alloc.no--; \ - ASSERT((AP)->mbcs.curr_sys_alloc.size >= (CSZ)); \ - (AP)->mbcs.curr_sys_alloc.size -= (CSZ); \ + ASSERT((AP)->mbcs.curr.norm.sys_alloc.no > 0); \ + (AP)->mbcs.curr.norm.sys_alloc.no--; \ + ASSERT((AP)->mbcs.curr.norm.sys_alloc.size >= (CSZ)); \ + (AP)->mbcs.curr.norm.sys_alloc.size -= (CSZ); \ DEBUG_CHECK_CARRIER_NO_SZ((AP)); \ } while (0) -#define STAT_MBC_BLK_ALLOC(AP, BSZ) \ +#define STAT_MBC_BLK_ALLOC(AP, BSZ, FLGS) \ do { \ - (AP)->mbcs.blocks.curr.no++; \ - if ((AP)->mbcs.blocks.max.no < (AP)->mbcs.blocks.curr.no) \ - (AP)->mbcs.blocks.max.no = (AP)->mbcs.blocks.curr.no; \ - (AP)->mbcs.blocks.curr.size += (BSZ); \ - if ((AP)->mbcs.blocks.max.size < (AP)->mbcs.blocks.curr.size) \ - (AP)->mbcs.blocks.max.size = (AP)->mbcs.blocks.curr.size; \ + CarriersStats_t *cstats__ = (((FLGS) & ERTS_ALCU_FLG_SBMBC) \ + ? &(AP)->sbmbcs \ + : &(AP)->mbcs); \ + cstats__->blocks.curr.no++; \ + if (cstats__->blocks.max.no < cstats__->blocks.curr.no) \ + cstats__->blocks.max.no = cstats__->blocks.curr.no; \ + cstats__->blocks.curr.size += (BSZ); \ + if (cstats__->blocks.max.size < cstats__->blocks.curr.size) \ + cstats__->blocks.max.size = cstats__->blocks.curr.size; \ } while (0) -#define STAT_MBC_BLK_FREE(AP, BSZ) \ +#define STAT_MBC_BLK_FREE(AP, BSZ, FLGS) \ do { \ - ASSERT((AP)->mbcs.blocks.curr.no > 0); \ - (AP)->mbcs.blocks.curr.no--; \ - ASSERT((AP)->mbcs.blocks.curr.size >= (BSZ)); \ - (AP)->mbcs.blocks.curr.size -= (BSZ); \ + CarriersStats_t *cstats__ = (((FLGS) & ERTS_ALCU_FLG_SBMBC) \ + ? &(AP)->sbmbcs \ + : &(AP)->mbcs); \ + ASSERT(cstats__->blocks.curr.no > 0); \ + cstats__->blocks.curr.no--; \ + ASSERT(cstats__->blocks.curr.size >= (BSZ)); \ + cstats__->blocks.curr.size -= (BSZ); \ } while (0) /* Debug stuff... */ @@ -410,7 +447,7 @@ do { \ static UWord carrier_alignment; #define DEBUG_SAVE_ALIGNMENT(C) \ do { \ - UWord algnmnt__ = sizeof(Unit_t) - (((UWord) (C)) % sizeof(Unit_t)); \ + UWord algnmnt__ = sizeof(Unit_t) - (((UWord) (C)) % sizeof(Unit_t));\ carrier_alignment = MIN(carrier_alignment, algnmnt__); \ ASSERT(((UWord) (C)) % sizeof(UWord) == 0); \ } while (0) @@ -524,8 +561,8 @@ static Uint get_next_mbc_size(Allctr_t *allctr) { Uint size; - int cs = (allctr->mbcs.curr_mseg.no - + allctr->mbcs.curr_sys_alloc.no + int cs = (allctr->mbcs.curr.norm.mseg.no + + allctr->mbcs.curr.norm.sys_alloc.no - (allctr->main_carrier ? 1 : 0)); ASSERT(cs >= 0); @@ -609,7 +646,8 @@ unlink_carrier(CarrierList_t *cl, Carrier_t *crr) } } - +static Block_t *create_sbmbc(Allctr_t *allctr, Uint umem_sz); +static void destroy_sbmbc(Allctr_t *allctr, Block_t *blk); static Block_t *create_carrier(Allctr_t *, Uint, UWord); static void destroy_carrier(Allctr_t *, Block_t *); @@ -619,39 +657,57 @@ static void destroy_carrier(Allctr_t *, Block_t *); * block in a sbc. */ static ERTS_INLINE void * -mbc_alloc_block(Allctr_t *allctr, Uint size, Uint *blk_szp) +mbc_alloc_block(Allctr_t *allctr, Uint size, Uint *blk_szp, Uint32 *alcu_flgsp) { Block_t *blk; + Uint get_blk_sz; + Uint sbmbct; ASSERT(size); ASSERT(size < allctr->sbc_threshold); - *blk_szp = UMEMSZ2BLKSZ(allctr, size); + *blk_szp = get_blk_sz = UMEMSZ2BLKSZ(allctr, size); + + sbmbct = allctr->sbmbc_threshold; + if (sbmbct) { + if (get_blk_sz < sbmbct) { + *alcu_flgsp |= ERTS_ALCU_FLG_SBMBC; + if (get_blk_sz + allctr->min_block_size > sbmbct) { + /* Since we use block size to determine if blocks are + located in sbmbc or not... */ + get_blk_sz += allctr->min_block_size; + } + } + } - blk = (*allctr->get_free_block)(allctr, *blk_szp, NULL, 0); + blk = (*allctr->get_free_block)(allctr, get_blk_sz, NULL, 0, *alcu_flgsp); -#if HALFWORD_HEAP if (!blk) { - blk = create_carrier(allctr, *blk_szp, CFLG_MBC|CFLG_FORCE_MSEG); - } + if ((*alcu_flgsp) & ERTS_ALCU_FLG_SBMBC) + blk = create_sbmbc(allctr, get_blk_sz); + else { +#if HALFWORD_HEAP + blk = create_carrier(allctr, get_blk_sz, CFLG_MBC|CFLG_FORCE_MSEG); #else - if (!blk) { - blk = create_carrier(allctr, *blk_szp, CFLG_MBC); - if (!blk) { - /* Emergency! We couldn't create the carrier as we wanted. - Try to place it in a sys_alloced sbc. */ - blk = create_carrier(allctr, - size, - CFLG_SBC|CFLG_FORCE_SIZE|CFLG_FORCE_SYS_ALLOC); + blk = create_carrier(allctr, get_blk_sz, CFLG_MBC); + if (!blk) { + /* Emergency! We couldn't create the carrier as we wanted. + Try to place it in a sys_alloced sbc. */ + blk = create_carrier(allctr, + size, + (CFLG_SBC + | CFLG_FORCE_SIZE + | CFLG_FORCE_SYS_ALLOC)); + } +#endif } } -#endif #ifdef ERTS_ALLOC_UTIL_HARD_DEBUG if (IS_MBC_BLK(blk)) { - (*allctr->link_free_block)(allctr, blk); + (*allctr->link_free_block)(allctr, blk, *alcu_flgsp); HARD_CHECK_BLK_CARRIER(allctr, blk); - (*allctr->unlink_free_block)(allctr, blk); + (*allctr->unlink_free_block)(allctr, blk, *alcu_flgsp); } #endif @@ -664,7 +720,8 @@ mbc_alloc_finalize(Allctr_t *allctr, Uint org_blk_sz, UWord flags, Uint want_blk_sz, - int valid_blk_info) + int valid_blk_info, + Uint32 alcu_flgs) { Uint blk_sz; Uint nxt_blk_sz; @@ -700,7 +757,7 @@ mbc_alloc_finalize(Allctr_t *allctr, SET_PREV_BLK_FREE(nxt_nxt_blk); } } - (*allctr->link_free_block)(allctr, nxt_blk); + (*allctr->link_free_block)(allctr, nxt_blk, alcu_flgs); ASSERT(IS_NOT_LAST_BLK(blk)); ASSERT(IS_FREE_BLK(nxt_blk)); @@ -741,7 +798,7 @@ mbc_alloc_finalize(Allctr_t *allctr, : IS_NOT_LAST_BLK(blk)); } - STAT_MBC_BLK_ALLOC(allctr, blk_sz); + STAT_MBC_BLK_ALLOC(allctr, blk_sz, alcu_flgs); ASSERT(IS_ALLOCED_BLK(blk)); ASSERT(blk_sz == BLK_SZ(blk)); @@ -761,7 +818,8 @@ mbc_alloc(Allctr_t *allctr, Uint size) { Block_t *blk; Uint blk_sz; - blk = mbc_alloc_block(allctr, size, &blk_sz); + Uint32 alcu_flgs = 0; + blk = mbc_alloc_block(allctr, size, &blk_sz, &alcu_flgs); if (!blk) return NULL; if (IS_MBC_BLK(blk)) @@ -770,7 +828,8 @@ mbc_alloc(Allctr_t *allctr, Uint size) BLK_SZ(blk), GET_BLK_HDR_FLGS(blk), blk_sz, - 1); + 1, + alcu_flgs); return BLK2UMEM(blk); } @@ -779,6 +838,7 @@ mbc_free(Allctr_t *allctr, void *p) { Uint is_first_blk; Uint is_last_blk; + Uint32 alcu_flgs = 0; Uint blk_sz; Block_t *blk; Block_t *nxt_blk; @@ -788,13 +848,15 @@ mbc_free(Allctr_t *allctr, void *p) blk = UMEM2BLK(p); blk_sz = BLK_SZ(blk); + if (blk_sz < allctr->sbmbc_threshold) + alcu_flgs |= ERTS_ALCU_FLG_SBMBC; ASSERT(IS_MBC_BLK(blk)); ASSERT(blk_sz >= allctr->min_block_size); HARD_CHECK_BLK_CARRIER(allctr, blk); - STAT_MBC_BLK_FREE(allctr, blk_sz); + STAT_MBC_BLK_FREE(allctr, blk_sz, alcu_flgs); is_first_blk = IS_FIRST_BLK(blk); is_last_blk = IS_LAST_BLK(blk); @@ -802,7 +864,7 @@ mbc_free(Allctr_t *allctr, void *p) if (!is_first_blk && IS_PREV_BLK_FREE(blk)) { /* Coalesce with previous block... */ blk = PREV_BLK(blk); - (*allctr->unlink_free_block)(allctr, blk); + (*allctr->unlink_free_block)(allctr, blk, alcu_flgs); blk_sz += BLK_SZ(blk); is_first_blk = IS_FIRST_BLK(blk); @@ -818,7 +880,7 @@ mbc_free(Allctr_t *allctr, void *p) nxt_blk = NXT_BLK(blk); if (IS_FREE_BLK(nxt_blk)) { /* Coalesce with next block... */ - (*allctr->unlink_free_block)(allctr, nxt_blk); + (*allctr->unlink_free_block)(allctr, nxt_blk, alcu_flgs); blk_sz += BLK_SZ(nxt_blk); SET_BLK_SZ(blk, blk_sz); @@ -850,16 +912,20 @@ mbc_free(Allctr_t *allctr, void *p) if (is_first_blk && is_last_blk - && allctr->main_carrier != FBLK2MBC(allctr, blk)) - destroy_carrier(allctr, blk); + && allctr->main_carrier != FBLK2MBC(allctr, blk)) { + if (alcu_flgs & ERTS_ALCU_FLG_SBMBC) + destroy_sbmbc(allctr, blk); + else + destroy_carrier(allctr, blk); + } else { - (*allctr->link_free_block)(allctr, blk); + (*allctr->link_free_block)(allctr, blk, alcu_flgs); HARD_CHECK_BLK_CARRIER(allctr, blk); } } static void * -mbc_realloc(Allctr_t *allctr, void *p, Uint size, UWord flgs) +mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs) { void *new_p; Uint old_blk_sz; @@ -867,7 +933,7 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, UWord flgs) #ifndef MBC_REALLOC_ALWAYS_MOVES Block_t *new_blk, *cand_blk; Uint cand_blk_sz; - Uint blk_sz; + Uint blk_sz, get_blk_sz; Block_t *nxt_blk; Uint nxt_blk_sz; Uint is_last_blk; @@ -883,10 +949,16 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, UWord flgs) ASSERT(old_blk_sz >= allctr->min_block_size); #ifdef MBC_REALLOC_ALWAYS_MOVES - if (flgs & ERTS_ALCU_FLG_FAIL_REALLOC_MOVE) + if (alcu_flgs & ERTS_ALCU_FLG_FAIL_REALLOC_MOVE) return NULL; #else /* !MBC_REALLOC_ALWAYS_MOVES */ - blk_sz = UMEMSZ2BLKSZ(allctr, size); + get_blk_sz = blk_sz = UMEMSZ2BLKSZ(allctr, size); + if ((alcu_flgs & ERTS_ALCU_FLG_SBMBC) + && (blk_sz + allctr->min_block_size > allctr->sbmbc_threshold)) { + /* Since we use block size to determine if blocks are + located in sbmbc or not... */ + get_blk_sz = blk_sz + allctr->min_block_size; + } ASSERT(IS_ALLOCED_BLK(blk)); ASSERT(IS_MBC_BLK(blk)); @@ -901,6 +973,9 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, UWord flgs) Uint diff_sz_val = old_blk_sz - blk_sz; Uint old_blk_sz_val = old_blk_sz; + if (get_blk_sz >= old_blk_sz) + return p; + if (diff_sz_val >= (~((Uint) 0) / 100)) { /* div both by 128 */ old_blk_sz_val >>= 7; @@ -909,7 +984,7 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, UWord flgs) /* Avoid fragmentation by moving the block if it is shrunk much */ if (100*diff_sz_val > allctr->mbc_move_threshold*old_blk_sz_val) { - if (flgs & ERTS_ALCU_FLG_FAIL_REALLOC_MOVE) + if (alcu_flgs & ERTS_ALCU_FLG_FAIL_REALLOC_MOVE) return NULL; cand_blk_sz = old_blk_sz; @@ -926,9 +1001,10 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, UWord flgs) } new_blk = (*allctr->get_free_block)(allctr, - blk_sz, + get_blk_sz, cand_blk, - cand_blk_sz); + cand_blk_sz, + alcu_flgs); if (new_blk || cand_blk != blk) goto move_into_new_blk; @@ -952,8 +1028,8 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, UWord flgs) nxt_blk_sz, SBH_THIS_FREE|SBH_PREV_ALLOCED|SBH_NOT_LAST_BLK); - STAT_MBC_BLK_FREE(allctr, old_blk_sz); - STAT_MBC_BLK_ALLOC(allctr, blk_sz); + STAT_MBC_BLK_FREE(allctr, old_blk_sz, alcu_flgs); + STAT_MBC_BLK_ALLOC(allctr, blk_sz, alcu_flgs); ASSERT(BLK_SZ(blk) >= allctr->min_block_size); @@ -964,7 +1040,7 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, UWord flgs) if (IS_FREE_BLK(nxt_nxt_blk)) { /* Coalesce with next free block... */ nxt_blk_sz += BLK_SZ(nxt_nxt_blk); - (*allctr->unlink_free_block)(allctr, nxt_nxt_blk); + (*allctr->unlink_free_block)(allctr, nxt_nxt_blk, alcu_flgs); SET_BLK_SZ(nxt_blk, nxt_blk_sz); is_last_blk = IS_LAST_BLK(nxt_nxt_blk); @@ -979,7 +1055,7 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, UWord flgs) } } - (*allctr->link_free_block)(allctr, nxt_blk); + (*allctr->link_free_block)(allctr, nxt_blk, alcu_flgs); ASSERT(IS_ALLOCED_BLK(blk)); @@ -1009,12 +1085,12 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, UWord flgs) if (!is_last_blk) { nxt_blk = NXT_BLK(blk); nxt_blk_sz = BLK_SZ(nxt_blk); - if (IS_FREE_BLK(nxt_blk) && blk_sz <= old_blk_sz + nxt_blk_sz) { + if (IS_FREE_BLK(nxt_blk) && get_blk_sz <= old_blk_sz + nxt_blk_sz) { /* Grow into next block... */ HARD_CHECK_BLK_CARRIER(allctr, blk); - (*allctr->unlink_free_block)(allctr, nxt_blk); + (*allctr->unlink_free_block)(allctr, nxt_blk, alcu_flgs); nxt_blk_sz -= blk_sz - old_blk_sz; is_last_blk = IS_LAST_BLK(nxt_blk); @@ -1051,13 +1127,13 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, UWord flgs) else SET_BLK_SZ_FTR(nxt_blk, nxt_blk_sz); - (*allctr->link_free_block)(allctr, nxt_blk); + (*allctr->link_free_block)(allctr, nxt_blk, alcu_flgs); ASSERT(IS_FREE_BLK(nxt_blk)); } - STAT_MBC_BLK_FREE(allctr, old_blk_sz); - STAT_MBC_BLK_ALLOC(allctr, blk_sz); + STAT_MBC_BLK_FREE(allctr, old_blk_sz, alcu_flgs); + STAT_MBC_BLK_ALLOC(allctr, blk_sz, alcu_flgs); ASSERT(IS_ALLOCED_BLK(blk)); @@ -1088,7 +1164,7 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, UWord flgs) } } - if (flgs & ERTS_ALCU_FLG_FAIL_REALLOC_MOVE) + if (alcu_flgs & ERTS_ALCU_FLG_FAIL_REALLOC_MOVE) return NULL; /* Need to grow in another block */ @@ -1108,7 +1184,7 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, UWord flgs) } } - if (cand_blk_sz < blk_sz) { + if (cand_blk_sz < get_blk_sz) { /* We wont fit in cand_blk get a new one */ #endif /* !MBC_REALLOC_ALWAYS_MOVES */ @@ -1127,9 +1203,10 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, UWord flgs) /* We will at least fit in cand_blk */ new_blk = (*allctr->get_free_block)(allctr, - blk_sz, + get_blk_sz, cand_blk, - cand_blk_sz); + cand_blk_sz, + alcu_flgs); move_into_new_blk: /* * new_blk, and cand_blk have to be correctly set @@ -1142,7 +1219,8 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, UWord flgs) BLK_SZ(new_blk), GET_BLK_HDR_FLGS(new_blk), blk_sz, - 1); + 1, + alcu_flgs); new_p = BLK2UMEM(new_blk); sys_memcpy(new_p, p, MIN(size, old_blk_sz - ABLK_HDR_SZ)); mbc_free(allctr, p); @@ -1164,7 +1242,7 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, UWord flgs) HARD_CHECK_BLK_CARRIER(allctr, blk); - (*allctr->unlink_free_block)(allctr, new_blk); /* prev */ + (*allctr->unlink_free_block)(allctr, new_blk, alcu_flgs); /* prev */ if (is_last_blk) new_blk_flgs |= LAST_BLK_HDR_FLG; @@ -1173,7 +1251,7 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, UWord flgs) if (IS_FREE_BLK(nxt_blk)) { new_blk_flgs |= GET_LAST_BLK_HDR_FLG(nxt_blk); new_blk_sz += BLK_SZ(nxt_blk); - (*allctr->unlink_free_block)(allctr, nxt_blk); + (*allctr->unlink_free_block)(allctr, nxt_blk, alcu_flgs); } } @@ -1196,9 +1274,10 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, UWord flgs) new_blk_sz, new_blk_flgs, blk_sz, - 0); + 0, + alcu_flgs); - STAT_MBC_BLK_FREE(allctr, old_blk_sz); + STAT_MBC_BLK_FREE(allctr, old_blk_sz, alcu_flgs); return new_p; } @@ -1243,6 +1322,100 @@ do { \ #define CHECK_1BLK_CARRIER(A, SBC, MSEGED, C, CSZ, B, BSZ) #endif +static Block_t * +create_sbmbc(Allctr_t *allctr, Uint umem_sz) +{ + Block_t *blk; + Uint blk_sz; + Uint crr_sz = allctr->sbmbc_size; + Carrier_t *crr; + +#if HALFWORD_HEAP + if (allctr->mseg_opt.low_mem) + crr = erts_alloc(ERTS_ALC_T_SBMBC_LOW, crr_sz); + else +#endif + crr = erts_alloc(ERTS_ALC_T_SBMBC, crr_sz); + + INC_CC(allctr->calls.sbmbc_alloc); + SET_CARRIER_HDR(crr, crr_sz, SCH_SYS_ALLOC|SCH_MBC); + + blk = MBC2FBLK(allctr, crr); + +#ifdef ERTS_ALLOC_UTIL_HARD_DEBUG + if (allctr->mbc_header_size % sizeof(Unit_t) == 0) + crr_sz -= sizeof(UWord); +#endif + + blk_sz = UNIT_FLOOR(crr_sz - allctr->mbc_header_size); + + SET_MBC_BLK_FTR(((UWord *) blk)[-1]); + SET_BLK_HDR(blk, blk_sz, SBH_THIS_FREE|SBH_PREV_FREE|SBH_LAST_BLK); + +#ifdef ERTS_ALLOC_UTIL_HARD_DEBUG + *((Carrier_t **) NXT_BLK(blk)) = crr; +#endif + + link_carrier(&allctr->sbmbc_list, crr); + +#ifdef ERTS_ALLOC_UTIL_HARD_DEBUG + if (allctr->mbc_header_size % sizeof(Unit_t) == 0) + crr_sz += sizeof(UWord); +#endif + + STAT_SBMBC_ALLOC(allctr, crr_sz); + CHECK_1BLK_CARRIER(allctr, 0, 0, crr, crr_sz, blk, blk_sz); +#ifdef ERTS_ALLOC_UTIL_HARD_DEBUG + if (allctr->mbc_header_size % sizeof(Unit_t) == 0) + crr_sz -= sizeof(UWord); +#endif + if (allctr->creating_mbc) + (*allctr->creating_mbc)(allctr, crr, ERTS_ALCU_FLG_SBMBC); + + DEBUG_SAVE_ALIGNMENT(crr); + return blk; +} + +static void +destroy_sbmbc(Allctr_t *allctr, Block_t *blk) +{ + Uint crr_sz; + Carrier_t *crr; + + ASSERT(IS_FIRST_BLK(blk)); + + ASSERT(IS_MBC_BLK(blk)); + + crr = FBLK2MBC(allctr, blk); + crr_sz = CARRIER_SZ(crr); + +#ifdef DEBUG + if (!allctr->stopped) { + ASSERT(IS_LAST_BLK(blk)); + +#ifdef ERTS_ALLOC_UTIL_HARD_DEBUG + (*allctr->link_free_block)(allctr, blk, ERTS_ALCU_FLG_SBMBC); + HARD_CHECK_BLK_CARRIER(allctr, blk); + (*allctr->unlink_free_block)(allctr, blk, ERTS_ALCU_FLG_SBMBC); +#endif + } +#endif + + STAT_SBMBC_FREE(allctr, crr_sz); + + unlink_carrier(&allctr->sbmbc_list, crr); + if (allctr->destroying_mbc) + (*allctr->destroying_mbc)(allctr, crr, ERTS_ALCU_FLG_SBMBC); + + INC_CC(allctr->calls.sbmbc_free); + +#if HALFWORD_HEAP + if (allctr->mseg_opt.low_mem) + erts_free(ERTS_ALC_T_SBMBC_LOW, crr); + else +#endif + erts_free(ERTS_ALC_T_SBMBC, crr); +} static Block_t * create_carrier(Allctr_t *allctr, Uint umem_sz, UWord flags) @@ -1271,11 +1444,11 @@ create_carrier(Allctr_t *allctr, Uint umem_sz, UWord flags) if (erts_mseg_no() >= max_mseg_carriers) goto try_sys_alloc; if (flags & CFLG_SBC) { - if (allctr->sbcs.curr_mseg.no >= allctr->max_mseg_sbcs) + if (allctr->sbcs.curr.norm.mseg.no >= allctr->max_mseg_sbcs) goto try_sys_alloc; } else { - if (allctr->mbcs.curr_mseg.no >= allctr->max_mseg_mbcs) + if (allctr->mbcs.curr.norm.mseg.no >= allctr->max_mseg_mbcs) goto try_sys_alloc; } @@ -1289,7 +1462,7 @@ create_carrier(Allctr_t *allctr, Uint umem_sz, UWord flags) if (crr_sz < allctr->mbc_header_size + blk_sz) crr_sz = allctr->mbc_header_size + blk_sz; #ifdef ERTS_ALLOC_UTIL_HARD_DEBUG - if (sizeof(Unit_t) == sizeof(UWord)) + if (allctr->mbc_header_size % sizeof(Unit_t) == 0) crr_sz += sizeof(UWord); #endif } @@ -1330,7 +1503,7 @@ create_carrier(Allctr_t *allctr, Uint umem_sz, UWord flags) && bcrr_sz < allctr->smallest_mbc_size) bcrr_sz = allctr->smallest_mbc_size; #ifdef ERTS_ALLOC_UTIL_HARD_DEBUG - if (sizeof(Unit_t) == sizeof(UWord)) + if (allctr->mbc_header_size % sizeof(Unit_t) == 0) bcrr_sz += sizeof(UWord); #endif @@ -1385,7 +1558,7 @@ create_carrier(Allctr_t *allctr, Uint umem_sz, UWord flags) blk = MBC2FBLK(allctr, crr); #ifdef ERTS_ALLOC_UTIL_HARD_DEBUG - if (sizeof(Unit_t) == sizeof(UWord)) + if (allctr->mbc_header_size % sizeof(Unit_t) == 0) crr_sz -= sizeof(UWord); #endif @@ -1406,16 +1579,16 @@ create_carrier(Allctr_t *allctr, Uint umem_sz, UWord flags) link_carrier(&allctr->mbc_list, crr); #ifdef ERTS_ALLOC_UTIL_HARD_DEBUG - if (sizeof(Unit_t) == sizeof(UWord)) + if (allctr->mbc_header_size % sizeof(Unit_t) == 0) crr_sz += sizeof(UWord); #endif CHECK_1BLK_CARRIER(allctr, 0, is_mseg, crr, crr_sz, blk, blk_sz); #ifdef ERTS_ALLOC_UTIL_HARD_DEBUG - if (sizeof(Unit_t) == sizeof(UWord)) + if (allctr->mbc_header_size % sizeof(Unit_t) == 0) crr_sz -= sizeof(UWord); #endif if (allctr->creating_mbc) - (*allctr->creating_mbc)(allctr, crr); + (*allctr->creating_mbc)(allctr, crr, 0); } @@ -1595,9 +1768,9 @@ destroy_carrier(Allctr_t *allctr, Block_t *blk) ASSERT(IS_LAST_BLK(blk)); #ifdef ERTS_ALLOC_UTIL_HARD_DEBUG - (*allctr->link_free_block)(allctr, blk); + (*allctr->link_free_block)(allctr, blk, 0); HARD_CHECK_BLK_CARRIER(allctr, blk); - (*allctr->unlink_free_block)(allctr, blk); + (*allctr->unlink_free_block)(allctr, blk, 0); #endif } #endif @@ -1614,7 +1787,7 @@ destroy_carrier(Allctr_t *allctr, Block_t *blk) unlink_carrier(&allctr->mbc_list, crr); if (allctr->destroying_mbc) - (*allctr->destroying_mbc)(allctr, crr); + (*allctr->destroying_mbc)(allctr, crr, 0); } @@ -1658,12 +1831,15 @@ static struct { Eterm lmbcs; Eterm smbcs; Eterm mbcgs; + Eterm sbmbcs; + Eterm sbmbct; #if HAVE_ERTS_MSEG Eterm mmc; #endif Eterm ycs; + /* Eterm sbmbcs; */ Eterm mbcs; Eterm sbcs; Eterm sys_alloc_carriers_size; @@ -1688,6 +1864,8 @@ static struct { Eterm mseg_dealloc; Eterm mseg_realloc; #endif + Eterm sbmbc_alloc; + Eterm sbmbc_free; #ifdef DEBUG Eterm end_of_atoms; #endif @@ -1746,12 +1924,15 @@ init_atoms(Allctr_t *allctr) AM_INIT(lmbcs); AM_INIT(smbcs); AM_INIT(mbcgs); + AM_INIT(sbmbcs); + AM_INIT(sbmbct); #if HAVE_ERTS_MSEG AM_INIT(mmc); #endif AM_INIT(ycs); + /*AM_INIT(sbmbcs);*/ AM_INIT(mbcs); AM_INIT(sbcs); AM_INIT(sys_alloc_carriers_size); @@ -1776,6 +1957,8 @@ init_atoms(Allctr_t *allctr) AM_INIT(mseg_dealloc); AM_INIT(mseg_realloc); #endif + AM_INIT(sbmbc_free); + AM_INIT(sbmbc_alloc); #ifdef DEBUG for (atom = (Eterm *) &am; atom < &am.end_of_atoms; atom++) { @@ -1869,7 +2052,9 @@ sz_info_carriers(Allctr_t *allctr, Uint *szp) { Eterm res = THE_NON_VALUE; - Uint curr_size = cs->curr_mseg.size + cs->curr_sys_alloc.size; + Uint curr_size = (cs == &allctr->sbmbcs + ? cs->curr.small_block.size + : cs->curr.norm.mseg.size + cs->curr.norm.sys_alloc.size); if (print_to_p) { int to = *print_to_p; @@ -1917,8 +2102,17 @@ info_carriers(Allctr_t *allctr, Uint *szp) { Eterm res = THE_NON_VALUE; - Uint curr_no = cs->curr_mseg.no + cs->curr_sys_alloc.no; - Uint curr_size = cs->curr_mseg.size + cs->curr_sys_alloc.size; + Uint curr_no, curr_size; + int small_block = cs == &allctr->sbmbcs; + + if (small_block) { + curr_no = cs->curr.small_block.no; + curr_size = cs->curr.small_block.size; + } + else { + curr_no = cs->curr.norm.mseg.no + cs->curr.norm.sys_alloc.no; + curr_size = cs->curr.norm.mseg.size + cs->curr.norm.sys_alloc.size; + } if (print_to_p) { int to = *print_to_p; @@ -1944,18 +2138,20 @@ info_carriers(Allctr_t *allctr, curr_no, cs->max.no, cs->max_ever.no); + if (!small_block) { #if HAVE_ERTS_MSEG - erts_print(to, - arg, - "%smseg carriers: %bpu\n", - prefix, - cs->curr_mseg.no); -#endif - erts_print(to, - arg, - "%ssys_alloc carriers: %bpu\n", - prefix, - cs->curr_sys_alloc.no); + erts_print(to, + arg, + "%smseg carriers: %bpu\n", + prefix, + cs->curr.norm.mseg.no); +#endif + erts_print(to, + arg, + "%ssys_alloc carriers: %bpu\n", + prefix, + cs->curr.norm.sys_alloc.no); + } erts_print(to, arg, "%scarriers size: %beu %bpu %bpu\n", @@ -1963,43 +2159,49 @@ info_carriers(Allctr_t *allctr, curr_size, cs->max.size, cs->max_ever.size); + if (!small_block) { #if HAVE_ERTS_MSEG - erts_print(to, - arg, - "%smseg carriers size: %bpu\n", - prefix, - cs->curr_mseg.size); -#endif - erts_print(to, - arg, - "%ssys_alloc carriers size: %bpu\n", - prefix, - cs->curr_sys_alloc.size); + erts_print(to, + arg, + "%smseg carriers size: %bpu\n", + prefix, + cs->curr.norm.mseg.size); +#endif + erts_print(to, + arg, + "%ssys_alloc carriers size: %bpu\n", + prefix, + cs->curr.norm.sys_alloc.size); + } } if (hpp || szp) { res = NIL; - add_2tup(hpp, szp, &res, - am.sys_alloc_carriers_size, - bld_unstable_uint(hpp, szp, cs->curr_sys_alloc.size)); + if (!small_block) { + add_2tup(hpp, szp, &res, + am.sys_alloc_carriers_size, + bld_unstable_uint(hpp, szp, cs->curr.norm.sys_alloc.size)); #if HAVE_ERTS_MSEG - add_2tup(hpp, szp, &res, - am.mseg_alloc_carriers_size, - bld_unstable_uint(hpp, szp, cs->curr_mseg.size)); + add_2tup(hpp, szp, &res, + am.mseg_alloc_carriers_size, + bld_unstable_uint(hpp, szp, cs->curr.norm.mseg.size)); #endif + } add_4tup(hpp, szp, &res, am.carriers_size, bld_unstable_uint(hpp, szp, curr_size), bld_unstable_uint(hpp, szp, cs->max.size), bld_unstable_uint(hpp, szp, cs->max_ever.size)); - add_2tup(hpp, szp, &res, - am.sys_alloc_carriers, - bld_unstable_uint(hpp, szp, cs->curr_sys_alloc.no)); + if (!small_block) { + add_2tup(hpp, szp, &res, + am.sys_alloc_carriers, + bld_unstable_uint(hpp, szp, cs->curr.norm.sys_alloc.no)); #if HAVE_ERTS_MSEG - add_2tup(hpp, szp, &res, - am.mseg_alloc_carriers, - bld_unstable_uint(hpp, szp, cs->curr_mseg.no)); + add_2tup(hpp, szp, &res, + am.mseg_alloc_carriers, + bld_unstable_uint(hpp, szp, cs->curr.norm.mseg.no)); #endif + } add_4tup(hpp, szp, &res, am.carriers, bld_unstable_uint(hpp, szp, curr_no), @@ -2077,6 +2279,9 @@ info_calls(Allctr_t *allctr, PRINT_CC_5(to, arg, prefix, "free", allctr->calls.this_free); PRINT_CC_5(to, arg, prefix, "realloc", allctr->calls.this_realloc); + PRINT_CC_4(to, arg, "sbmbc_alloc", allctr->calls.sbmbc_alloc); + PRINT_CC_4(to, arg, "sbmbc_free", allctr->calls.sbmbc_free); + #if HAVE_ERTS_MSEG PRINT_CC_4(to, arg, "mseg_alloc", allctr->calls.mseg_alloc); PRINT_CC_4(to, arg, "mseg_dealloc", allctr->calls.mseg_dealloc); @@ -2128,6 +2333,14 @@ info_calls(Allctr_t *allctr, bld_unstable_uint(hpp, szp, allctr->calls.mseg_alloc.no)); #endif add_3tup(hpp, szp, &res, + am.sbmbc_free, + bld_unstable_uint(hpp, szp, allctr->calls.sbmbc_free.giga_no), + bld_unstable_uint(hpp, szp, allctr->calls.sbmbc_free.no)); + add_3tup(hpp, szp, &res, + am.sbmbc_alloc, + bld_unstable_uint(hpp, szp, allctr->calls.sbmbc_alloc.giga_no), + bld_unstable_uint(hpp, szp, allctr->calls.sbmbc_alloc.no)); + add_3tup(hpp, szp, &res, allctr->name.realloc, bld_unstable_uint(hpp, szp, allctr->calls.this_realloc.giga_no), bld_unstable_uint(hpp, szp, allctr->calls.this_realloc.no)); @@ -2191,7 +2404,9 @@ info_options(Allctr_t *allctr, #endif "option lmbcs: %beu\n" "option smbcs: %beu\n" - "option mbcgs: %beu\n", + "option mbcgs: %beu\n" + "option sbmbcs: %beu\n" + "option sbmbct: %beu\n", topt, allctr->ramv ? "true" : "false", #if HALFWORD_HEAP @@ -2211,7 +2426,9 @@ info_options(Allctr_t *allctr, #endif allctr->largest_mbc_size, allctr->smallest_mbc_size, - allctr->mbc_growth_stages); + allctr->mbc_growth_stages, + allctr->sbmbc_size, + allctr->sbmbc_threshold); } res = (*allctr->info_options)(allctr, "option ", print_to_p, print_to_arg, @@ -2219,6 +2436,12 @@ info_options(Allctr_t *allctr, if (hpp || szp) { add_2tup(hpp, szp, &res, + am.sbmbct, + bld_uint(hpp, szp, allctr->sbmbc_threshold)); + add_2tup(hpp, szp, &res, + am.sbmbcs, + bld_uint(hpp, szp, allctr->sbmbc_size)); + add_2tup(hpp, szp, &res, am.mbcgs, bld_uint(hpp, szp, allctr->mbc_growth_stages)); add_2tup(hpp, szp, &res, @@ -2285,10 +2508,10 @@ update_max_ever_values(CarriersStats_t *cs) static ERTS_INLINE void reset_max_values(CarriersStats_t *cs) { - cs->max.no = cs->curr_mseg.no + cs->curr_sys_alloc.no; - cs->max.size = cs->curr_mseg.size + cs->curr_sys_alloc.size; - cs->blocks.max.no = cs->blocks.curr.no; - cs->blocks.max.size = cs->blocks.curr.size; + cs->max.no = cs->curr.norm.mseg.no + cs->curr.norm.sys_alloc.no; + cs->max.size = cs->curr.norm.mseg.size + cs->curr.norm.sys_alloc.size; + cs->blocks.max.no = cs->blocks.curr.no; + cs->blocks.max.size = cs->blocks.curr.size; } @@ -2367,7 +2590,7 @@ erts_alcu_sz_info(Allctr_t *allctr, Uint **hpp, Uint *szp) { - Eterm res, mbcs, sbcs; + Eterm res, sbmbcs, mbcs, sbcs; res = THE_NON_VALUE; @@ -2389,24 +2612,29 @@ erts_alcu_sz_info(Allctr_t *allctr, /* Update sbc values not continously updated */ allctr->sbcs.blocks.curr.no - = allctr->sbcs.curr_mseg.no + allctr->sbcs.curr_sys_alloc.no; + = allctr->sbcs.curr.norm.mseg.no + allctr->sbcs.curr.norm.sys_alloc.no; allctr->sbcs.blocks.max.no = allctr->sbcs.max.no; + update_max_ever_values(&allctr->sbmbcs); update_max_ever_values(&allctr->mbcs); update_max_ever_values(&allctr->sbcs); - mbcs = sz_info_carriers(allctr, &allctr->mbcs, "mbcs ", print_to_p, - print_to_arg, hpp, szp); - sbcs = sz_info_carriers(allctr, &allctr->sbcs, "sbcs ", print_to_p, - print_to_arg, hpp, szp); + sbmbcs = sz_info_carriers(allctr, &allctr->sbmbcs, "sbmbcs ", print_to_p, + print_to_arg, hpp, szp); + mbcs = sz_info_carriers(allctr, &allctr->mbcs, "mbcs ", print_to_p, + print_to_arg, hpp, szp); + sbcs = sz_info_carriers(allctr, &allctr->sbcs, "sbcs ", print_to_p, + print_to_arg, hpp, szp); if (hpp || szp) { res = NIL; add_2tup(hpp, szp, &res, am.sbcs, sbcs); add_2tup(hpp, szp, &res, am.mbcs, mbcs); + add_2tup(hpp, szp, &res, am.sbmbcs, sbmbcs); } if (begin_max_period) { + reset_max_values(&allctr->sbmbcs); reset_max_values(&allctr->mbcs); reset_max_values(&allctr->sbcs); } @@ -2428,7 +2656,7 @@ erts_alcu_info(Allctr_t *allctr, Uint **hpp, Uint *szp) { - Eterm res, sett, mbcs, sbcs, calls; + Eterm res, sett, sbmbcs, mbcs, sbcs, calls; res = THE_NON_VALUE; @@ -2450,9 +2678,10 @@ erts_alcu_info(Allctr_t *allctr, /* Update sbc values not continously updated */ allctr->sbcs.blocks.curr.no - = allctr->sbcs.curr_mseg.no + allctr->sbcs.curr_sys_alloc.no; + = allctr->sbcs.curr.norm.mseg.no + allctr->sbcs.curr.norm.sys_alloc.no; allctr->sbcs.blocks.max.no = allctr->sbcs.max.no; + update_max_ever_values(&allctr->sbmbcs); update_max_ever_values(&allctr->mbcs); update_max_ever_values(&allctr->sbcs); @@ -2464,11 +2693,13 @@ erts_alcu_info(Allctr_t *allctr, ERTS_ALCU_VSN_STR); } - sett = info_options(allctr, print_to_p, print_to_arg, hpp, szp); - mbcs = info_carriers(allctr, &allctr->mbcs, "mbcs ", print_to_p, - print_to_arg, hpp, szp); - sbcs = info_carriers(allctr, &allctr->sbcs, "sbcs ", print_to_p, - print_to_arg, hpp, szp); + sett = info_options(allctr, print_to_p, print_to_arg, hpp, szp); + sbmbcs = info_carriers(allctr, &allctr->sbmbcs, "sbmbcs ", print_to_p, + print_to_arg, hpp, szp); + mbcs = info_carriers(allctr, &allctr->mbcs, "mbcs ", print_to_p, + print_to_arg, hpp, szp); + sbcs = info_carriers(allctr, &allctr->sbcs, "sbcs ", print_to_p, + print_to_arg, hpp, szp); calls = info_calls(allctr, print_to_p, print_to_arg, hpp, szp); if (hpp || szp) { @@ -2477,6 +2708,7 @@ erts_alcu_info(Allctr_t *allctr, add_2tup(hpp, szp, &res, am.calls, calls); add_2tup(hpp, szp, &res, am.sbcs, sbcs); add_2tup(hpp, szp, &res, am.mbcs, mbcs); + add_2tup(hpp, szp, &res, am.sbmbcs, sbmbcs); add_2tup(hpp, szp, &res, am.options, sett); add_3tup(hpp, szp, &res, am.versions, @@ -2485,6 +2717,7 @@ erts_alcu_info(Allctr_t *allctr, } if (begin_max_period) { + reset_max_values(&allctr->sbmbcs); reset_max_values(&allctr->mbcs); reset_max_values(&allctr->sbcs); } @@ -2508,12 +2741,14 @@ erts_alcu_current_size(Allctr_t *allctr, AllctrSize_t *size) erts_mtx_lock(&allctr->mutex); #endif - size->carriers = allctr->mbcs.curr_mseg.size; - size->carriers += allctr->mbcs.curr_sys_alloc.size; - size->carriers += allctr->sbcs.curr_mseg.size; - size->carriers += allctr->sbcs.curr_sys_alloc.size; + size->carriers = allctr->mbcs.curr.norm.mseg.size; + size->carriers += allctr->mbcs.curr.norm.sys_alloc.size; + size->carriers += allctr->sbmbcs.curr.small_block.size; + size->carriers += allctr->sbcs.curr.norm.mseg.size; + size->carriers += allctr->sbcs.curr.norm.sys_alloc.size; size->blocks = allctr->mbcs.blocks.curr.size; + size->blocks += allctr->sbmbcs.blocks.curr.size; size->blocks += allctr->sbcs.blocks.curr.size; #ifdef USE_THREADS @@ -2725,7 +2960,7 @@ do_erts_alcu_realloc(ErtsAlcType_t type, void *extra, void *p, Uint size, - UWord flgs) + Uint32 alcu_flgs) { Allctr_t *allctr = (Allctr_t *) extra; Block_t *blk; @@ -2758,9 +2993,32 @@ do_erts_alcu_realloc(ErtsAlcType_t type, blk = UMEM2BLK(p); + if (allctr->sbmbc_threshold > 0) { + Uint old_sz, new_sz, lim; + lim = allctr->sbmbc_threshold; + old_sz = BLK_SZ(blk); + new_sz = UMEMSZ2BLKSZ(allctr, size); + if ((old_sz < lim && lim <= new_sz) + || (new_sz < lim && lim <= old_sz)) { + /* *Need* to move it... */ + + INC_CC(allctr->calls.this_realloc); + res = do_erts_alcu_alloc(type, extra, size); + DEC_CC(allctr->calls.this_alloc); + + sys_memcpy(res, p, MIN(size, old_sz - ABLK_HDR_SZ)); + + do_erts_alcu_free(type, extra, p); + DEC_CC(allctr->calls.this_free); + return res; + } + if (old_sz < lim) + alcu_flgs |= ERTS_ALCU_FLG_SBMBC; + } + if (size < allctr->sbc_threshold) { if (IS_MBC_BLK(blk)) - res = mbc_realloc(allctr, p, size, flgs); + res = mbc_realloc(allctr, p, size, alcu_flgs); else { Uint used_sz = allctr->sbc_header_size + ABLK_HDR_SZ + size; Uint crr_sz; @@ -2791,7 +3049,7 @@ do_erts_alcu_realloc(ErtsAlcType_t type, if (100*diff_sz_val < allctr->sbc_move_threshold*crr_sz_val) /* Data won't be copied into a new carrier... */ goto do_carrier_resize; - else if (flgs & ERTS_ALCU_FLG_FAIL_REALLOC_MOVE) + else if (alcu_flgs & ERTS_ALCU_FLG_FAIL_REALLOC_MOVE) return NULL; res = mbc_alloc(allctr, size); @@ -2814,7 +3072,7 @@ do_erts_alcu_realloc(ErtsAlcType_t type, #endif res = new_blk ? BLK2UMEM(new_blk) : NULL; } - else if (flgs & ERTS_ALCU_FLG_FAIL_REALLOC_MOVE) + else if (alcu_flgs & ERTS_ALCU_FLG_FAIL_REALLOC_MOVE) return NULL; else { #if HALFWORD_HEAP @@ -3174,6 +3432,26 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init) allctr->min_block_size = UNIT_CEILING(allctr->min_block_size + sizeof(UWord)); + + allctr->sbmbc_threshold = init->sbmbct; + + if (!erts_have_sbmbc_alloc + || ERTS_IS_SBMBC_ALLOCATOR_NO__(allctr->alloc_no)) + allctr->sbmbc_threshold = 0; + + if (!allctr->sbmbc_threshold) + allctr->sbmbc_size = 0; + else { + Uint min_size; + allctr->sbmbc_size = init->sbmbcs; + min_size = allctr->sbmbc_threshold; + min_size += allctr->min_block_size; + min_size += allctr->mbc_header_size; + if (allctr->sbmbc_size < min_size) + allctr->sbmbc_size = min_size; + } + + #if HAVE_ERTS_MSEG if (allctr->mseg_opt.abs_shrink_th > ~((UWord) 0) / 100) allctr->mseg_opt.abs_shrink_th = ~((UWord) 0) / 100; @@ -3185,12 +3463,16 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init) #ifdef ERTS_ENABLE_LOCK_COUNT erts_mtx_init_x_opt(&allctr->mutex, - "alcu_allocator", - make_small(allctr->alloc_no), - ERTS_LCNT_LT_ALLOC); + ERTS_IS_SBMBC_ALLOCATOR_NO__(allctr->alloc_no) + ? "sbmbc_alloc" + : "alcu_allocator", + make_small(allctr->alloc_no), + ERTS_LCNT_LT_ALLOC); #else erts_mtx_init_x(&allctr->mutex, - "alcu_allocator", + ERTS_IS_SBMBC_ALLOCATOR_NO__(allctr->alloc_no) + ? "sbmbc_alloc" + : "alcu_allocator", make_small(allctr->alloc_no)); #endif /*ERTS_ENABLE_LOCK_COUNT*/ @@ -3260,7 +3542,7 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init) if (!blk) goto error; - (*allctr->link_free_block)(allctr, blk); + (*allctr->link_free_block)(allctr, blk, 0); HARD_CHECK_BLK_CARRIER(allctr, blk); @@ -3290,6 +3572,8 @@ erts_alcu_stop(Allctr_t *allctr) destroy_carrier(allctr, SBC2BLK(allctr, allctr->sbc_list.first)); while (allctr->mbc_list.first) destroy_carrier(allctr, MBC2FBLK(allctr, allctr->mbc_list.first)); + while (allctr->sbmbc_list.first) + destroy_sbmbc(allctr, MBC2FBLK(allctr, allctr->sbmbc_list.first)); #ifdef USE_THREADS if (allctr->thread_safe) @@ -3387,13 +3671,15 @@ erts_alcu_verify_unused(Allctr_t *allctr) { UWord no; - no = allctr->sbcs.curr_mseg.no; - no += allctr->sbcs.curr_sys_alloc.no; + no = allctr->sbcs.curr.norm.mseg.no; + no += allctr->sbcs.curr.norm.sys_alloc.no; no += allctr->mbcs.blocks.curr.no; + no += allctr->sbmbcs.blocks.curr.no; if (no) { UWord sz = allctr->sbcs.blocks.curr.size; sz += allctr->mbcs.blocks.curr.size; + sz += allctr->sbmbcs.blocks.curr.size; erl_exit(ERTS_ABORT_EXIT, "%salloc() used when expected to be unused!\n" "Total amount of blocks allocated: %bpu\n" @@ -3492,7 +3778,7 @@ check_blk_carrier(Allctr_t *allctr, Block_t *iblk) (*allctr->check_block)(allctr, blk, (int) is_free_blk); if (IS_LAST_BLK(blk)) { - carrier_end = ((char *) NXT_BLK(blk)) + sizeof(UWord); + carrier_end = ((char *) NXT_BLK(blk)); mbc = *((Carrier_t **) NXT_BLK(blk)); prev_blk = NULL; blk = MBC2FBLK(allctr, mbc); @@ -3507,9 +3793,9 @@ check_blk_carrier(Allctr_t *allctr, Block_t *iblk) ASSERT(IS_MB_CARRIER(mbc)); ASSERT((((char *) mbc) + allctr->mbc_header_size - + tot_blk_sz - + sizeof(UWord)) == carrier_end); - ASSERT(((char *) mbc) + CARRIER_SZ(mbc) == carrier_end); + + tot_blk_sz) == carrier_end); + ASSERT(((char *) mbc) + CARRIER_SZ(mbc) - sizeof(Unit_t) <= carrier_end + && carrier_end <= ((char *) mbc) + CARRIER_SZ(mbc)); if (allctr->check_mbc) (*allctr->check_mbc)(allctr, mbc); @@ -3523,6 +3809,7 @@ check_blk_carrier(Allctr_t *allctr, Block_t *iblk) cl = &allctr->mbc_list; } +#if 0 /* FIXIT sbmbc */ if (cl->first == crr) { ASSERT(!crr->prev); } @@ -3537,6 +3824,7 @@ check_blk_carrier(Allctr_t *allctr, Block_t *iblk) ASSERT(crr->next); ASSERT(crr->next->prev == crr); } +#endif } #endif diff --git a/erts/emulator/beam/erl_alloc_util.h b/erts/emulator/beam/erl_alloc_util.h index ddf84c086c..fed4d3dbe6 100644 --- a/erts/emulator/beam/erl_alloc_util.h +++ b/erts/emulator/beam/erl_alloc_util.h @@ -34,6 +34,7 @@ typedef struct { typedef struct { char *name_prefix; ErtsAlcType_t alloc_no; + int force; int ts; int tspec; int tpref; @@ -50,6 +51,8 @@ typedef struct { UWord lmbcs; UWord smbcs; UWord mbcgs; + UWord sbmbct; + UWord sbmbcs; } AllctrInit_t; typedef struct { @@ -67,6 +70,7 @@ typedef struct { #define ERTS_DEFAULT_ALLCTR_INIT { \ NULL, \ ERTS_ALC_A_INVALID, /* (number) alloc_no: allocator number */\ + 0, /* (bool) force: force enabled */\ 1, /* (bool) ts: thread safe */\ 0, /* (bool) tspec: thread specific */\ 0, /* (bool) tpref: thread preferred */\ @@ -82,7 +86,9 @@ typedef struct { 10, /* (amount) mmmbc: max mseg mbcs */\ 10*1024*1024, /* (bytes) lmbcs: largest mbc size */\ 1024*1024, /* (bytes) smbcs: smallest mbc size */\ - 10 /* (amount) mbcgs: mbc growth stages */\ + 10, /* (amount) mbcgs: mbc growth stages */\ + 256, /* (bytes) sbmbct: small block mbc threshold */\ + 8*1024 /* (bytes) sbmbcs: small block mbc size */\ } #else /* if SMALL_MEMORY */ @@ -95,6 +101,7 @@ typedef struct { #define ERTS_DEFAULT_ALLCTR_INIT { \ NULL, \ ERTS_ALC_A_INVALID, /* (number) alloc_no: allocator number */\ + 0, /* (bool) force: force enabled */\ 1, /* (bool) ts: thread safe */\ 0, /* (bool) tspec: thread specific */\ 0, /* (bool) tpref: thread preferred */\ @@ -109,7 +116,9 @@ typedef struct { 10, /* (amount) mmmbc: max mseg mbcs */\ 1024*1024, /* (bytes) lmbcs: largest mbc size */\ 128*1024, /* (bytes) smbcs: smallest mbc size */\ - 10 /* (amount) mbcgs: mbc growth stages */\ + 10, /* (amount) mbcgs: mbc growth stages */\ + 256, /* (bytes) sbmbct: small block mbc threshold */\ + 8*1024 /* (bytes) sbmbcs: small block mbc size */\ } #endif @@ -144,6 +153,9 @@ void erts_alcu_current_size(Allctr_t *, AllctrSize_t *); #if defined(GET_ERL_ALLOC_UTIL_IMPL) && !defined(ERL_ALLOC_UTIL_IMPL__) #define ERL_ALLOC_UTIL_IMPL__ +#define ERTS_ALCU_FLG_FAIL_REALLOC_MOVE (((Uint32) 1) << 0) +#define ERTS_ALCU_FLG_SBMBC (((Uint32) 1) << 1) + #ifdef USE_THREADS #define ERL_THREADS_EMU_INTERNAL__ #include "erl_threads.h" @@ -188,6 +200,8 @@ void erts_alcu_current_size(Allctr_t *, AllctrSize_t *); #define CARRIER_SZ(C) \ ((C)->chdr & SZ_MASK) +extern int erts_have_sbmbc_alloc; + typedef union {char c[8]; long l; double d;} Unit_t; typedef struct Carrier_t_ Carrier_t; @@ -216,8 +230,13 @@ typedef struct { } StatValues_t; typedef struct { - StatValues_t curr_mseg; - StatValues_t curr_sys_alloc; + union { + struct { + StatValues_t mseg; + StatValues_t sys_alloc; + } norm; + StatValues_t small_block; + } curr; StatValues_t max; StatValues_t max_ever; struct { @@ -257,6 +276,8 @@ struct Allctr_t_ { Uint largest_mbc_size; Uint smallest_mbc_size; Uint mbc_growth_stages; + Uint sbmbc_threshold; + Uint sbmbc_size; #if HAVE_ERTS_MSEG ErtsMsegOpt_t mseg_opt; #endif @@ -269,6 +290,7 @@ struct Allctr_t_ { Uint min_block_size; /* Carriers */ + CarrierList_t sbmbc_list; CarrierList_t mbc_list; CarrierList_t sbc_list; @@ -277,15 +299,15 @@ struct Allctr_t_ { /* Callback functions (first 4 are mandatory) */ Block_t * (*get_free_block) (Allctr_t *, Uint, - Block_t *, Uint); - void (*link_free_block) (Allctr_t *, Block_t *); - void (*unlink_free_block) (Allctr_t *, Block_t *); + Block_t *, Uint, Uint32); + void (*link_free_block) (Allctr_t *, Block_t *, Uint32); + void (*unlink_free_block) (Allctr_t *, Block_t *, Uint32); Eterm (*info_options) (Allctr_t *, char *, int *, void *, Uint **, Uint *); Uint (*get_next_mbc_size) (Allctr_t *); - void (*creating_mbc) (Allctr_t *, Carrier_t *); - void (*destroying_mbc) (Allctr_t *, Carrier_t *); + void (*creating_mbc) (Allctr_t *, Carrier_t *, Uint32); + void (*destroying_mbc) (Allctr_t *, Carrier_t *, Uint32); void (*init_atoms) (void); #ifdef ERTS_ALLOC_UTIL_HARD_DEBUG @@ -312,6 +334,8 @@ struct Allctr_t_ { CallCounter_t this_alloc; CallCounter_t this_free; CallCounter_t this_realloc; + CallCounter_t sbmbc_alloc; + CallCounter_t sbmbc_free; CallCounter_t mseg_alloc; CallCounter_t mseg_dealloc; CallCounter_t mseg_realloc; @@ -322,6 +346,7 @@ struct Allctr_t_ { CarriersStats_t sbcs; CarriersStats_t mbcs; + CarriersStats_t sbmbcs; #ifdef DEBUG #ifdef USE_THREADS diff --git a/erts/emulator/beam/erl_ao_firstfit_alloc.c b/erts/emulator/beam/erl_ao_firstfit_alloc.c new file mode 100644 index 0000000000..002852cdad --- /dev/null +++ b/erts/emulator/beam/erl_ao_firstfit_alloc.c @@ -0,0 +1,972 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2003-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + + +/* + * Description: An "address order first fit" allocator + * based on a Red-Black (binary search) Tree. The search, + * insert, and delete operations are all O(log n) operations + * on a Red-Black Tree. + * Red-Black Trees are described in "Introduction to Algorithms", + * by Thomas H. Cormen, Charles E. Leiserson, and Ronald L. Riverest. + * + * This module is a callback-module for erl_alloc_util.c + * + * Algorithm: The tree nodes are free-blocks ordered in address order. + * Every node also keeps the size of the largest block in its + * sub-tree ('max_size'). By that we can start from root and keep + * left (for low addresses) while dismissing entire sub-trees with + * too small blocks. + * + * Authors: Rickard Green/Sverker Eriksson + */ + + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif +#include "global.h" +#define GET_ERL_AOFF_ALLOC_IMPL +#include "erl_ao_firstfit_alloc.h" + +#ifdef DEBUG +#if 0 +#define HARD_DEBUG +#endif +#else +#undef HARD_DEBUG +#endif + +#define MIN_MBC_SZ (16*1024) +#define MIN_MBC_FIRST_FREE_SZ (4*1024) + +#define TREE_NODE_FLG (((Uint) 1) << 0) +#define RED_FLG (((Uint) 1) << 1) +#ifdef HARD_DEBUG +# define LEFT_VISITED_FLG (((Uint) 1) << 2) +# define RIGHT_VISITED_FLG (((Uint) 1) << 3) +#endif + +#define IS_RED(N) (((AOFF_RBTree_t *) (N)) \ + && ((AOFF_RBTree_t *) (N))->flags & RED_FLG) +#define IS_BLACK(N) (!IS_RED(((AOFF_RBTree_t *) (N)))) + +#define SET_RED(N) (((AOFF_RBTree_t *) (N))->flags |= RED_FLG) +#define SET_BLACK(N) (((AOFF_RBTree_t *) (N))->flags &= ~RED_FLG) + +#undef ASSERT +#define ASSERT ASSERT_EXPR + +#if 1 +#define RBT_ASSERT ASSERT +#else +#define RBT_ASSERT(x) +#endif + + +/* Types... */ +typedef struct AOFF_RBTree_t_ AOFF_RBTree_t; + +struct AOFF_RBTree_t_ { + Block_t hdr; + Uint flags; + AOFF_RBTree_t *parent; + AOFF_RBTree_t *left; + AOFF_RBTree_t *right; + Uint max_sz; /* of all blocks in this sub-tree */ +}; + +#ifdef HARD_DEBUG +static AOFF_RBTree_t * check_tree(AOFF_RBTree_t* root, Uint); +#endif + + +/* Calculate 'max_size' of tree node x by only looking at the direct children + * of x and x itself. + */ +static ERTS_INLINE Uint node_max_size(AOFF_RBTree_t *x) +{ + Uint sz = BLK_SZ(x); + if (x->left && x->left->max_sz > sz) { + sz = x->left->max_sz; + } + if (x->right && x->right->max_sz > sz) { + sz = x->right->max_sz; + } + return sz; +} + +/* Set new possibly lower 'max_size' of node and propagate change toward root +*/ +static ERTS_INLINE void lower_max_size(AOFF_RBTree_t *node, + AOFF_RBTree_t* stop_at) +{ + AOFF_RBTree_t* x = node; + Uint old_max = x->max_sz; + Uint new_max = node_max_size(x); + + if (new_max < old_max) { + x->max_sz = new_max; + while ((x=x->parent) != stop_at && x->max_sz == old_max) { + x->max_sz = node_max_size(x); + } + ASSERT(x == stop_at || x->max_sz > old_max); + } + else ASSERT(new_max == old_max); +} + + +/* Prototypes of callback functions */ +static Block_t* aoff_get_free_block(Allctr_t *, Uint, Block_t *, Uint, Uint32 flags); +static void aoff_link_free_block(Allctr_t *, Block_t*, Uint32 flags); +static void aoff_unlink_free_block(Allctr_t *allctr, Block_t *del, Uint32 flags); + +static Eterm info_options(Allctr_t *, char *, int *, void *, Uint **, Uint *); +static void init_atoms(void); + + + +#ifdef DEBUG + +/* Destroy all tree fields */ +#define DESTROY_TREE_NODE(N) \ + sys_memset((void *) (((Block_t *) (N)) + 1), \ + 0xff, \ + (sizeof(AOFF_RBTree_t) - sizeof(Block_t))) + +#else + +#define DESTROY_TREE_NODE(N) + +#endif + + +static int atoms_initialized = 0; + +void +erts_aoffalc_init(void) +{ + atoms_initialized = 0; +} + +Allctr_t * +erts_aoffalc_start(AOFFAllctr_t *alc, + AOFFAllctrInit_t* aoffinit, + AllctrInit_t *init) +{ + AOFFAllctr_t nulled_state = {{0}}; + /* {{0}} is used instead of {0}, in order to avoid (an incorrect) gcc + warning. gcc warns if {0} is used as initializer of a struct when + the first member is a struct (not if, for example, the third member + is a struct). */ + Allctr_t *allctr = (Allctr_t *) alc; + + sys_memcpy((void *) alc, (void *) &nulled_state, sizeof(AOFFAllctr_t)); + + allctr->mbc_header_size = sizeof(Carrier_t); + allctr->min_mbc_size = MIN_MBC_SZ; + allctr->min_mbc_first_free_size = MIN_MBC_FIRST_FREE_SZ; + allctr->min_block_size = sizeof(AOFF_RBTree_t); + + allctr->vsn_str = ERTS_ALC_AOFF_ALLOC_VSN_STR; + + + /* Callback functions */ + + allctr->get_free_block = aoff_get_free_block; + allctr->link_free_block = aoff_link_free_block; + allctr->unlink_free_block = aoff_unlink_free_block; + allctr->info_options = info_options; + + allctr->get_next_mbc_size = NULL; + allctr->creating_mbc = NULL; + allctr->destroying_mbc = NULL; + allctr->init_atoms = init_atoms; + +#ifdef ERTS_ALLOC_UTIL_HARD_DEBUG + allctr->check_block = NULL; + allctr->check_mbc = NULL; +#endif + + allctr->atoms_initialized = 0; + + if (!erts_alcu_start(allctr, init)) + return NULL; + + return allctr; +} + +/* + * Red-Black Tree operations needed + */ + +static ERTS_INLINE void +left_rotate(AOFF_RBTree_t **root, AOFF_RBTree_t *x) +{ + AOFF_RBTree_t *y = x->right; + x->right = y->left; + if (y->left) + y->left->parent = x; + y->parent = x->parent; + if (!y->parent) { + RBT_ASSERT(*root == x); + *root = y; + } + else if (x == x->parent->left) + x->parent->left = y; + else { + RBT_ASSERT(x == x->parent->right); + x->parent->right = y; + } + y->left = x; + x->parent = y; + + y->max_sz = x->max_sz; + x->max_sz = node_max_size(x); + ASSERT(y->max_sz >= x->max_sz); +} + +static ERTS_INLINE void +right_rotate(AOFF_RBTree_t **root, AOFF_RBTree_t *x) +{ + AOFF_RBTree_t *y = x->left; + x->left = y->right; + if (y->right) + y->right->parent = x; + y->parent = x->parent; + if (!y->parent) { + RBT_ASSERT(*root == x); + *root = y; + } + else if (x == x->parent->right) + x->parent->right = y; + else { + RBT_ASSERT(x == x->parent->left); + x->parent->left = y; + } + y->right = x; + x->parent = y; + y->max_sz = x->max_sz; + x->max_sz = node_max_size(x); + ASSERT(y->max_sz >= x->max_sz); +} + + +/* + * Replace node x with node y + * NOTE: block header of y is not changed + */ +static ERTS_INLINE void +replace(AOFF_RBTree_t **root, AOFF_RBTree_t *x, AOFF_RBTree_t *y) +{ + + if (!x->parent) { + RBT_ASSERT(*root == x); + *root = y; + } + else if (x == x->parent->left) + x->parent->left = y; + else { + RBT_ASSERT(x == x->parent->right); + x->parent->right = y; + } + if (x->left) { + RBT_ASSERT(x->left->parent == x); + x->left->parent = y; + } + if (x->right) { + RBT_ASSERT(x->right->parent == x); + x->right->parent = y; + } + + y->flags = x->flags; + y->parent = x->parent; + y->right = x->right; + y->left = x->left; + + y->max_sz = x->max_sz; + lower_max_size(y, NULL); + DESTROY_TREE_NODE(x); +} + +static void +tree_insert_fixup(AOFF_RBTree_t** root, AOFF_RBTree_t *blk) +{ + AOFF_RBTree_t *x = blk, *y; + + /* + * Rearrange the tree so that it satisfies the Red-Black Tree properties + */ + + RBT_ASSERT(x != *root && IS_RED(x->parent)); + do { + + /* + * x and its parent are both red. Move the red pair up the tree + * until we get to the root or until we can separate them. + */ + + RBT_ASSERT(IS_RED(x)); + RBT_ASSERT(IS_BLACK(x->parent->parent)); + RBT_ASSERT(x->parent->parent); + + if (x->parent == x->parent->parent->left) { + y = x->parent->parent->right; + if (IS_RED(y)) { + SET_BLACK(y); + x = x->parent; + SET_BLACK(x); + x = x->parent; + SET_RED(x); + } + else { + + if (x == x->parent->right) { + x = x->parent; + left_rotate(root, x); + } + + RBT_ASSERT(x == x->parent->parent->left->left); + RBT_ASSERT(IS_RED(x)); + RBT_ASSERT(IS_RED(x->parent)); + RBT_ASSERT(IS_BLACK(x->parent->parent)); + RBT_ASSERT(IS_BLACK(y)); + + SET_BLACK(x->parent); + SET_RED(x->parent->parent); + right_rotate(root, x->parent->parent); + + RBT_ASSERT(x == x->parent->left); + RBT_ASSERT(IS_RED(x)); + RBT_ASSERT(IS_RED(x->parent->right)); + RBT_ASSERT(IS_BLACK(x->parent)); + break; + } + } + else { + RBT_ASSERT(x->parent == x->parent->parent->right); + y = x->parent->parent->left; + if (IS_RED(y)) { + SET_BLACK(y); + x = x->parent; + SET_BLACK(x); + x = x->parent; + SET_RED(x); + } + else { + + if (x == x->parent->left) { + x = x->parent; + right_rotate(root, x); + } + + RBT_ASSERT(x == x->parent->parent->right->right); + RBT_ASSERT(IS_RED(x)); + RBT_ASSERT(IS_RED(x->parent)); + RBT_ASSERT(IS_BLACK(x->parent->parent)); + RBT_ASSERT(IS_BLACK(y)); + + SET_BLACK(x->parent); + SET_RED(x->parent->parent); + left_rotate(root, x->parent->parent); + + RBT_ASSERT(x == x->parent->right); + RBT_ASSERT(IS_RED(x)); + RBT_ASSERT(IS_RED(x->parent->left)); + RBT_ASSERT(IS_BLACK(x->parent)); + break; + } + } + } while (x != *root && IS_RED(x->parent)); + + SET_BLACK(*root); +} + +static void +aoff_unlink_free_block(Allctr_t *allctr, Block_t *del, Uint32 flags) +{ + AOFFAllctr_t *alc = (AOFFAllctr_t *) allctr; + AOFF_RBTree_t **root = ((flags & ERTS_ALCU_FLG_SBMBC) + ? &alc->sbmbc_root : &alc->mbc_root); + Uint spliced_is_black; + AOFF_RBTree_t *x, *y, *z = (AOFF_RBTree_t *) del; + AOFF_RBTree_t null_x; /* null_x is used to get the fixup started when we + splice out a node without children. */ + + null_x.parent = NULL; + +#ifdef HARD_DEBUG + check_tree(*root, 0); +#endif + + /* Remove node from tree... */ + + /* Find node to splice out */ + if (!z->left || !z->right) + y = z; + else + /* Set y to z:s successor */ + for(y = z->right; y->left; y = y->left); + /* splice out y */ + x = y->left ? y->left : y->right; + spliced_is_black = IS_BLACK(y); + if (x) { + x->parent = y->parent; + } + else if (spliced_is_black) { + x = &null_x; + x->flags = 0; + SET_BLACK(x); + x->right = x->left = NULL; + x->max_sz = 0; + x->parent = y->parent; + y->left = x; + } + + if (!y->parent) { + RBT_ASSERT(*root == y); + *root = x; + } + else { + if (y == y->parent->left) { + y->parent->left = x; + } + else { + RBT_ASSERT(y == y->parent->right); + y->parent->right = x; + } + if (y->parent != z) { + lower_max_size(y->parent, (y==z ? NULL : z)); + } + } + if (y != z) { + /* We spliced out the successor of z; replace z by the successor */ + replace(root, z, y); + } + + if (spliced_is_black) { + /* We removed a black node which makes the resulting tree + violate the Red-Black Tree properties. Fixup tree... */ + + while (IS_BLACK(x) && x->parent) { + + /* + * x has an "extra black" which we move up the tree + * until we reach the root or until we can get rid of it. + * + * y is the sibbling of x + */ + + if (x == x->parent->left) { + y = x->parent->right; + RBT_ASSERT(y); + if (IS_RED(y)) { + RBT_ASSERT(y->right); + RBT_ASSERT(y->left); + SET_BLACK(y); + RBT_ASSERT(IS_BLACK(x->parent)); + SET_RED(x->parent); + left_rotate(root, x->parent); + y = x->parent->right; + } + RBT_ASSERT(y); + RBT_ASSERT(IS_BLACK(y)); + if (IS_BLACK(y->left) && IS_BLACK(y->right)) { + SET_RED(y); + x = x->parent; + } + else { + if (IS_BLACK(y->right)) { + SET_BLACK(y->left); + SET_RED(y); + right_rotate(root, y); + y = x->parent->right; + } + RBT_ASSERT(y); + if (IS_RED(x->parent)) { + + SET_BLACK(x->parent); + SET_RED(y); + } + RBT_ASSERT(y->right); + SET_BLACK(y->right); + left_rotate(root, x->parent); + x = *root; + break; + } + } + else { + RBT_ASSERT(x == x->parent->right); + y = x->parent->left; + RBT_ASSERT(y); + if (IS_RED(y)) { + RBT_ASSERT(y->right); + RBT_ASSERT(y->left); + SET_BLACK(y); + RBT_ASSERT(IS_BLACK(x->parent)); + SET_RED(x->parent); + right_rotate(root, x->parent); + y = x->parent->left; + } + RBT_ASSERT(y); + RBT_ASSERT(IS_BLACK(y)); + if (IS_BLACK(y->right) && IS_BLACK(y->left)) { + SET_RED(y); + x = x->parent; + } + else { + if (IS_BLACK(y->left)) { + SET_BLACK(y->right); + SET_RED(y); + left_rotate(root, y); + y = x->parent->left; + } + RBT_ASSERT(y); + if (IS_RED(x->parent)) { + SET_BLACK(x->parent); + SET_RED(y); + } + RBT_ASSERT(y->left); + SET_BLACK(y->left); + right_rotate(root, x->parent); + x = *root; + break; + } + } + } + SET_BLACK(x); + + if (null_x.parent) { + if (null_x.parent->left == &null_x) + null_x.parent->left = NULL; + else { + RBT_ASSERT(null_x.parent->right == &null_x); + null_x.parent->right = NULL; + } + RBT_ASSERT(!null_x.left); + RBT_ASSERT(!null_x.right); + } + else if (*root == &null_x) { + *root = NULL; + RBT_ASSERT(!null_x.left); + RBT_ASSERT(!null_x.right); + } + } + + DESTROY_TREE_NODE(del); + +#ifdef HARD_DEBUG + check_tree(*root, 0); +#endif +} + +static void +aoff_link_free_block(Allctr_t *allctr, Block_t *block, Uint32 flags) +{ + AOFFAllctr_t *alc = (AOFFAllctr_t *) allctr; + AOFF_RBTree_t *blk = (AOFF_RBTree_t *) block; + AOFF_RBTree_t **root = ((flags & ERTS_ALCU_FLG_SBMBC) + ? &alc->sbmbc_root : &alc->mbc_root); + Uint blk_sz = BLK_SZ(blk); + +#ifdef HARD_DEBUG + check_tree(*root, 0); +#endif + + blk->flags = 0; + blk->left = NULL; + blk->right = NULL; + blk->max_sz = blk_sz; + + if (!*root) { + blk->parent = NULL; + SET_BLACK(blk); + *root = blk; + } + else { + AOFF_RBTree_t *x = *root; + while (1) { + if (x->max_sz < blk_sz) { + x->max_sz = blk_sz; + } + if (blk < x) { + if (!x->left) { + blk->parent = x; + x->left = blk; + break; + } + x = x->left; + } + else { + if (!x->right) { + blk->parent = x; + x->right = blk; + break; + } + x = x->right; + } + + } + + /* Insert block into size tree */ + RBT_ASSERT(blk->parent); + + SET_RED(blk); + if (IS_RED(blk->parent)) + tree_insert_fixup(root, blk); + } + +#ifdef HARD_DEBUG + check_tree(*root, 0); +#endif +} + +static Block_t * +aoff_get_free_block(Allctr_t *allctr, Uint size, + Block_t *cand_blk, Uint cand_size, Uint32 flags) +{ + AOFFAllctr_t *alc = (AOFFAllctr_t *) allctr; + AOFF_RBTree_t *x = ((flags & ERTS_ALCU_FLG_SBMBC) + ? alc->sbmbc_root : alc->mbc_root); + AOFF_RBTree_t *blk = NULL; +#ifdef HARD_DEBUG + AOFF_RBTree_t* dbg_blk = check_tree(x, size); +#endif + + ASSERT(!cand_blk || cand_size >= size); + + while (x) { + if (x->left && x->left->max_sz >= size) { + x = x->left; + } + else if (BLK_SZ(x) >= size) { + blk = x; + break; + } + else { + x = x->right; + } + } + +#ifdef HARD_DEBUG + ASSERT(blk == dbg_blk); +#endif + + if (!blk) + return NULL; + + if (cand_blk && cand_blk < &blk->hdr) { + return NULL; /* cand_blk was better */ + } + + aoff_unlink_free_block(allctr, (Block_t *) blk, flags); + + return (Block_t *) blk; +} + + +/* + * info_options() + */ + +static struct { + Eterm as; + Eterm aoff; +#ifdef DEBUG + Eterm end_of_atoms; +#endif +} am; + +static void ERTS_INLINE atom_init(Eterm *atom, char *name) +{ + *atom = am_atom_put(name, strlen(name)); +} +#define AM_INIT(AM) atom_init(&am.AM, #AM) + +static void +init_atoms(void) +{ +#ifdef DEBUG + Eterm *atom; +#endif + + if (atoms_initialized) + return; + +#ifdef DEBUG + for (atom = (Eterm *) &am; atom <= &am.end_of_atoms; atom++) { + *atom = THE_NON_VALUE; + } +#endif + AM_INIT(as); + AM_INIT(aoff); + +#ifdef DEBUG + for (atom = (Eterm *) &am; atom < &am.end_of_atoms; atom++) { + ASSERT(*atom != THE_NON_VALUE); + } +#endif + + atoms_initialized = 1; +} + + +#define bld_uint erts_bld_uint +#define bld_cons erts_bld_cons +#define bld_tuple erts_bld_tuple + +static ERTS_INLINE void +add_2tup(Uint **hpp, Uint *szp, Eterm *lp, Eterm el1, Eterm el2) +{ + *lp = bld_cons(hpp, szp, bld_tuple(hpp, szp, 2, el1, el2), *lp); +} + +static Eterm +info_options(Allctr_t *allctr, + char *prefix, + int *print_to_p, + void *print_to_arg, + Uint **hpp, + Uint *szp) +{ + Eterm res = THE_NON_VALUE; + + if (print_to_p) { + erts_print(*print_to_p, + print_to_arg, + "%sas: %s\n", + prefix, + "aoff"); + } + + if (hpp || szp) { + + if (!atoms_initialized) + erl_exit(1, "%s:%d: Internal error: Atoms not initialized", + __FILE__, __LINE__);; + + res = NIL; + add_2tup(hpp, szp, &res, am.as, am.aoff); + } + + return res; +} + + +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ + * NOTE: erts_aoffalc_test() is only supposed to be used for testing. * + * * + * Keep alloc_SUITE_data/allocator_test.h updated if changes are made * + * to erts_aoffalc_test() * +\* */ + +unsigned long +erts_aoffalc_test(unsigned long op, unsigned long a1, unsigned long a2) +{ + switch (op) { + case 0x500: return (unsigned long) 0; /* IS_AOBF */ + case 0x501: return (unsigned long) ((AOFFAllctr_t *) a1)->mbc_root; + case 0x502: return (unsigned long) ((AOFF_RBTree_t *) a1)->parent; + case 0x503: return (unsigned long) ((AOFF_RBTree_t *) a1)->left; + case 0x504: return (unsigned long) ((AOFF_RBTree_t *) a1)->right; + case 0x506: return (unsigned long) IS_BLACK((AOFF_RBTree_t *) a1); + case 0x508: return (unsigned long) 1; /* IS_AOFF */ + case 0x509: return (unsigned long) ((AOFF_RBTree_t *) a1)->max_sz; + default: ASSERT(0); return ~((unsigned long) 0); + } +} + + +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ + * Debug functions * +\* */ + + +#ifdef HARD_DEBUG + +#define IS_LEFT_VISITED(FB) ((FB)->flags & LEFT_VISITED_FLG) +#define IS_RIGHT_VISITED(FB) ((FB)->flags & RIGHT_VISITED_FLG) + +#define SET_LEFT_VISITED(FB) ((FB)->flags |= LEFT_VISITED_FLG) +#define SET_RIGHT_VISITED(FB) ((FB)->flags |= RIGHT_VISITED_FLG) + +#define UNSET_LEFT_VISITED(FB) ((FB)->flags &= ~LEFT_VISITED_FLG) +#define UNSET_RIGHT_VISITED(FB) ((FB)->flags &= ~RIGHT_VISITED_FLG) + + +#if 0 +# define PRINT_TREE +#else +# undef PRINT_TREE +#endif + +#ifdef PRINT_TREE +static void print_tree(AOFF_RBTree_t*); +#endif + +/* + * Checks that the order between parent and children are correct, + * and that the Red-Black Tree properies are satisfied. if size > 0, + * check_tree() returns the node that satisfies "address order first fit" + * + * The Red-Black Tree properies are: + * 1. Every node is either red or black. + * 2. Every leaf (NIL) is black. + * 3. If a node is red, then both its children are black. + * 4. Every simple path from a node to a descendant leaf + * contains the same number of black nodes. + * + * + own.max_size == MAX(own.size, left.max_size, right.max_size) + */ + +static AOFF_RBTree_t * +check_tree(AOFF_RBTree_t* root, Uint size) +{ + AOFF_RBTree_t *res = NULL; + Sint blacks; + Sint curr_blacks; + AOFF_RBTree_t *x; + +#ifdef PRINT_TREE + print_tree(root); +#endif + + if (!root) + return res; + + x = root; + ASSERT(IS_BLACK(x)); + ASSERT(!x->parent); + curr_blacks = 1; + blacks = -1; + + while (x) { + if (!IS_LEFT_VISITED(x)) { + SET_LEFT_VISITED(x); + if (x->left) { + x = x->left; + if (IS_BLACK(x)) + curr_blacks++; + continue; + } + else { + if (blacks < 0) + blacks = curr_blacks; + ASSERT(blacks == curr_blacks); + } + } + + if (!IS_RIGHT_VISITED(x)) { + SET_RIGHT_VISITED(x); + if (x->right) { + x = x->right; + if (IS_BLACK(x)) + curr_blacks++; + continue; + } + else { + if (blacks < 0) + blacks = curr_blacks; + ASSERT(blacks == curr_blacks); + } + } + + + if (IS_RED(x)) { + ASSERT(IS_BLACK(x->right)); + ASSERT(IS_BLACK(x->left)); + } + + ASSERT(x->parent || x == root); + + if (x->left) { + ASSERT(x->left->parent == x); + ASSERT(x->left < x); + ASSERT(x->left->max_sz <= x->max_sz); + } + + if (x->right) { + ASSERT(x->right->parent == x); + ASSERT(x->right > x); + ASSERT(x->right->max_sz <= x->max_sz); + } + ASSERT(x->max_sz >= BLK_SZ(x)); + ASSERT(x->max_sz == BLK_SZ(x) + || x->max_sz == (x->left ? x->left->max_sz : 0) + || x->max_sz == (x->right ? x->right->max_sz : 0)); + + if (size && BLK_SZ(x) >= size) { + if (!res || x < res) { + res = x; + } + } + + UNSET_LEFT_VISITED(x); + UNSET_RIGHT_VISITED(x); + if (IS_BLACK(x)) + curr_blacks--; + x = x->parent; + + } + + ASSERT(curr_blacks == 0); + + UNSET_LEFT_VISITED(root); + UNSET_RIGHT_VISITED(root); + + return res; + +} + + +#ifdef PRINT_TREE +#define INDENT_STEP 2 + +#include <stdio.h> + +static void +print_tree_aux(AOFF_RBTree_t *x, int indent) +{ + int i; + + if (x) { + print_tree_aux(x->right, indent + INDENT_STEP); + for (i = 0; i < indent; i++) { + putc(' ', stderr); + } + fprintf(stderr, "%s: sz=%lu addr=0x%lx max_size=%lu\r\n", + IS_BLACK(x) ? "BLACK" : "RED", + BLK_SZ(x), (Uint)x, x->max_sz); + print_tree_aux(x->left, indent + INDENT_STEP); + } +} + + +static void +print_tree(AOFF_RBTree_t* root) +{ + fprintf(stderr, " --- AOFF tree begin ---\r\n"); + print_tree_aux(root, 0); + fprintf(stderr, " --- AOFF tree end ---\r\n"); +} + +#endif /* PRINT_TREE */ + +#endif /* HARD_DEBUG */ + diff --git a/erts/emulator/beam/erl_ao_firstfit_alloc.h b/erts/emulator/beam/erl_ao_firstfit_alloc.h new file mode 100644 index 0000000000..0bf0ec8cee --- /dev/null +++ b/erts/emulator/beam/erl_ao_firstfit_alloc.h @@ -0,0 +1,60 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2003-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + + +#ifndef ERL_AO_FIRSTFIT_ALLOC__ +#define ERL_AO_FIRSTFIT_ALLOC__ + +#include "erl_alloc_util.h" + +#define ERTS_ALC_AOFF_ALLOC_VSN_STR "0.9" + +typedef struct AOFFAllctr_t_ AOFFAllctr_t; + +typedef struct { + int dummy; +} AOFFAllctrInit_t; + +#define ERTS_DEFAULT_AOFF_ALLCTR_INIT {0/*dummy*/} + +void erts_aoffalc_init(void); +Allctr_t *erts_aoffalc_start(AOFFAllctr_t *, AOFFAllctrInit_t*, AllctrInit_t *); + +#endif /* #ifndef ERL_AO_FIRSTFIT_ALLOC__ */ + + + +#if defined(GET_ERL_AOFF_ALLOC_IMPL) && !defined(ERL_AOFF_ALLOC_IMPL__) +#define ERL_AOFF_ALLOC_IMPL__ + +#define GET_ERL_ALLOC_UTIL_IMPL +#include "erl_alloc_util.h" + + +struct AOFFAllctr_t_ { + Allctr_t allctr; /* Has to be first! */ + + struct AOFF_RBTree_t_* mbc_root; + struct AOFF_RBTree_t_* sbmbc_root; +}; + +unsigned long erts_aoffalc_test(unsigned long, unsigned long, unsigned long); + +#endif /* #if defined(GET_ERL_AOFF_ALLOC_IMPL) + && !defined(ERL_AOFF_ALLOC_IMPL__) */ diff --git a/erts/emulator/beam/erl_bestfit_alloc.c b/erts/emulator/beam/erl_bestfit_alloc.c index 3035e5df16..5e3032ddaa 100644 --- a/erts/emulator/beam/erl_bestfit_alloc.c +++ b/erts/emulator/beam/erl_bestfit_alloc.c @@ -84,24 +84,24 @@ #ifdef HARD_DEBUG -static RBTree_t * check_tree(BFAllctr_t *, Uint); +static RBTree_t * check_tree(RBTree_t, int, Uint); #endif -static void tree_delete(Allctr_t *allctr, Block_t *del); +static void tree_delete(Allctr_t *allctr, Block_t *del, Uint32 flags); /* Prototypes of callback functions */ /* "address order best fit" specific callback functions */ static Block_t * aobf_get_free_block (Allctr_t *, Uint, - Block_t *, Uint); -static void aobf_link_free_block (Allctr_t *, Block_t *); + Block_t *, Uint, Uint32); +static void aobf_link_free_block (Allctr_t *, Block_t *, Uint32); #define aobf_unlink_free_block tree_delete /* "best fit" specific callback functions */ static Block_t * bf_get_free_block (Allctr_t *, Uint, - Block_t *, Uint); -static void bf_link_free_block (Allctr_t *, Block_t *); -static ERTS_INLINE void bf_unlink_free_block (Allctr_t *, Block_t *); + Block_t *, Uint, Uint32); +static void bf_link_free_block (Allctr_t *, Block_t *, Uint32); +static ERTS_INLINE void bf_unlink_free_block (Allctr_t *, Block_t *, Uint32); static Eterm info_options (Allctr_t *, char *, int *, @@ -303,7 +303,7 @@ replace(RBTree_t **root, RBTree_t *x, RBTree_t *y) } static void -tree_insert_fixup(BFAllctr_t *bfallctr, RBTree_t *blk) +tree_insert_fixup(RBTree_t **root, RBTree_t *blk) { RBTree_t *x = blk, *y; @@ -311,7 +311,7 @@ tree_insert_fixup(BFAllctr_t *bfallctr, RBTree_t *blk) * Rearrange the tree so that it satisfies the Red-Black Tree properties */ - RBT_ASSERT(x != bfallctr->root && IS_RED(x->parent)); + RBT_ASSERT(x != *root && IS_RED(x->parent)); do { /* @@ -336,7 +336,7 @@ tree_insert_fixup(BFAllctr_t *bfallctr, RBTree_t *blk) if (x == x->parent->right) { x = x->parent; - left_rotate(&bfallctr->root, x); + left_rotate(root, x); } RBT_ASSERT(x == x->parent->parent->left->left); @@ -347,7 +347,7 @@ tree_insert_fixup(BFAllctr_t *bfallctr, RBTree_t *blk) SET_BLACK(x->parent); SET_RED(x->parent->parent); - right_rotate(&bfallctr->root, x->parent->parent); + right_rotate(root, x->parent->parent); RBT_ASSERT(x == x->parent->left); RBT_ASSERT(IS_RED(x)); @@ -370,7 +370,7 @@ tree_insert_fixup(BFAllctr_t *bfallctr, RBTree_t *blk) if (x == x->parent->left) { x = x->parent; - right_rotate(&bfallctr->root, x); + right_rotate(root, x); } RBT_ASSERT(x == x->parent->parent->right->right); @@ -381,7 +381,7 @@ tree_insert_fixup(BFAllctr_t *bfallctr, RBTree_t *blk) SET_BLACK(x->parent); SET_RED(x->parent->parent); - left_rotate(&bfallctr->root, x->parent->parent); + left_rotate(root, x->parent->parent); RBT_ASSERT(x == x->parent->right); RBT_ASSERT(IS_RED(x)); @@ -390,9 +390,9 @@ tree_insert_fixup(BFAllctr_t *bfallctr, RBTree_t *blk) break; } } - } while (x != bfallctr->root && IS_RED(x->parent)); + } while (x != *root && IS_RED(x->parent)); - SET_BLACK(bfallctr->root); + SET_BLACK(*root); } @@ -402,18 +402,22 @@ tree_insert_fixup(BFAllctr_t *bfallctr, RBTree_t *blk) * callback function in the address order case. */ static void -tree_delete(Allctr_t *allctr, Block_t *del) +tree_delete(Allctr_t *allctr, Block_t *del, Uint32 flags) { BFAllctr_t *bfallctr = (BFAllctr_t *) allctr; Uint spliced_is_black; + RBTree_t **root = ((flags & ERTS_ALCU_FLG_SBMBC) + ? &bfallctr->sbmbc_root + : &bfallctr->mbc_root); RBTree_t *x, *y, *z = (RBTree_t *) del; RBTree_t null_x; /* null_x is used to get the fixup started when we splice out a node without children. */ null_x.parent = NULL; + #ifdef HARD_DEBUG - check_tree(bfallctr, 0); + check_tree(*root, bfallctr->address_order, 0); #endif /* Remove node from tree... */ @@ -440,8 +444,8 @@ tree_delete(Allctr_t *allctr, Block_t *del) } if (!y->parent) { - RBT_ASSERT(bfallctr->root == y); - bfallctr->root = x; + RBT_ASSERT(*root == y); + *root = x; } else if (y == y->parent->left) y->parent->left = x; @@ -451,7 +455,7 @@ tree_delete(Allctr_t *allctr, Block_t *del) } if (y != z) { /* We spliced out the successor of z; replace z by the successor */ - replace(&bfallctr->root, z, y); + replace(root, z, y); } if (spliced_is_black) { @@ -476,7 +480,7 @@ tree_delete(Allctr_t *allctr, Block_t *del) SET_BLACK(y); RBT_ASSERT(IS_BLACK(x->parent)); SET_RED(x->parent); - left_rotate(&bfallctr->root, x->parent); + left_rotate(root, x->parent); y = x->parent->right; } RBT_ASSERT(y); @@ -489,7 +493,7 @@ tree_delete(Allctr_t *allctr, Block_t *del) if (IS_BLACK(y->right)) { SET_BLACK(y->left); SET_RED(y); - right_rotate(&bfallctr->root, y); + right_rotate(root, y); y = x->parent->right; } RBT_ASSERT(y); @@ -500,8 +504,8 @@ tree_delete(Allctr_t *allctr, Block_t *del) } RBT_ASSERT(y->right); SET_BLACK(y->right); - left_rotate(&bfallctr->root, x->parent); - x = bfallctr->root; + left_rotate(root, x->parent); + x = *root; break; } } @@ -515,7 +519,7 @@ tree_delete(Allctr_t *allctr, Block_t *del) SET_BLACK(y); RBT_ASSERT(IS_BLACK(x->parent)); SET_RED(x->parent); - right_rotate(&bfallctr->root, x->parent); + right_rotate(root, x->parent); y = x->parent->left; } RBT_ASSERT(y); @@ -528,7 +532,7 @@ tree_delete(Allctr_t *allctr, Block_t *del) if (IS_BLACK(y->left)) { SET_BLACK(y->right); SET_RED(y); - left_rotate(&bfallctr->root, y); + left_rotate(root, y); y = x->parent->left; } RBT_ASSERT(y); @@ -538,8 +542,8 @@ tree_delete(Allctr_t *allctr, Block_t *del) } RBT_ASSERT(y->left); SET_BLACK(y->left); - right_rotate(&bfallctr->root, x->parent); - x = bfallctr->root; + right_rotate(root, x->parent); + x = *root; break; } } @@ -556,8 +560,8 @@ tree_delete(Allctr_t *allctr, Block_t *del) RBT_ASSERT(!null_x.left); RBT_ASSERT(!null_x.right); } - else if (bfallctr->root == &null_x) { - bfallctr->root = NULL; + else if (*root == &null_x) { + *root = NULL; RBT_ASSERT(!null_x.left); RBT_ASSERT(!null_x.right); } @@ -567,7 +571,7 @@ tree_delete(Allctr_t *allctr, Block_t *del) DESTROY_TREE_NODE(del); #ifdef HARD_DEBUG - check_tree(bfallctr, 0); + check_tree(root, bfallctr->address_order, 0); #endif } @@ -577,23 +581,28 @@ tree_delete(Allctr_t *allctr, Block_t *del) \* */ static void -aobf_link_free_block(Allctr_t *allctr, Block_t *block) +aobf_link_free_block(Allctr_t *allctr, Block_t *block, Uint32 flags) { BFAllctr_t *bfallctr = (BFAllctr_t *) allctr; + RBTree_t **root = ((flags & ERTS_ALCU_FLG_SBMBC) + ? &bfallctr->sbmbc_root + : &bfallctr->mbc_root); RBTree_t *blk = (RBTree_t *) block; Uint blk_sz = BLK_SZ(blk); + + blk->flags = 0; blk->left = NULL; blk->right = NULL; - if (!bfallctr->root) { + if (!*root) { blk->parent = NULL; SET_BLACK(blk); - bfallctr->root = blk; + *root = blk; } else { - RBTree_t *x = bfallctr->root; + RBTree_t *x = *root; while (1) { Uint size; @@ -623,28 +632,32 @@ aobf_link_free_block(Allctr_t *allctr, Block_t *block) SET_RED(blk); if (IS_RED(blk->parent)) - tree_insert_fixup(bfallctr, blk); + tree_insert_fixup(root, blk); } #ifdef HARD_DEBUG - check_tree(bfallctr, 0); + check_tree(root, 1, 0); #endif } #if 0 /* tree_delete() is directly used instead */ static void -aobf_unlink_free_block(Allctr_t *allctr, Block_t *block) +aobf_unlink_free_block(Allctr_t *allctr, Block_t *block, Uint32 flags) { - tree_delete(allctr, block); + tree_delete(allctr, block, flags); } #endif static Block_t * aobf_get_free_block(Allctr_t *allctr, Uint size, - Block_t *cand_blk, Uint cand_size) + Block_t *cand_blk, Uint cand_size, + Uint32 flags) { BFAllctr_t *bfallctr = (BFAllctr_t *) allctr; - RBTree_t *x = bfallctr->root; + RBTree_t **root = ((flags & ERTS_ALCU_FLG_SBMBC) + ? &bfallctr->sbmbc_root + : &bfallctr->mbc_root); + RBTree_t *x = *root; RBTree_t *blk = NULL; Uint blk_sz; @@ -665,7 +678,7 @@ aobf_get_free_block(Allctr_t *allctr, Uint size, return NULL; #ifdef HARD_DEBUG - ASSERT(blk == check_tree(bfallctr, size)); + ASSERT(blk == check_tree(root, 1, size)); #endif if (cand_blk) { @@ -676,7 +689,7 @@ aobf_get_free_block(Allctr_t *allctr, Uint size, return NULL; /* cand_blk was better */ } - aobf_unlink_free_block(allctr, (Block_t *) blk); + aobf_unlink_free_block(allctr, (Block_t *) blk, flags); return (Block_t *) blk; } @@ -687,9 +700,12 @@ aobf_get_free_block(Allctr_t *allctr, Uint size, \* */ static void -bf_link_free_block(Allctr_t *allctr, Block_t *block) +bf_link_free_block(Allctr_t *allctr, Block_t *block, Uint32 flags) { BFAllctr_t *bfallctr = (BFAllctr_t *) allctr; + RBTree_t **root = ((flags & ERTS_ALCU_FLG_SBMBC) + ? &bfallctr->sbmbc_root + : &bfallctr->mbc_root); RBTree_t *blk = (RBTree_t *) block; Uint blk_sz = BLK_SZ(blk); @@ -700,13 +716,13 @@ bf_link_free_block(Allctr_t *allctr, Block_t *block) blk->left = NULL; blk->right = NULL; - if (!bfallctr->root) { + if (!*root) { blk->parent = NULL; SET_BLACK(blk); - bfallctr->root = blk; + *root = blk; } else { - RBTree_t *x = bfallctr->root; + RBTree_t *x = *root; while (1) { Uint size; @@ -745,7 +761,7 @@ bf_link_free_block(Allctr_t *allctr, Block_t *block) SET_RED(blk); if (IS_RED(blk->parent)) - tree_insert_fixup(bfallctr, blk); + tree_insert_fixup(root, blk); } @@ -753,14 +769,17 @@ bf_link_free_block(Allctr_t *allctr, Block_t *block) LIST_NEXT(blk) = NULL; #ifdef HARD_DEBUG - check_tree(bfallctr, 0); + check_tree(root, 0, 0); #endif } static ERTS_INLINE void -bf_unlink_free_block(Allctr_t *allctr, Block_t *block) +bf_unlink_free_block(Allctr_t *allctr, Block_t *block, Uint32 flags) { BFAllctr_t *bfallctr = (BFAllctr_t *) allctr; + RBTree_t **root = ((flags & ERTS_ALCU_FLG_SBMBC) + ? &bfallctr->sbmbc_root + : &bfallctr->mbc_root); RBTree_t *x = (RBTree_t *) block; if (IS_LIST_ELEM(x)) { @@ -778,9 +797,9 @@ bf_unlink_free_block(Allctr_t *allctr, Block_t *block) ASSERT(IS_LIST_ELEM(LIST_NEXT(x))); #ifdef HARD_DEBUG - check_tree(bfallctr, 0); + check_tree(root, 0, 0); #endif - replace(&bfallctr->root, x, LIST_NEXT(x)); + replace(root, x, LIST_NEXT(x)); #ifdef HARD_DEBUG check_tree(bfallctr, 0); @@ -788,7 +807,7 @@ bf_unlink_free_block(Allctr_t *allctr, Block_t *block) } else { /* Remove from tree */ - tree_delete(allctr, block); + tree_delete(allctr, block, flags); } DESTROY_LIST_ELEM(x); @@ -797,10 +816,14 @@ bf_unlink_free_block(Allctr_t *allctr, Block_t *block) static Block_t * bf_get_free_block(Allctr_t *allctr, Uint size, - Block_t *cand_blk, Uint cand_size) + Block_t *cand_blk, Uint cand_size, + Uint32 flags) { BFAllctr_t *bfallctr = (BFAllctr_t *) allctr; - RBTree_t *x = bfallctr->root; + RBTree_t **root = ((flags & ERTS_ALCU_FLG_SBMBC) + ? &bfallctr->sbmbc_root + : &bfallctr->mbc_root); + RBTree_t *x = *root; RBTree_t *blk = NULL; Uint blk_sz; @@ -827,7 +850,7 @@ bf_get_free_block(Allctr_t *allctr, Uint size, #ifdef HARD_DEBUG { - RBTree_t *ct_blk = check_tree(bfallctr, size); + RBTree_t *ct_blk = check_tree(root, 0, size); ASSERT(BLK_SZ(ct_blk) == BLK_SZ(blk)); } #endif @@ -839,7 +862,7 @@ bf_get_free_block(Allctr_t *allctr, Uint size, the tree node */ blk = LIST_NEXT(blk) ? LIST_NEXT(blk) : blk; - bf_unlink_free_block(allctr, (Block_t *) blk); + bf_unlink_free_block(allctr, (Block_t *) blk, flags); return (Block_t *) blk; } @@ -949,13 +972,14 @@ erts_bfalc_test(unsigned long op, unsigned long a1, unsigned long a2) { switch (op) { case 0x200: return (unsigned long) ((BFAllctr_t *) a1)->address_order; - case 0x201: return (unsigned long) ((BFAllctr_t *) a1)->root; + case 0x201: return (unsigned long) ((BFAllctr_t *) a1)->mbc_root; case 0x202: return (unsigned long) ((RBTree_t *) a1)->parent; case 0x203: return (unsigned long) ((RBTree_t *) a1)->left; case 0x204: return (unsigned long) ((RBTree_t *) a1)->right; case 0x205: return (unsigned long) ((RBTreeList_t *) a1)->next; case 0x206: return (unsigned long) IS_BLACK((RBTree_t *) a1); case 0x207: return (unsigned long) IS_TREE_NODE((RBTree_t *) a1); + case 0x208: return (unsigned long) 0; /* IS_AOFF */ default: ASSERT(0); return ~((unsigned long) 0); } } @@ -985,7 +1009,7 @@ erts_bfalc_test(unsigned long op, unsigned long a1, unsigned long a2) #endif #ifdef PRINT_TREE -static void print_tree(BFAllctr_t *); +static void print_tree(RBTree_t *, int); #endif /* @@ -1003,7 +1027,7 @@ static void print_tree(BFAllctr_t *); */ static RBTree_t * -check_tree(BFAllctr_t *bfallctr, Uint size) +check_tree(RBTree_t *root, int ao, Uint size) { RBTree_t *res = NULL; Sint blacks; @@ -1011,13 +1035,13 @@ check_tree(BFAllctr_t *bfallctr, Uint size) RBTree_t *x; #ifdef PRINT_TREE - print_tree(bfallctr); + print_tree(root, ao); #endif - if (!bfallctr->root) + if (!root) return res; - x = bfallctr->root; + x = root; ASSERT(IS_BLACK(x)); ASSERT(!x->parent); curr_blacks = 1; @@ -1060,11 +1084,11 @@ check_tree(BFAllctr_t *bfallctr, Uint size) ASSERT(IS_BLACK(x->left)); } - ASSERT(x->parent || x == bfallctr->root); + ASSERT(x->parent || x == root); if (x->left) { ASSERT(x->left->parent == x); - if (bfallctr->address_order) { + if (ao) { ASSERT(BLK_SZ(x->left) < BLK_SZ(x) || (BLK_SZ(x->left) == BLK_SZ(x) && x->left < x)); } @@ -1076,7 +1100,7 @@ check_tree(BFAllctr_t *bfallctr, Uint size) if (x->right) { ASSERT(x->right->parent == x); - if (bfallctr->address_order) { + if (ao) { ASSERT(BLK_SZ(x->right) > BLK_SZ(x) || (BLK_SZ(x->right) == BLK_SZ(x) && x->right > x)); } @@ -1087,7 +1111,7 @@ check_tree(BFAllctr_t *bfallctr, Uint size) } if (size && BLK_SZ(x) >= size) { - if (bfallctr->address_order) { + if (ao) { if (!res || BLK_SZ(x) < BLK_SZ(res) || (BLK_SZ(x) == BLK_SZ(res) && x < res)) @@ -1109,8 +1133,8 @@ check_tree(BFAllctr_t *bfallctr, Uint size) ASSERT(curr_blacks == 0); - UNSET_LEFT_VISITED(bfallctr->root); - UNSET_RIGHT_VISITED(bfallctr->root); + UNSET_LEFT_VISITED(root); + UNSET_RIGHT_VISITED(root); return res; @@ -1148,11 +1172,11 @@ print_tree_aux(RBTree_t *x, int indent) static void -print_tree(BFAllctr_t *bfallctr) +print_tree(RBTree_t *root, int ao) { - char *type = bfallctr->address_order ? "Size-Adress" : "Size"; + char *type = ao ? "Size-Adress" : "Size"; fprintf(stderr, " --- %s tree begin ---\r\n", type); - print_tree_aux(bfallctr->root, 0); + print_tree_aux(root, 0); fprintf(stderr, " --- %s tree end ---\r\n", type); } diff --git a/erts/emulator/beam/erl_bestfit_alloc.h b/erts/emulator/beam/erl_bestfit_alloc.h index cb35e21e57..faa2d9742e 100644 --- a/erts/emulator/beam/erl_bestfit_alloc.h +++ b/erts/emulator/beam/erl_bestfit_alloc.h @@ -54,7 +54,8 @@ typedef struct RBTree_t_ RBTree_t; struct BFAllctr_t_ { Allctr_t allctr; /* Has to be first! */ - RBTree_t * root; + RBTree_t * mbc_root; + RBTree_t * sbmbc_root; int address_order; }; diff --git a/erts/emulator/beam/erl_bits.h b/erts/emulator/beam/erl_bits.h index 0f67733fa4..3309ea706b 100644 --- a/erts/emulator/beam/erl_bits.h +++ b/erts/emulator/beam/erl_bits.h @@ -150,7 +150,7 @@ void erts_bits_destroy_state(ERL_BITS_PROTO_0); * NBYTES(x) returns the number of bytes needed to store x bits. */ -#define NBYTES(x) (((x) + 7) >> 3) +#define NBYTES(x) (((Uint64)(x) + (Uint64) 7) >> 3) #define BYTE_OFFSET(ofs) ((Uint) (ofs) >> 3) #define BIT_OFFSET(ofs) ((ofs) & 7) diff --git a/erts/emulator/beam/erl_db.c b/erts/emulator/beam/erl_db.c index e0a6aa05c6..e9bdeb35ef 100644 --- a/erts/emulator/beam/erl_db.c +++ b/erts/emulator/beam/erl_db.c @@ -338,13 +338,13 @@ static ERTS_INLINE void db_unlock(DbTable* tb, db_lock_kind_t kind) ASSERT(tb != meta_pid_to_tab && tb != meta_pid_to_fixed_tab); if (tb->common.type & DB_FINE_LOCKED) { - if (tb->common.is_thread_safe) { - ASSERT(kind == LCK_WRITE); + if (kind == LCK_WRITE) { + ASSERT(tb->common.is_thread_safe); tb->common.is_thread_safe = 0; erts_smp_rwmtx_rwunlock(&tb->common.rwlock); } else { - ASSERT(kind != LCK_WRITE); + ASSERT(!tb->common.is_thread_safe); erts_smp_rwmtx_runlock(&tb->common.rwlock); } } @@ -543,9 +543,9 @@ static int remove_named_tab(DbTable *tb, int have_lock) * We keep our increased refc over this op in order to * prevent the table from disapearing. */ - erts_smp_rwmtx_rwunlock(&tb->common.rwlock); + db_unlock(tb, LCK_WRITE); erts_smp_rwmtx_rwlock(rwlock); - erts_smp_rwmtx_rwlock(&tb->common.rwlock); + db_lock(tb, LCK_WRITE); } #endif @@ -1650,24 +1650,6 @@ BIF_RETTYPE ets_delete_1(BIF_ALIST_1) tb->common.status &= ~(DB_PROTECTED|DB_PUBLIC|DB_PRIVATE); tb->common.status |= DB_DELETE; - mmtl = get_meta_main_tab_lock(tb->common.slot); -#ifdef ERTS_SMP - if (erts_smp_rwmtx_tryrwlock(mmtl) == EBUSY) { - /* - * We keep our increased refc over this op in order to - * prevent the table from disapearing. - */ - erts_smp_rwmtx_rwunlock(&tb->common.rwlock); - erts_smp_rwmtx_rwlock(mmtl); - erts_smp_rwmtx_rwlock(&tb->common.rwlock); - } -#endif - /* We must keep the slot, to be found by db_proc_dead() if process dies */ - MARK_SLOT_DEAD(tb->common.slot); - erts_smp_rwmtx_rwunlock(mmtl); - if (is_atom(tb->common.id)) - remove_named_tab(tb, 0); - if (tb->common.owner != BIF_P->id) { DeclareTmpHeap(meta_tuple,3,BIF_P); @@ -1691,6 +1673,25 @@ BIF_RETTYPE ets_delete_1(BIF_ALIST_1) db_meta_unlock(meta_pid_to_tab, LCK_WRITE_REC); UnUseTmpHeap(3,BIF_P); } + + mmtl = get_meta_main_tab_lock(tb->common.slot); +#ifdef ERTS_SMP + if (erts_smp_rwmtx_tryrwlock(mmtl) == EBUSY) { + /* + * We keep our increased refc over this op in order to + * prevent the table from disapearing. + */ + db_unlock(tb, LCK_WRITE); + erts_smp_rwmtx_rwlock(mmtl); + db_lock(tb, LCK_WRITE); + } +#endif + /* We must keep the slot, to be found by db_proc_dead() if process dies */ + MARK_SLOT_DEAD(tb->common.slot); + erts_smp_rwmtx_rwunlock(mmtl); + if (is_atom(tb->common.id)) + remove_named_tab(tb, 0); + /* disable inheritance */ free_heir_data(tb); tb->common.heir = am_none; @@ -3657,9 +3658,6 @@ static Eterm table_info(Process* p, DbTable* tb, Eterm What) ret = am_true; else ret = am_false; - } else if (What == am_atom_put("kept_objects",12)) { - ret = make_small(IS_HASH_TABLE(tb->common.status) - ? db_kept_items_hash(&tb->hash) : 0); } else if (What == am_atom_put("safe_fixed",10)) { #ifdef ERTS_SMP erts_smp_mtx_lock(&tb->common.fixlock); @@ -3701,7 +3699,7 @@ static Eterm table_info(Process* p, DbTable* tb, Eterm What) Eterm* hp; db_calc_stats_hash(&tb->hash, &stats); - hp = HAlloc(p, 1 + 6 + FLOAT_SIZE_OBJECT*3); + hp = HAlloc(p, 1 + 7 + FLOAT_SIZE_OBJECT*3); f.fd = stats.avg_chain_len; avg = make_float(hp); PUT_DOUBLE(f, hp); @@ -3716,10 +3714,11 @@ static Eterm table_info(Process* p, DbTable* tb, Eterm What) std_dev_exp = make_float(hp); PUT_DOUBLE(f, hp); hp += FLOAT_SIZE_OBJECT; - ret = TUPLE6(hp, make_small(erts_smp_atomic_read(&tb->hash.nactive)), + ret = TUPLE7(hp, make_small(erts_smp_atomic_read(&tb->hash.nactive)), avg, std_dev_real, std_dev_exp, make_small(stats.min_chain_len), - make_small(stats.max_chain_len)); + make_small(stats.max_chain_len), + make_small(db_kept_items_hash(&tb->hash))); } else { ret = am_false; diff --git a/erts/emulator/beam/erl_db_util.c b/erts/emulator/beam/erl_db_util.c index c3b074f782..e5be1f253a 100644 --- a/erts/emulator/beam/erl_db_util.c +++ b/erts/emulator/beam/erl_db_util.c @@ -1731,6 +1731,7 @@ Eterm db_prog_match(Process *c_p, Binary *bprog, #define BEGIN_ATOMIC_TRACE(p) \ do { \ if (! atomic_trace) { \ + erts_refc_inc(&bprog->refc, 2); \ erts_smp_proc_unlock((p), ERTS_PROC_LOCK_MAIN); \ erts_smp_block_system(0); \ atomic_trace = !0; \ @@ -1741,6 +1742,9 @@ Eterm db_prog_match(Process *c_p, Binary *bprog, if (atomic_trace) { \ erts_smp_release_system(); \ erts_smp_proc_lock((p), ERTS_PROC_LOCK_MAIN); \ + if (erts_refc_dectest(&bprog->refc, 0) == 0) {\ + erts_bin_free(bprog); \ + } \ atomic_trace = 0; \ } \ } while (0) diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c index 5edcd667e7..e3445bcdc5 100644 --- a/erts/emulator/beam/erl_gc.c +++ b/erts/emulator/beam/erl_gc.c @@ -100,14 +100,14 @@ static Uint combined_message_size(Process* p); static void remove_message_buffers(Process* p); static int major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl); static int minor_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl); -static void do_minor(Process *p, int new_sz, Eterm* objv, int nobj); +static void do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj); static Eterm* sweep_rootset(Rootset *rootset, Eterm* htop, char* src, Uint src_size); static Eterm* sweep_one_area(Eterm* n_hp, Eterm* n_htop, char* src, Uint src_size); static Eterm* sweep_one_heap(Eterm* heap_ptr, Eterm* heap_end, Eterm* htop, char* src, Uint src_size); static Eterm* collect_heap_frags(Process* p, Eterm* heap, Eterm* htop, Eterm* objv, int nobj); -static Uint adjust_after_fullsweep(Process *p, int size_before, +static Uint adjust_after_fullsweep(Process *p, Uint size_before, int need, Eterm *objv, int nobj); static void shrink_new_heap(Process *p, Uint new_sz, Eterm *objv, int nobj); static void grow_new_heap(Process *p, Uint new_sz, Eterm* objv, int nobj); @@ -441,7 +441,15 @@ erts_garbage_collect(Process* p, int need, Eterm* objv, int nobj) p->last_old_htop = p->old_htop; #endif - return ((int) (HEAP_TOP(p) - HEAP_START(p)) / 10); + /* FIXME: This function should really return an Sint, i.e., a possibly + 64 bit wide signed integer, but that requires updating all the code + that calls it. For now, we just return INT_MAX if the result is too + large for an int. */ + { + Sint result = (HEAP_TOP(p) - HEAP_START(p)) / 10; + if (result >= INT_MAX) return INT_MAX; + else return (int) result; + } } /* @@ -599,7 +607,7 @@ erts_garbage_collect_literals(Process* p, Eterm* literals, Uint lit_size) char* area; Uint area_size; Eterm* old_htop; - int n; + Uint n; /* * Set GC state. @@ -731,7 +739,7 @@ minor_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl) * This improved Estone by more than 1200 estones on my computer * (Ultra Sparc 10). */ - size_t new_sz = erts_next_heap_size(HEAP_TOP(p) - HEAP_START(p), 1); + Uint new_sz = erts_next_heap_size(HEAP_TOP(p) - HEAP_START(p), 1); /* Create new, empty old_heap */ n_old = (Eterm *) ERTS_HEAP_ALLOC(ERTS_ALC_T_OLD_HEAP, @@ -871,12 +879,12 @@ minor_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl) #endif /* HIPE */ static void -do_minor(Process *p, int new_sz, Eterm* objv, int nobj) +do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj) { Rootset rootset; /* Rootset for GC (stack, dictionary, etc). */ Roots* roots; Eterm* n_htop; - int n; + Uint n; Eterm* ptr; Eterm val; Eterm gval; @@ -1079,14 +1087,14 @@ major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl) { Rootset rootset; Roots* roots; - int size_before; + Uint size_before; Eterm* n_heap; Eterm* n_htop; char* src = (char *) HEAP_START(p); Uint src_size = (char *) HEAP_TOP(p) - src; char* oh = (char *) OLD_HEAP(p); Uint oh_size = (char *) OLD_HTOP(p) - oh; - int n; + Uint n; Uint new_sz; Uint fragments = MBUF_SIZE(p) + combined_message_size(p); ErlMessage *msgp; @@ -1312,10 +1320,10 @@ major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl) } static Uint -adjust_after_fullsweep(Process *p, int size_before, int need, Eterm *objv, int nobj) +adjust_after_fullsweep(Process *p, Uint size_before, int need, Eterm *objv, int nobj) { - int wanted, sz, size_after, need_after; - int stack_size = STACK_SZ_ON_HEAP(p); + Uint wanted, sz, size_after, need_after; + Uint stack_size = STACK_SZ_ON_HEAP(p); Uint reclaimed_now; size_after = (HEAP_TOP(p) - HEAP_START(p)); @@ -1915,8 +1923,8 @@ static void grow_new_heap(Process *p, Uint new_sz, Eterm* objv, int nobj) { Eterm* new_heap; - int heap_size = HEAP_TOP(p) - HEAP_START(p); - int stack_size = p->hend - p->stop; + Uint heap_size = HEAP_TOP(p) - HEAP_START(p); + Uint stack_size = p->hend - p->stop; Sint offs; ASSERT(HEAP_SIZE(p) < new_sz); @@ -1954,10 +1962,10 @@ static void shrink_new_heap(Process *p, Uint new_sz, Eterm *objv, int nobj) { Eterm* new_heap; - int heap_size = HEAP_TOP(p) - HEAP_START(p); + Uint heap_size = HEAP_TOP(p) - HEAP_START(p); Sint offs; - int stack_size = p->hend - p->stop; + Uint stack_size = p->hend - p->stop; ASSERT(new_sz < p->heap_sz); sys_memmove(p->heap + new_sz - stack_size, p->stop, stack_size * diff --git a/erts/emulator/beam/erl_goodfit_alloc.c b/erts/emulator/beam/erl_goodfit_alloc.c index 76b206d76f..1cc508ac5a 100644 --- a/erts/emulator/beam/erl_goodfit_alloc.c +++ b/erts/emulator/beam/erl_goodfit_alloc.c @@ -163,10 +163,10 @@ BKT_MIN_SZ(GFAllctr_t *gfallctr, int ix) /* Prototypes of callback functions */ static Block_t * get_free_block (Allctr_t *, Uint, - Block_t *, Uint); -static void link_free_block (Allctr_t *, Block_t *); -static void unlink_free_block (Allctr_t *, Block_t *); -static void update_last_aux_mbc (Allctr_t *, Carrier_t *); + Block_t *, Uint, Uint32); +static void link_free_block (Allctr_t *, Block_t *, Uint32); +static void unlink_free_block (Allctr_t *, Block_t *, Uint32); +static void update_last_aux_mbc (Allctr_t *, Carrier_t *, Uint32); static Eterm info_options (Allctr_t *, char *, int *, void *, Uint **, Uint *); static void init_atoms (void); @@ -197,6 +197,8 @@ erts_gfalc_start(GFAllctr_t *gfallctr, is a struct). */ Allctr_t *allctr = (Allctr_t *) gfallctr; + init->sbmbct = 0; /* Small mbc not yet supported by goodfit */ + sys_memcpy((void *) gfallctr, (void *) &nulled_state, sizeof(GFAllctr_t)); allctr->mbc_header_size = sizeof(Carrier_t); @@ -379,7 +381,7 @@ search_bucket(Allctr_t *allctr, int ix, Uint size) static Block_t * get_free_block(Allctr_t *allctr, Uint size, - Block_t *cand_blk, Uint cand_size) + Block_t *cand_blk, Uint cand_size, Uint32 flags) { GFAllctr_t *gfallctr = (GFAllctr_t *) allctr; int unsafe_bi, min_bi; @@ -398,7 +400,7 @@ get_free_block(Allctr_t *allctr, Uint size, if (blk) { if (cand_blk && cand_size <= BLK_SZ(blk)) return NULL; /* cand_blk was better */ - unlink_free_block(allctr, blk); + unlink_free_block(allctr, blk, flags); return blk; } if (min_bi < NO_OF_BKTS - 1) { @@ -418,14 +420,14 @@ get_free_block(Allctr_t *allctr, Uint size, ASSERT(blk); if (cand_blk && cand_size <= BLK_SZ(blk)) return NULL; /* cand_blk was better */ - unlink_free_block(allctr, blk); + unlink_free_block(allctr, blk, flags); return blk; } static void -link_free_block(Allctr_t *allctr, Block_t *block) +link_free_block(Allctr_t *allctr, Block_t *block, Uint32 flags) { GFAllctr_t *gfallctr = (GFAllctr_t *) allctr; GFFreeBlock_t *blk = (GFFreeBlock_t *) block; @@ -446,7 +448,7 @@ link_free_block(Allctr_t *allctr, Block_t *block) } static void -unlink_free_block(Allctr_t *allctr, Block_t *block) +unlink_free_block(Allctr_t *allctr, Block_t *block, Uint32 flags) { GFAllctr_t *gfallctr = (GFAllctr_t *) allctr; GFFreeBlock_t *blk = (GFFreeBlock_t *) block; @@ -467,7 +469,7 @@ unlink_free_block(Allctr_t *allctr, Block_t *block) } static void -update_last_aux_mbc(Allctr_t *allctr, Carrier_t *mbc) +update_last_aux_mbc(Allctr_t *allctr, Carrier_t *mbc, Uint32 flags) { GFAllctr_t *gfallctr = (GFAllctr_t *) allctr; diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c index 0a57eb6d88..0173fd40f6 100644 --- a/erts/emulator/beam/erl_init.c +++ b/erts/emulator/beam/erl_init.c @@ -803,10 +803,12 @@ early_init(int *argc, char **argv) /* #if defined(HIPE) hipe_signal_init(); /* must be done very early */ #endif - erl_sys_init(); erl_sys_args(argc, argv); + /* Creates threads on Windows that depend on the arguments, so has to be after erl_sys_args */ + erl_sys_init(); + erts_ets_realloc_always_moves = 0; erts_ets_always_compress = 0; erts_dist_buf_busy_limit = ERTS_DE_BUSY_LIMIT; diff --git a/erts/emulator/beam/erl_instrument.c b/erts/emulator/beam/erl_instrument.c index f3f3c22933..04ea004ef7 100644 --- a/erts/emulator/beam/erl_instrument.c +++ b/erts/emulator/beam/erl_instrument.c @@ -1186,6 +1186,8 @@ erts_instr_init(int stat, int map_stat) sys_memzero((void *) stats->n, sizeof(Stat_t)*(ERTS_ALC_N_MAX+1)); for (i = ERTS_ALC_A_MIN; i <= ERTS_ALC_A_MAX; i++) { + if (ERTS_IS_SBMBC_ALLOCATOR_NO__(i)) + continue; if (erts_allctrs_info[i].enabled) stats->ap[i] = &stats->a[i]; else @@ -1199,6 +1201,8 @@ erts_instr_init(int stat, int map_stat) erts_instr_memory_map = 1; erts_instr_stat = 1; for (i = ERTS_ALC_A_MIN; i <= ERTS_ALC_A_MAX; i++) { + if (ERTS_IS_SBMBC_ALLOCATOR_NO__(i)) + continue; erts_allctrs[i].alloc = map_stat_alloc; erts_allctrs[i].realloc = map_stat_realloc; erts_allctrs[i].free = map_stat_free; @@ -1209,6 +1213,8 @@ erts_instr_init(int stat, int map_stat) else { erts_instr_stat = 1; for (i = ERTS_ALC_A_MIN; i <= ERTS_ALC_A_MAX; i++) { + if (ERTS_IS_SBMBC_ALLOCATOR_NO__(i)) + continue; erts_allctrs[i].alloc = stat_alloc; erts_allctrs[i].realloc = stat_realloc; erts_allctrs[i].free = stat_free; diff --git a/erts/emulator/beam/erl_lock_check.c b/erts/emulator/beam/erl_lock_check.c index 9180508a49..587d82f2bb 100644 --- a/erts/emulator/beam/erl_lock_check.c +++ b/erts/emulator/beam/erl_lock_check.c @@ -153,6 +153,7 @@ static erts_lc_lock_order_t erts_lock_order[] = { { "instr", NULL }, { "fix_alloc", "index" }, { "alcu_allocator", "index" }, + { "sbmbc_alloc", "index" }, { "alcu_delayed_free", "index" }, { "mseg", NULL }, #if HALFWORD_HEAP diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c index 68421b4387..6e7ac43676 100644 --- a/erts/emulator/beam/erl_nif.c +++ b/erts/emulator/beam/erl_nif.c @@ -578,7 +578,15 @@ int enif_is_identical(Eterm lhs, Eterm rhs) int enif_compare(Eterm lhs, Eterm rhs) { - return CMP(lhs,rhs); + Sint result = CMP(lhs,rhs); + + if (result < 0) { + return -1; + } else if (result > 0) { + return 1; + } + + return result; } int enif_get_tuple(ErlNifEnv* env, Eterm tpl, int* arity, const Eterm** array) @@ -833,8 +841,11 @@ ERL_NIF_TERM enif_make_uint(ErlNifEnv* env, unsigned i) ERL_NIF_TERM enif_make_long(ErlNifEnv* env, long i) { + if (IS_SSMALL(i)) { + return make_small(i); + } #if SIZEOF_LONG == ERTS_SIZEOF_ETERM - return IS_SSMALL(i) ? make_small(i) : small_to_big(i, alloc_heap(env,2)); + return small_to_big(i, alloc_heap(env,2)); #elif SIZEOF_LONG == 8 ensure_heap(env,3); return erts_sint64_to_big(i, &env->hp); @@ -843,8 +854,11 @@ ERL_NIF_TERM enif_make_long(ErlNifEnv* env, long i) ERL_NIF_TERM enif_make_ulong(ErlNifEnv* env, unsigned long i) { + if (IS_USMALL(0,i)) { + return make_small(i); + } #if SIZEOF_LONG == ERTS_SIZEOF_ETERM - return IS_USMALL(0,i) ? make_small(i) : uint_to_big(i,alloc_heap(env,2)); + return uint_to_big(i,alloc_heap(env,2)); #elif SIZEOF_LONG == 8 ensure_heap(env,3); return erts_uint64_to_big(i, &env->hp); diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index 2704359a8f..d8aed63544 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -5782,10 +5782,13 @@ erts_sched_stat_term(Process *p, int total) void erts_schedule_misc_op(void (*func)(void *), void *arg) { - ErtsRunQueue *rq = erts_get_runq_current(NULL); + ErtsRunQueue *rq; ErtsMiscOpList *molp = misc_op_list_alloc(); + ErtsSchedulerData *esdp = erts_get_scheduler_data(); - if (!rq) { + if (esdp) { + rq = esdp->run_queue; + } else { /* * This can only happen when the sys msg dispatcher * thread schedules misc ops (this happens *very* diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c index 1a102f7187..6953e7fe7d 100644 --- a/erts/emulator/beam/external.c +++ b/erts/emulator/beam/external.c @@ -459,6 +459,12 @@ Uint erts_encode_ext_size(Eterm term) + 1 /* VERSION_MAGIC */; } +Uint erts_encode_ext_size_2(Eterm term, unsigned dflags) +{ + return encode_size_struct2(NULL, term, TERM_TO_BINARY_DFLAGS|dflags) + + 1 /* VERSION_MAGIC */; +} + Uint erts_encode_ext_size_ets(Eterm term) { return encode_size_struct2(NULL, term, TERM_TO_BINARY_DFLAGS|DFLAGS_INTERNAL_TAGS); @@ -1262,6 +1268,49 @@ external_size_1(Process* p, Eterm Term) } Eterm +external_size_2(Process* p, Eterm Term, Eterm Flags) +{ + Uint size; + Uint flags = TERM_TO_BINARY_DFLAGS; + + while (is_list(Flags)) { + Eterm arg = CAR(list_val(Flags)); + Eterm* tp; + + if (is_tuple(arg) && *(tp = tuple_val(arg)) == make_arityval(2)) { + if (tp[1] == am_minor_version && is_small(tp[2])) { + switch (signed_val(tp[2])) { + case 0: + break; + case 1: + flags |= DFLAG_NEW_FLOATS; + break; + default: + goto error; + } + } else { + goto error; + } + } else { + error: + BIF_ERROR(p, BADARG); + } + Flags = CDR(list_val(Flags)); + } + if (is_not_nil(Flags)) { + goto error; + } + + size = erts_encode_ext_size_2(Term, flags); + if (IS_USMALL(0, size)) { + BIF_RET(make_small(size)); + } else { + Eterm* hp = HAlloc(p, BIG_UINT_HEAP_SIZE); + BIF_RET(uint_to_big(size, hp)); + } +} + +Eterm erts_term_to_binary(Process* p, Eterm Term, int level, Uint flags) { Uint size; diff --git a/erts/emulator/beam/external.h b/erts/emulator/beam/external.h index d8287b96a4..72fe74baf2 100644 --- a/erts/emulator/beam/external.h +++ b/erts/emulator/beam/external.h @@ -160,6 +160,7 @@ Uint erts_encode_dist_ext_size(Eterm, Uint32, ErtsAtomCacheMap *); void erts_encode_dist_ext(Eterm, byte **, Uint32, ErtsAtomCacheMap *); Uint erts_encode_ext_size(Eterm); +Uint erts_encode_ext_size_2(Eterm, unsigned); Uint erts_encode_ext_size_ets(Eterm); void erts_encode_ext(Eterm, byte **); byte* erts_encode_ext_ets(Eterm, byte *, struct erl_off_heap_header** ext_off_heap); diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab index 8a5763b4bb..304ce22ef2 100644 --- a/erts/emulator/beam/ops.tab +++ b/erts/emulator/beam/ops.tab @@ -1236,7 +1236,7 @@ i_bs_init_heap I I I d i_bs_init_heap_bin_heap I I I d -bs_init_bits Fail Sz Words Regs Flags Dst | binary_too_big_bits(Sz) => system_limit Fail +bs_init_bits Fail Sz=o Words Regs Flags Dst => system_limit Fail bs_init_bits Fail Sz=u Words=u==0 Regs Flags Dst => i_bs_init_bits Sz Regs Dst bs_init_bits Fail Sz=u Words Regs Flags Dst => i_bs_init_bits_heap Sz Words Regs Dst diff --git a/erts/emulator/drivers/common/inet_drv.c b/erts/emulator/drivers/common/inet_drv.c index 40c4a0df08..ebc4469a23 100644 --- a/erts/emulator/drivers/common/inet_drv.c +++ b/erts/emulator/drivers/common/inet_drv.c @@ -3709,6 +3709,8 @@ static int inet_ctl_fdopen(inet_descriptor* desc, int domain, int type, /* check that it is a socket and that the socket is bound */ if (IS_SOCKET_ERROR(sock_name(s, (struct sockaddr*) &name, &sz))) return ctl_error(sock_errno(), rbuf, rsize); + if (name.sa.sa_family != domain) + return ctl_error(EINVAL, rbuf, rsize); desc->s = s; if ((desc->event = sock_create_event(desc)) == INVALID_EVENT) return ctl_error(sock_errno(), rbuf, rsize); @@ -9739,7 +9741,7 @@ static int packet_inet_ctl(ErlDrvData e, unsigned int cmd, char* buf, int len, if (desc->active || (len != 8)) return ctl_error(EINVAL, rbuf, rsize); timeout = get_int32(buf); - /* The 2nd arg, Length(4), is ignored for both UDP ans SCTP protocols, + /* The 2nd arg, Length(4), is ignored for both UDP and SCTP protocols, since they are msg-oriented. */ if (enq_async(desc, tbuf, PACKET_REQ_RECV) < 0) diff --git a/erts/emulator/drivers/win32/win_efile.c b/erts/emulator/drivers/win32/win_efile.c index 3d59564f7b..931bb196f1 100755 --- a/erts/emulator/drivers/win32/win_efile.c +++ b/erts/emulator/drivers/win32/win_efile.c @@ -127,6 +127,8 @@ static int errno_map(DWORD last_error) { return EBUSY; case ERROR_NO_PROC_SLOTS: return EAGAIN; + case ERROR_CANT_RESOLVE_FILENAME: + return EMLINK; case ERROR_ARENA_TRASHED: case ERROR_INVALID_BLOCK: case ERROR_BAD_ENVIRONMENT: @@ -1405,7 +1407,7 @@ efile_readlink(Efile_error* errInfo, char* name, char* buffer, size_t size) DWORD fileAttributes = GetFileAttributesW(wname); if ((fileAttributes & FILE_ATTRIBUTE_REPARSE_POINT)) { BOOLEAN success = 0; - HANDLE h = CreateFileW(wname, GENERIC_READ, 0,NULL, OPEN_EXISTING, 0, NULL); + HANDLE h = CreateFileW(wname, GENERIC_READ, 0,NULL, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, NULL); int len; if(h != INVALID_HANDLE_VALUE) { success = pGetFinalPathNameByHandle(h, wbuffer, size,0); @@ -1421,7 +1423,7 @@ efile_readlink(Efile_error* errInfo, char* name, char* buffer, size_t size) if (*wbuffer == L'\\') *wbuffer = L'/'; CloseHandle(h); - } + } FreeLibrary(hModule); if (success) { return 1; diff --git a/erts/emulator/hipe/hipe_mode_switch.c b/erts/emulator/hipe/hipe_mode_switch.c index 16f8fb1347..e3e8367b62 100644 --- a/erts/emulator/hipe/hipe_mode_switch.c +++ b/erts/emulator/hipe/hipe_mode_switch.c @@ -346,7 +346,12 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[]) p->arity = callee_arity; } - /* If process is in P_WAITING state, we schedule the next process */ + /* Schedule next process if current process was hibernated or is waiting + for messages */ + if (p->flags & F_HIBERNATE_SCHED) { + p->flags &= ~F_HIBERNATE_SCHED; + goto do_schedule; + } if (p->status == P_WAITING) { goto do_schedule; } diff --git a/erts/emulator/sys/unix/sys.c b/erts/emulator/sys/unix/sys.c index bafbbb0f6c..e5ee0df7fa 100644 --- a/erts/emulator/sys/unix/sys.c +++ b/erts/emulator/sys/unix/sys.c @@ -527,7 +527,6 @@ erts_sys_pre_init(void) void erl_sys_init(void) { - erts_smp_rwmtx_init(&environ_rwmtx, "environ"); #if !DISABLE_VFORK { int res; @@ -3090,6 +3089,8 @@ erl_sys_args(int* argc, char** argv) { int i, j; + erts_smp_rwmtx_init(&environ_rwmtx, "environ"); + i = 1; ASSERT(argc && argv); @@ -3151,4 +3152,5 @@ erl_sys_args(int* argc, char** argv) argv[j++] = argv[i]; } *argc = j; + } diff --git a/erts/emulator/sys/win32/sys.c b/erts/emulator/sys/win32/sys.c index a2159d063c..76db355a9c 100644 --- a/erts/emulator/sys/win32/sys.c +++ b/erts/emulator/sys/win32/sys.c @@ -3282,6 +3282,7 @@ erts_sys_pre_init(void) } #endif erts_smp_atomic_init(&sys_misc_mem_sz, 0); + erts_sys_env_init(); } void noinherit_std_handle(DWORD type) @@ -3297,8 +3298,6 @@ void erl_sys_init(void) { HANDLE handle; - erts_sys_env_init(); - noinherit_std_handle(STD_OUTPUT_HANDLE); noinherit_std_handle(STD_INPUT_HANDLE); noinherit_std_handle(STD_ERROR_HANDLE); diff --git a/erts/emulator/test/alloc_SUITE_data/allocator_test.h b/erts/emulator/test/alloc_SUITE_data/allocator_test.h index b869a4079c..8b34375980 100644 --- a/erts/emulator/test/alloc_SUITE_data/allocator_test.h +++ b/erts/emulator/test/alloc_SUITE_data/allocator_test.h @@ -82,15 +82,17 @@ typedef void* erts_cond; #define NO_OF_BKTS ((Ulong) ALC_TEST0(0x102)) #define FIND_BKT(A, I) ((int) ALC_TEST2(0x103, (A), (I))) -/* From erl_bestfit_alloc.c */ -#define IS_AOBF(A) ((Ulong) ALC_TEST1(0x200, (A))) -#define RBT_ROOT(A) ((RBT_t *) ALC_TEST1(0x201, (A))) -#define RBT_PARENT(T) ((RBT_t *) ALC_TEST1(0x202, (T))) -#define RBT_LEFT(T) ((RBT_t *) ALC_TEST1(0x203, (T))) -#define RBT_RIGHT(T) ((RBT_t *) ALC_TEST1(0x204, (T))) -#define RBT_NEXT(T) ((RBTL_t *) ALC_TEST1(0x205, (T))) -#define RBT_IS_BLACK(T) ((Ulong) ALC_TEST1(0x206, (T))) -#define RBT_IS_TREE(T) ((Ulong) ALC_TEST1(0x207, (T))) +/* From erl_bestfit_alloc.c and erl_ao_firstfit_alloc.c */ +#define IS_AOBF(A) ((Ulong) ALC_TEST1(RBT_OP(0), (A))) +#define RBT_ROOT(A) ((RBT_t *) ALC_TEST1(RBT_OP(1), (A))) +#define RBT_PARENT(T) ((RBT_t *) ALC_TEST1(RBT_OP(2), (T))) +#define RBT_LEFT(T) ((RBT_t *) ALC_TEST1(RBT_OP(3), (T))) +#define RBT_RIGHT(T) ((RBT_t *) ALC_TEST1(RBT_OP(4), (T))) +#define RBT_NEXT(T) ((RBTL_t *) ALC_TEST1(RBT_OP(5), (T))) +#define RBT_IS_BLACK(T) ((Ulong) ALC_TEST1(RBT_OP(6), (T))) +#define RBT_IS_TREE(T) ((Ulong) ALC_TEST1(RBT_OP(7), (T))) +#define IS_AOFF(A) ((Ulong) ALC_TEST1(RBT_OP(8), (A))) +#define RBT_MAX_SZ(T) ((Ulong) ALC_TEST1(RBT_OP(9), (T))) /* From erl_mseg.c */ #define HAVE_MSEG() ((int) ALC_TEST0(0x400)) diff --git a/erts/emulator/test/alloc_SUITE_data/coalesce.c b/erts/emulator/test/alloc_SUITE_data/coalesce.c index c84da97d35..6f35d3279b 100644 --- a/erts/emulator/test/alloc_SUITE_data/coalesce.c +++ b/erts/emulator/test/alloc_SUITE_data/coalesce.c @@ -267,7 +267,7 @@ void testcase_run(TestCaseState_t *tcs) { char *argv_org[] = {"-tmmbcs1024", "-tsbct2048", "-trmbcmt100", "-tas", NULL, NULL}; - char *alg[] = {"af", "gf", "bf", "aobf", NULL}; + char *alg[] = {"af", "gf", "bf", "aobf", "aoff", NULL}; int i; for (i = 0; alg[i]; i++) { diff --git a/erts/emulator/test/alloc_SUITE_data/rbtree.c b/erts/emulator/test/alloc_SUITE_data/rbtree.c index c97e0aac1a..4e7f821baf 100644 --- a/erts/emulator/test/alloc_SUITE_data/rbtree.c +++ b/erts/emulator/test/alloc_SUITE_data/rbtree.c @@ -34,6 +34,14 @@ typedef struct { #define PRINT_TREE #endif +/* Ugly hack to steer the test code towards the right allocator */ +#define RBT_OP(CMD) (current_rbt_type_op_base + (CMD)) +static enum { + BESTFIT_OP_BASE = 0x200, + AO_FIRSTFIT_OP_BASE = 0x500 +}current_rbt_type_op_base; + + #ifdef PRINT_TREE #define INDENT_STEP 5 @@ -65,12 +73,11 @@ print_tree_aux(TestCaseState_t *tcs, RBT_t *x, int indent) static void -print_tree(TestCaseState_t *tcs, RBT_t *root, int aobf) +print_tree(TestCaseState_t *tcs, RBT_t *root) { - char *type = aobf ? "Size-Adress" : "Size"; - testcase_printf(tcs, " --- %s tree begin ---\r\n", type); + testcase_printf(tcs, " --- Tree begin ---\r\n"); print_tree_aux(tcs, root, 0); - testcase_printf(tcs, " --- %s tree end ---\r\n", type); + testcase_printf(tcs, " --- Tree end ---\r\n"); } #endif @@ -78,7 +85,8 @@ print_tree(TestCaseState_t *tcs, RBT_t *root, int aobf) static RBT_t * check_tree(TestCaseState_t *tcs, Allctr_t *alc, Ulong size) { - int i, max_i, address_order; + enum { BF, AOBF, AOFF }type; + int i, max_i; char stk[128]; RBT_t *root, *x, *y, *res; Ulong x_sz, y_sz, is_x_black; @@ -86,11 +94,14 @@ check_tree(TestCaseState_t *tcs, Allctr_t *alc, Ulong size) res = NULL; - address_order = IS_AOBF(alc); + if (IS_AOBF(alc)) type = AOBF; + else if (IS_AOFF(alc)) type = AOFF; + else type = BF; + root = RBT_ROOT(alc); #ifdef PRINT_TREE - print_tree(tcs, root, address_order); + print_tree(tcs, root); #endif max_i = i = -1; @@ -165,12 +176,18 @@ check_tree(TestCaseState_t *tcs, Allctr_t *alc, Ulong size) if (y) { y_sz = BLK_SZ(y); ASSERT(tcs, RBT_PARENT(y) == x); - if (address_order) { + switch (type) { + case AOBF: ASSERT(tcs, y_sz < x_sz || (y_sz == x_sz && y < x)); - } - else { + break; + case BF: ASSERT(tcs, RBT_IS_TREE(y)); ASSERT(tcs, y_sz < x_sz); + break; + case AOFF: + ASSERT(tcs, y < x); + ASSERT(tcs, RBT_MAX_SZ(y) <= RBT_MAX_SZ(x)); + break; } } @@ -178,16 +195,22 @@ check_tree(TestCaseState_t *tcs, Allctr_t *alc, Ulong size) if (y) { y_sz = BLK_SZ(y); ASSERT(tcs, RBT_PARENT(y) == x); - if (address_order) { + switch (type) { + case AOBF: ASSERT(tcs, y_sz > x_sz || (y_sz == x_sz && y > x)); - } - else { + break; + case BF: ASSERT(tcs, RBT_IS_TREE(y)); ASSERT(tcs, y_sz > x_sz); + break; + case AOFF: + ASSERT(tcs, y > x); + ASSERT(tcs, RBT_MAX_SZ(y) <= RBT_MAX_SZ(x)); + break; } } - if (!address_order) { + if (type == BF) { Ulong l_sz; RBTL_t *l = RBT_NEXT(x); for (l = RBT_NEXT(x); l; l = RBT_NEXT(l)) { @@ -202,13 +225,20 @@ check_tree(TestCaseState_t *tcs, Allctr_t *alc, Ulong size) res = x; else { y_sz = BLK_SZ(res); - if (address_order) { + switch (type) { + case AOBF: if (x_sz < y_sz || (x_sz == y_sz && x < res)) res = x; - } - else { - if (!res || x_sz < y_sz) + break; + case BF: + if (x_sz < y_sz) res = x; + break; + case AOFF: + if (x < res) { + res = x; + } + break; } } } @@ -257,7 +287,7 @@ static void test_it(TestCaseState_t *tcs) { int i; - Allctr_t a = ((rbtree_test_data *) tcs->extra)->allocator; + Allctr_t* a = ((rbtree_test_data *) tcs->extra)->allocator; void **blk = ((rbtree_test_data *) tcs->extra)->blk; void **fence = ((rbtree_test_data *) tcs->extra)->fence; Ulong min_blk_sz; @@ -338,6 +368,7 @@ testcase_run(TestCaseState_t *tcs) { char *argv1[] = {"-tasbf", NULL}; char *argv2[] = {"-tasaobf", NULL}; + char *argv3[] = {"-tasaoff", NULL}; Allctr_t *a; rbtree_test_data *td; @@ -355,6 +386,7 @@ testcase_run(TestCaseState_t *tcs) testcase_printf(tcs, "Starting test of best fit...\n"); + current_rbt_type_op_base = BESTFIT_OP_BASE; td->allocator = a = START_ALC("rbtree_bf_", 0, argv1); ASSERT(tcs, a); @@ -371,6 +403,7 @@ testcase_run(TestCaseState_t *tcs) testcase_printf(tcs, "Starting test of address order best fit...\n"); + current_rbt_type_op_base = BESTFIT_OP_BASE; td->allocator = a = START_ALC("rbtree_aobf_", 0, argv2); ASSERT(tcs, a); @@ -383,4 +416,19 @@ testcase_run(TestCaseState_t *tcs) testcase_printf(tcs, "Address order best fit test succeeded!\n"); + /* Address order first fit... */ + + testcase_printf(tcs, "Starting test of address order first fit...\n"); + + current_rbt_type_op_base = AO_FIRSTFIT_OP_BASE; + td->allocator = a = START_ALC("rbtree_aoff_", 0, argv3); + + ASSERT(tcs, a); + + test_it(tcs); + + STOP_ALC(a); + td->allocator = NULL; + + testcase_printf(tcs, "Address order first fit test succeeded!\n"); } diff --git a/erts/emulator/test/binary_SUITE.erl b/erts/emulator/test/binary_SUITE.erl index 4e82381fba..fed5854112 100644 --- a/erts/emulator/test/binary_SUITE.erl +++ b/erts/emulator/test/binary_SUITE.erl @@ -478,6 +478,11 @@ terms(Config) when is_list(Config) -> Sz when is_integer(Sz), size(Bin) =< Sz -> ok end, + Bin1 = term_to_binary(Term, [{minor_version, 1}]), + case erlang:external_size(Bin1, [{minor_version, 1}]) of + Sz1 when is_integer(Sz1), size(Bin1) =< Sz1 -> + ok + end, Term = binary_to_term(Bin), Term = binary_to_term(Bin, [safe]), Unaligned = make_unaligned_sub_binary(Bin), @@ -510,7 +515,12 @@ terms_float(Config) when is_list(Config) -> Term = binary_to_term(Bin0), Bin1 = term_to_binary(Term, [{minor_version,1}]), Term = binary_to_term(Bin1), - true = size(Bin1) < size(Bin0) + true = size(Bin1) < size(Bin0), + Size0 = erlang:external_size(Term), + Size00 = erlang:external_size(Term, [{minor_version, 0}]), + Size1 = erlang:external_size(Term, [{minor_version, 1}]), + true = (Size0 =:= Size00), + true = Size1 < Size0 end). external_size(Config) when is_list(Config) -> @@ -526,7 +536,9 @@ external_size(Config) when is_list(Config) -> io:format(" Aligned size: ~p\n", [Sz1]), io:format("Unaligned size: ~p\n", [Sz2]), ?line ?t:fail() - end. + end, + ?line erlang:external_size(Bin) =:= erlang:external_size(Bin, [{minor_version, 1}]), + ?line erlang:external_size(Unaligned) =:= erlang:external_size(Unaligned, [{minor_version, 1}]). external_size_1(Term, Size0, Limit) when Size0 < Limit -> case erlang:external_size(Term) of diff --git a/erts/emulator/test/bs_construct_SUITE.erl b/erts/emulator/test/bs_construct_SUITE.erl index 1959803385..7fdf36711b 100644 --- a/erts/emulator/test/bs_construct_SUITE.erl +++ b/erts/emulator/test/bs_construct_SUITE.erl @@ -553,6 +553,11 @@ huge_float_check({'EXIT',{badarg,_}}) -> ok. huge_binary(Config) when is_list(Config) -> ?line 16777216 = size(<<0:(id(1 bsl 26)),(-1):(id(1 bsl 26))>>), + ?line garbage_collect(), + ?line id(<<0:((1 bsl 32)-1)>>), + ?line garbage_collect(), + ?line id(<<0:(id((1 bsl 32)-1))>>), + ?line garbage_collect(), ok. system_limit(Config) when is_list(Config) -> @@ -565,6 +570,10 @@ system_limit(Config) when is_list(Config) -> ?line {'EXIT',{system_limit,_}} = (catch <<(id(<<>>))/binary,0:(id(1 bsl 100))>>), + %% Would fail to load. + ?line {'EXIT',{system_limit,_}} = (catch <<0:(1 bsl 67)>>), + ?line {'EXIT',{system_limit,_}} = (catch <<0:((1 bsl 64)+1)>>), + case WordSize of 4 -> system_limit_32(); @@ -581,6 +590,14 @@ system_limit_32() -> ?line {'EXIT',{system_limit,_}} = (catch <<0:(id(8)),42:536870912/unit:8>>), ?line {'EXIT',{system_limit,_}} = (catch <<0:(id(8)),42:(id(536870912))/unit:8>>), + + %% The size would be silently truncated, resulting in a crash. + ?line {'EXIT',{system_limit,_}} = (catch <<0:(1 bsl 35)>>), + ?line {'EXIT',{system_limit,_}} = (catch <<0:((1 bsl 32)+1)>>), + + %% Would fail to load. + ?line {'EXIT',{system_limit,_}} = (catch <<0:(1 bsl 43)>>), + ?line {'EXIT',{system_limit,_}} = (catch <<0:((1 bsl 40)+1)>>), ok. badarg(Config) when is_list(Config) -> diff --git a/erts/emulator/test/code_SUITE.erl b/erts/emulator/test/code_SUITE.erl index a062cea117..29cbdedd17 100644 --- a/erts/emulator/test/code_SUITE.erl +++ b/erts/emulator/test/code_SUITE.erl @@ -20,7 +20,9 @@ -module(code_SUITE). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, - new_binary_types/1,t_check_process_code/1,t_check_process_code_ets/1, + new_binary_types/1, + t_check_process_code/1,t_check_old_code/1, + t_check_process_code_ets/1, external_fun/1,get_chunk/1,module_md5/1,make_stub/1, make_stub_many_funs/1,constant_pools/1, false_dependency/1,coverage/1]). @@ -31,7 +33,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [new_binary_types, t_check_process_code, - t_check_process_code_ets, external_fun, get_chunk, + t_check_process_code_ets, t_check_old_code, external_fun, get_chunk, module_md5, make_stub, make_stub_many_funs, constant_pools, false_dependency, coverage]. @@ -248,6 +250,32 @@ fun_refc(F) -> Count. +%% Test the erlang:check_old_code/1 BIF. +t_check_old_code(Config) when is_list(Config) -> + ?line Data = ?config(data_dir, Config), + ?line File = filename:join(Data, "my_code_test"), + + ?line erlang:purge_module(my_code_test), + ?line erlang:delete_module(my_code_test), + ?line catch erlang:purge_module(my_code_test), + + ?line false = erlang:check_old_code(my_code_test), + + ?line {ok,my_code_test,Code} = compile:file(File, [binary]), + ?line {module,my_code_test} = code:load_binary(my_code_test, File, Code), + + ?line false = erlang:check_old_code(my_code_test), + ?line {module,my_code_test} = code:load_binary(my_code_test, File, Code), + ?line true = erlang:check_old_code(my_code_test), + + ?line true = erlang:purge_module(my_code_test), + ?line true = erlang:delete_module(my_code_test), + ?line true = erlang:purge_module(my_code_test), + + ?line {'EXIT',_} = (catch erlang:check_old_code([])), + + ok. + external_fun(Config) when is_list(Config) -> ?line false = erlang:function_exported(another_code_test, x, 1), ?line ExtFun = erlang:make_fun(id(another_code_test), x, 1), diff --git a/erts/emulator/test/fun_SUITE.erl b/erts/emulator/test/fun_SUITE.erl index 7795efe57e..559e540016 100644 --- a/erts/emulator/test/fun_SUITE.erl +++ b/erts/emulator/test/fun_SUITE.erl @@ -647,17 +647,11 @@ refc_dist_1() -> %% Fun is passed in an exit signal. Wait until it is gone. ?line wait_until(fun () -> 4 =/= fun_refc(F2) end), ?line 3 = fun_refc(F2), - erts_debug:set_internal_state(available_internal_state, true), - ?line F_refc = case erts_debug:get_internal_state(force_heap_frags) of - false -> 3; - true -> 2 % GC after bif already decreased it - end, - ?line F_refc = fun_refc(F), - erts_debug:set_internal_state(available_internal_state, false), + ?line true = erlang:garbage_collect(), + ?line 2 = fun_refc(F), refc_dist_send(Node, F). refc_dist_send(Node, F) -> - ?line true = erlang:garbage_collect(), ?line Pid = spawn_link(Node, fun() -> receive {To,Fun} when is_function(Fun) -> diff --git a/erts/emulator/test/hibernate_SUITE.erl b/erts/emulator/test/hibernate_SUITE.erl index 203fa6b48e..82a0aad189 100644 --- a/erts/emulator/test/hibernate_SUITE.erl +++ b/erts/emulator/test/hibernate_SUITE.erl @@ -25,16 +25,16 @@ init_per_group/2,end_per_group/2, init_per_testcase/2,end_per_testcase/2, basic/1,dynamic_call/1,min_heap_size/1,bad_args/1, - messages_in_queue/1,undefined_mfa/1, no_heap/1]). + messages_in_queue/1,undefined_mfa/1,no_heap/1,wake_up_and_bif_trap/1]). %% Used by test cases. --export([basic_hibernator/1,dynamic_call_hibernator/2,messages_in_queue_restart/2, no_heap_loop/0]). +-export([basic_hibernator/1,dynamic_call_hibernator/2,messages_in_queue_restart/2, no_heap_loop/0,characters_to_list_trap/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [basic, dynamic_call, min_heap_size, bad_args, messages_in_queue, - undefined_mfa, no_heap]. + undefined_mfa, no_heap, wake_up_and_bif_trap]. groups() -> []. @@ -384,6 +384,31 @@ clean_dict() -> lists:foreach(fun ({Key, _}) -> erase(Key) end, Dict). %% +%% Wake up and then immediatly bif trap with a lengthy computation. +%% + +wake_up_and_bif_trap(doc) -> []; +wake_up_and_bif_trap(suite) -> []; +wake_up_and_bif_trap(Config) when is_list(Config) -> + ?line Self = self(), + ?line Pid = spawn_link(fun() -> erlang:hibernate(?MODULE, characters_to_list_trap, [Self]) end), + ?line Pid ! wakeup, + ?line receive + {ok, Pid0} when Pid0 =:= Pid -> ok + after 5000 -> + ?line ?t:fail(process_blocked) + end, + ?line unlink(Pid), + ?line exit(Pid, bye). + +%% Lengthy computation that traps (in characters_to_list_trap_3). +characters_to_list_trap(Parent) -> + Bin0 = <<"abcdefghijklmnopqrstuvwxz0123456789">>, + Bin = binary:copy(Bin0, 1500), + unicode:characters_to_list(Bin), + Parent ! {ok, self()}. + +%% %% Misc %% diff --git a/erts/emulator/test/match_spec_SUITE.erl b/erts/emulator/test/match_spec_SUITE.erl index 2b21fa58f4..461773114e 100644 --- a/erts/emulator/test/match_spec_SUITE.erl +++ b/erts/emulator/test/match_spec_SUITE.erl @@ -27,8 +27,9 @@ destructive_in_test_bif/1, guard_exceptions/1, unary_plus/1, unary_minus/1, moving_labels/1]). -export([fpe/1]). +-export([otp_9422/1]). --export([runner/2]). +-export([runner/2, loop_runner/3]). -export([f1/1, f2/2, f3/2, fn/1, fn/2, fn/3]). -export([do_boxed_and_small/0]). @@ -57,7 +58,8 @@ all() -> trace_control_word, silent, silent_no_ms, ms_trace2, ms_trace3, boxed_and_small, destructive_in_test_bif, guard_exceptions, unary_plus, unary_minus, fpe, - moving_labels]; + moving_labels, + otp_9422]; true -> [not_run] end. @@ -208,6 +210,43 @@ test_3(Config) when is_list(Config) -> ?line collect(P1, [{trace, P1, call, {?MODULE, f2, [a, b]}, [true]}]), ?line ok. +otp_9422(doc) -> []; +otp_9422(Config) when is_list(Config) -> + Laps = 1000, + ?line Fun1 = fun() -> otp_9422_tracee() end, + ?line P1 = spawn_link(?MODULE, loop_runner, [self(), Fun1, Laps]), + io:format("spawned ~p as tracee\n", [P1]), + + ?line erlang:trace(P1, true, [call, silent]), + + ?line Fun2 = fun() -> otp_9422_trace_changer() end, + ?line P2 = spawn_link(?MODULE, loop_runner, [self(), Fun2, Laps]), + io:format("spawned ~p as trace_changer\n", [P2]), + + start_collect(P1), + start_collect(P2), + + %%receive after 10*1000 -> ok end, + + stop_collect(P1), + stop_collect(P2), + ok. + +otp_9422_tracee() -> + ?MODULE:f1(a), + ?MODULE:f1(b), + ?MODULE:f1(c). + +otp_9422_trace_changer() -> + Pat1 = [{[a], [], [{enable_trace, arity}]}], + ?line erlang:trace_pattern({?MODULE, f1, 1}, Pat1), + Pat2 = [{[b], [], [{disable_trace, arity}]}], + ?line erlang:trace_pattern({?MODULE, f1, 1}, Pat2). + + + + + bad_match_spec_bin(Config) when is_list(Config) -> {'EXIT',{badarg,_}} = (catch ets:match_spec_run([1], <<>>)), B0 = <<1,2>>, @@ -932,6 +971,24 @@ runner(Collector, Fun) -> Collector ! {gone, self()} end. +loop_runner(Collector, Fun, Laps) -> + receive + {go, Collector} -> + go + end, + loop_runner_cont(Collector, Fun, 0, Laps). + +loop_runner_cont(_Collector, _Fun, Laps, Laps) -> + receive + {done, Collector} -> + io:format("loop_runner ~p exit after ~p laps\n", [self(), Laps]), + Collector ! {gone, self()} + end; +loop_runner_cont(Collector, Fun, N, Laps) -> + Fun(), + loop_runner_cont(Collector, Fun, N+1, Laps). + + f1(X) -> {X}. diff --git a/erts/emulator/test/mtx_SUITE_data/mtx_SUITE.c b/erts/emulator/test/mtx_SUITE_data/mtx_SUITE.c index 818023211c..0e4065c26b 100644 --- a/erts/emulator/test/mtx_SUITE_data/mtx_SUITE.c +++ b/erts/emulator/test/mtx_SUITE_data/mtx_SUITE.c @@ -552,13 +552,19 @@ create_rwlock(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) static ERL_NIF_TERM rwlock_op(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) { - rwlock_resource_t *rwlr; + /* + * Use a union for pointer type conversion to avoid compiler warnings + * about strict-aliasing violations with gcc-4.1. gcc >= 4.2 does not + * emit the warning. + * TODO: Reconsider use of union once gcc-4.1 is obsolete? + */ + union { void* vp; rwlock_resource_t *p; } rwlr; int blocking, write, wait_locked, wait_unlocked; if (argc != 5) goto badarg; - if (!enif_get_resource(env, argv[0], enif_priv_data(env), (void **) &rwlr)) + if (!enif_get_resource(env, argv[0], enif_priv_data(env), &rwlr.vp)) goto badarg; blocking = get_bool(env, argv[1]); @@ -581,22 +587,22 @@ rwlock_op(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) if (write) { if (blocking) - RWMUTEX_WLOCK(rwlr->rwlock); + RWMUTEX_WLOCK(rwlr.p->rwlock); else - while (EBUSY == RWMUTEX_TRYWLOCK(rwlr->rwlock)); - if (rwlr->lock_check) { - ASSERT(!ATOMIC_READ(&rwlr->is_locked)); - ATOMIC_SET(&rwlr->is_locked, -1); + while (EBUSY == RWMUTEX_TRYWLOCK(rwlr.p->rwlock)); + if (rwlr.p->lock_check) { + ASSERT(!ATOMIC_READ(&rwlr.p->is_locked)); + ATOMIC_SET(&rwlr.p->is_locked, -1); } } else { if (blocking) - RWMUTEX_RLOCK(rwlr->rwlock); + RWMUTEX_RLOCK(rwlr.p->rwlock); else - while (EBUSY == RWMUTEX_TRYRLOCK(rwlr->rwlock)); - if (rwlr->lock_check) { - ASSERT(ATOMIC_READ(&rwlr->is_locked) >= 0); - ATOMIC_INC(&rwlr->is_locked); + while (EBUSY == RWMUTEX_TRYRLOCK(rwlr.p->rwlock)); + if (rwlr.p->lock_check) { + ASSERT(ATOMIC_READ(&rwlr.p->is_locked) >= 0); + ATOMIC_INC(&rwlr.p->is_locked); } } @@ -604,18 +610,18 @@ rwlock_op(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) milli_sleep(wait_locked); if (write) { - if (rwlr->lock_check) { - ASSERT(ATOMIC_READ(&rwlr->is_locked) == -1); - ATOMIC_SET(&rwlr->is_locked, 0); + if (rwlr.p->lock_check) { + ASSERT(ATOMIC_READ(&rwlr.p->is_locked) == -1); + ATOMIC_SET(&rwlr.p->is_locked, 0); } - RWMUTEX_WUNLOCK(rwlr->rwlock); + RWMUTEX_WUNLOCK(rwlr.p->rwlock); } else { - if (rwlr->lock_check) { - ASSERT(ATOMIC_READ(&rwlr->is_locked) > 0); - ATOMIC_DEC(&rwlr->is_locked); + if (rwlr.p->lock_check) { + ASSERT(ATOMIC_READ(&rwlr.p->is_locked) > 0); + ATOMIC_DEC(&rwlr.p->is_locked); } - RWMUTEX_RUNLOCK(rwlr->rwlock); + RWMUTEX_RUNLOCK(rwlr.p->rwlock); } if (wait_unlocked) diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl index 91d695d979..f6344791f1 100644 --- a/erts/emulator/test/nif_SUITE.erl +++ b/erts/emulator/test/nif_SUITE.erl @@ -257,10 +257,54 @@ types(Config) when is_list(Config) -> end, [{},{ok},{{}},{[],{}},{1,2,3,4,5}]), Stuff = [[],{},0,0.0,(1 bsl 100),(fun()-> ok end),make_ref(),self()], - [eq_cmp(A,clone(B)) || A<-Stuff, B<-Stuff], + [eq_cmp(A,clone(B)) || A<-Stuff, B<-Stuff], + + {IntSz, LongSz} = type_sizes(), + UintMax = (1 bsl (IntSz*8)) - 1, + IntMax = UintMax bsr 1, + IntMin = -(IntMax+1), + UlongMax = (1 bsl (LongSz*8)) - 1, + LongMax = UlongMax bsr 1, + LongMin = -(LongMax+1), + Uint64Max = (1 bsl 64) - 1, + Int64Max = Uint64Max bsr 1, + Int64Min = -(Int64Max+1), + Limits = [{IntMin,IntMax},{0,UintMax},{LongMin,LongMax},{0,UlongMax},{Int64Min,Int64Max},{0,Uint64Max}], + io:format("Limits = ~p\n", [Limits]), + lists:foreach(fun(I) -> + R1 = echo_int(I), + %%io:format("echo_int(~p) -> ~p\n", [I, R1]), + R2 = my_echo_int(I, Limits), + ?line R1 = R2, + ?line true = (R1 =:= R2), + ?line true = (R1 == R2) + end, int_list()), + ?line verify_tmpmem(TmpMem), + ?line true = (compare(-1294536544000, -1178704800000) < 0), + ?line true = (compare(-1178704800000, -1294536544000) > 0), + ?line true = (compare(-295147905179352825856, -36893488147419103232) < 0), + ?line true = (compare(-36893488147419103232, -295147905179352825856) > 0), + ?line true = (compare(-29514790517935282585612345678, -36893488147419103232) < 0), + ?line true = (compare(-36893488147419103232, -29514790517935282585612345678) > 0), ok. +int_list() -> + Start = 1 bsl 200, + int_list([Start], -Start). +int_list([N | _]=List, End) when N<End -> + List; +int_list([N | _]=List, End) -> + int_list([N - (1 + (abs(N) div 3)) | List], End). + +my_echo_int(I, Limits) -> + lists:map(fun({Min,Max}) -> + if I < Min -> false; + I > Max -> false; + true -> I + end + end, Limits). + clone(X) -> binary_to_term(term_to_binary(X)). @@ -1170,9 +1214,10 @@ tmpmem() -> MemInfo -> MSBCS = lists:foldl( fun ({instance, _, L}, Acc) -> + {value,{_,SBMBCS}} = lists:keysearch(sbmbcs, 1, L), {value,{_,MBCS}} = lists:keysearch(mbcs, 1, L), {value,{_,SBCS}} = lists:keysearch(sbcs, 1, L), - [MBCS,SBCS | Acc] + [SBMBCS,MBCS,SBCS | Acc] end, [], MemInfo), @@ -1269,6 +1314,8 @@ send_blob_thread(_,_,_) -> ?nif_stub. join_send_thread(_) -> ?nif_stub. copy_blob(_) -> ?nif_stub. send_term(_,_) -> ?nif_stub. +echo_int(_) -> ?nif_stub. +type_sizes() -> ?nif_stub. nif_stub_error(Line) -> exit({nif_not_loaded,module,?MODULE,line,Line}). diff --git a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c index 0bb93daa33..92f1bab8dd 100644 --- a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c +++ b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c @@ -28,6 +28,7 @@ static int static_cntA; /* zero by default */ static int static_cntB = NIF_SUITE_LIB_VER * 100; +static ERL_NIF_TERM atom_false; static ERL_NIF_TERM atom_self; static ERL_NIF_TERM atom_ok; static ERL_NIF_TERM atom_join; @@ -40,7 +41,18 @@ typedef struct CallInfo* call_history; NifModPrivData* nif_mod; union { ErlNifResourceType* t; long l; } rt_arr[2]; -}PrivData; +} PrivData; + +/* + * Use a union for pointer type conversion to avoid compiler warnings + * about strict-aliasing violations with gcc-4.1. gcc >= 4.2 does not + * emit the warning. + * TODO: Reconsider use of union once gcc-4.1 is obsolete? + */ +typedef union { + void* vp; + struct make_term_info* p; +} mti_t; void add_call(ErlNifEnv* env, PrivData* data, const char* func_name) { @@ -103,7 +115,7 @@ static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) msgenv_resource_type = enif_open_resource_type(env,NULL,"nif_SUITE.msgenv", msgenv_dtor, ERL_NIF_RT_CREATE, NULL); - + atom_false = enif_make_atom(env,"false"); atom_self = enif_make_atom(env,"self"); atom_ok = enif_make_atom(env,"ok"); atom_join = enif_make_atom(env,"join"); @@ -481,6 +493,45 @@ error: return enif_make_atom(env,"error"); } +static ERL_NIF_TERM echo_int(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + int sint; + unsigned uint; + long slong; + unsigned long ulong; + ErlNifSInt64 sint64; + ErlNifUInt64 uint64; + ERL_NIF_TERM sint_term = atom_false, uint_term = atom_false; + ERL_NIF_TERM slong_term = atom_false, ulong_term = atom_false; + ERL_NIF_TERM sint64_term = atom_false, uint64_term = atom_false; + + if (enif_get_int(env, argv[0], &sint)) { + sint_term = enif_make_int(env, sint); + } + if (enif_get_uint(env, argv[0], &uint)) { + uint_term = enif_make_uint(env, uint); + } + if (enif_get_long(env, argv[0], &slong)) { + slong_term = enif_make_long(env, slong); + } + if (enif_get_ulong(env, argv[0], &ulong)) { + ulong_term = enif_make_ulong(env, ulong); + } + if (enif_get_int64(env, argv[0], &sint64)) { + sint64_term = enif_make_int64(env, sint64); + } + if (enif_get_uint64(env, argv[0], &uint64)) { + uint64_term = enif_make_uint64(env, uint64); + } + return enif_make_list6(env, sint_term, uint_term, slong_term, ulong_term, sint64_term, uint64_term); +} + +static ERL_NIF_TERM type_sizes(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + return enif_make_tuple2(env, enif_make_int(env, sizeof(int)), + enif_make_int(env, sizeof(long))); +} + static ERL_NIF_TERM tuple_2_list(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { int arity = -1; @@ -667,7 +718,7 @@ static ERL_NIF_TERM get_resource_type(ErlNifEnv* env, int argc, const ERL_NIF_TE static ERL_NIF_TERM alloc_resource(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { ErlNifBinary data_bin; - union { ErlNifResourceType* t; long l;} type; + union { ErlNifResourceType* t; long l; } type; union { void* p; long l;} data; if (!enif_get_long(env, argv[0], &type.l) || !enif_inspect_binary(env, argv[1], &data_bin) @@ -691,7 +742,7 @@ static ERL_NIF_TERM make_resource(ErlNifEnv* env, int argc, const ERL_NIF_TERM a static ERL_NIF_TERM make_new_resource(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { ErlNifBinary data_bin; - union { ErlNifResourceType* t; long l;} type; + union { ErlNifResourceType* t; long l; } type; void* data; ERL_NIF_TERM ret; if (!enif_get_long(env, argv[0], &type.l) @@ -709,7 +760,7 @@ static ERL_NIF_TERM make_new_resource(ErlNifEnv* env, int argc, const ERL_NIF_TE static ERL_NIF_TERM make_new_resource_binary(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { ErlNifBinary data_bin; - union { struct binary_resource* p; void* vp; long l;} br; + union { struct binary_resource* p; void* vp; long l; } br; void* buf; ERL_NIF_TERM ret; if (!enif_inspect_binary(env, argv[0], &data_bin) @@ -1229,10 +1280,7 @@ static void msgenv_dtor(ErlNifEnv* env, void* obj) static ERL_NIF_TERM clear_msgenv(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { - union { - void* vp; - struct make_term_info* p; - }mti; + mti_t mti; if (!enif_get_resource(env, argv[0], msgenv_resource_type, &mti.vp)) { return enif_make_badarg(env); } @@ -1245,7 +1293,7 @@ static ERL_NIF_TERM clear_msgenv(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar static ERL_NIF_TERM grow_blob(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { - union { void* vp; struct make_term_info* p; }mti; + mti_t mti; ERL_NIF_TERM term; if (!enif_get_resource(env, argv[0], msgenv_resource_type, &mti.vp) || (argc>2 && !enif_get_uint(env,argv[2], &mti.p->n))) { @@ -1261,7 +1309,7 @@ static ERL_NIF_TERM grow_blob(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[ static ERL_NIF_TERM send_blob(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { - union { void* vp; struct make_term_info* p; }mti; + mti_t mti; ErlNifPid to; ERL_NIF_TERM copy; int res; @@ -1276,7 +1324,7 @@ static ERL_NIF_TERM send_blob(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[ static ERL_NIF_TERM send3_blob(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { - union { void* vp; struct make_term_info* p; }mti; + mti_t mti; ErlNifPid to; ERL_NIF_TERM copy; int res; @@ -1294,7 +1342,7 @@ static ERL_NIF_TERM send3_blob(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv void* threaded_sender(void *arg) { - union { void* vp; struct make_term_info* p; }mti; + mti_t mti; mti.vp = arg; enif_mutex_lock(mti.p->mtx); @@ -1309,7 +1357,7 @@ void* threaded_sender(void *arg) static ERL_NIF_TERM send_blob_thread(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { - union { void* vp; struct make_term_info* p; }mti; + mti_t mti; ERL_NIF_TERM copy; if (!enif_get_resource(env, argv[0], msgenv_resource_type, &mti.vp) || !enif_get_local_pid(env,argv[1], &mti.p->to_pid)) { @@ -1335,7 +1383,7 @@ static ERL_NIF_TERM send_blob_thread(ErlNifEnv* env, int argc, const ERL_NIF_TER static ERL_NIF_TERM join_send_thread(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { - union { void* vp; struct make_term_info* p; }mti; + mti_t mti; int err; if (!enif_get_resource(env, argv[0], msgenv_resource_type, &mti.vp)) { return enif_make_badarg(env); @@ -1352,7 +1400,7 @@ static ERL_NIF_TERM join_send_thread(ErlNifEnv* env, int argc, const ERL_NIF_TER static ERL_NIF_TERM copy_blob(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { - union { void* vp; struct make_term_info* p; }mti; + mti_t mti; if (!enif_get_resource(env, argv[0], msgenv_resource_type, &mti.vp)) { return enif_make_badarg(env); } @@ -1417,7 +1465,9 @@ static ErlNifFunc nif_funcs[] = {"send_blob_thread", 3, send_blob_thread}, {"join_send_thread", 1, join_send_thread}, {"copy_blob", 1, copy_blob}, - {"send_term", 2, send_term} + {"send_term", 2, send_term}, + {"echo_int", 1, echo_int}, + {"type_sizes", 0, type_sizes} }; ERL_NIF_INIT(nif_SUITE,nif_funcs,load,reload,upgrade,unload) diff --git a/erts/emulator/test/send_term_SUITE.erl b/erts/emulator/test/send_term_SUITE.erl index 6615873392..ba0ba804ca 100644 --- a/erts/emulator/test/send_term_SUITE.erl +++ b/erts/emulator/test/send_term_SUITE.erl @@ -175,6 +175,10 @@ chk_temp_alloc() -> %% Verify that we havn't got anything allocated by temp_alloc lists:foreach( fun ({instance, _, TI}) -> + ?line {value, {sbmbcs, SBMBCInfo}} + = lists:keysearch(sbmbcs, 1, TI), + ?line {value, {blocks, 0, _, _}} + = lists:keysearch(blocks, 1, SBMBCInfo), ?line {value, {mbcs, MBCInfo}} = lists:keysearch(mbcs, 1, TI), ?line {value, {blocks, 0, _, _}} diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops index e7c57142c0..354439b5e3 100755 --- a/erts/emulator/utils/beam_makeops +++ b/erts/emulator/utils/beam_makeops @@ -67,6 +67,10 @@ my $max_gen_operands = 8; # Must be even. The beam_load.c file must be updated, too. my $max_spec_operands = 6; +# The maximum number of primitive genop_types. + +my $max_genop_types = 16; + my %gen_opnum; my %num_specific; my %gen_to_spec; @@ -106,7 +110,7 @@ my @pred_table; # Operand types for generic instructions. my $compiler_types = "uiaxyfhz"; -my $loader_types = "nprvlq"; +my $loader_types = "nprvlqo"; my $genop_types = $compiler_types . $loader_types; # @@ -142,34 +146,61 @@ my %arg_size = ('r' => 0, # x(0) - x register zero my %type_bit; my @tag_type; +sub define_type_bit { + my($tag,$val) = @_; + defined $type_bit{$tag} and + sanity("the tag '$tag' has already been defined with the value ", + $type_bit{$tag}); + $type_bit{$tag} = $val; +} + { my($bit) = 1; my(%bit); foreach (split('', $genop_types)) { push(@tag_type, $_); - $type_bit{$_} = $bit; + define_type_bit($_, $bit); $bit{$_} = $bit; $bit *= 2; } # Composed types. - $type_bit{'d'} = $type_bit{'x'} | $type_bit{'y'} | $type_bit{'r'}; - $type_bit{'c'} = $type_bit{'i'} | $type_bit{'a'} | $type_bit{'n'} | $type_bit{'q'}; - $type_bit{'s'} = $type_bit{'d'} | $type_bit{'i'} | $type_bit{'a'} | $type_bit{'n'}; - $type_bit{'j'} = $type_bit{'f'} | $type_bit{'p'}; + define_type_bit('d', $type_bit{'x'} | $type_bit{'y'} | $type_bit{'r'}); + define_type_bit('c', $type_bit{'i'} | $type_bit{'a'} | + $type_bit{'n'} | $type_bit{'q'}); + define_type_bit('s', $type_bit{'d'} | $type_bit{'i'} | + $type_bit{'a'} | $type_bit{'n'}); + define_type_bit('j', $type_bit{'f'} | $type_bit{'p'}); # Aliases (for matching purposes). - $type_bit{'I'} = $type_bit{'u'}; - $type_bit{'t'} = $type_bit{'u'}; - $type_bit{'A'} = $type_bit{'u'}; - $type_bit{'L'} = $type_bit{'u'}; - $type_bit{'b'} = $type_bit{'u'}; - $type_bit{'N'} = $type_bit{'u'}; - $type_bit{'U'} = $type_bit{'u'}; - $type_bit{'e'} = $type_bit{'u'}; - $type_bit{'P'} = $type_bit{'u'}; - $type_bit{'Q'} = $type_bit{'u'}; + define_type_bit('I', $type_bit{'u'}); + define_type_bit('t', $type_bit{'u'}); + define_type_bit('A', $type_bit{'u'}); + define_type_bit('L', $type_bit{'u'}); + define_type_bit('b', $type_bit{'u'}); + define_type_bit('N', $type_bit{'u'}); + define_type_bit('U', $type_bit{'u'}); + define_type_bit('e', $type_bit{'u'}); + define_type_bit('P', $type_bit{'u'}); + define_type_bit('Q', $type_bit{'u'}); +} + +# +# Sanity checks. +# + +{ + if (@tag_type > $max_genop_types) { + sanity("\$max_genop_types is $max_genop_types, ", + "but there are ", scalar(@tag_type), + " primitive tags defined\n"); + } + + foreach my $tag (@tag_type) { + sanity("tag '$tag': primitive tags must be named with lowercase letters") + unless $tag =~ /^[a-z]$/; + } } # @@ -436,12 +467,12 @@ sub emulator_output { # my(@bits) = (0) x ($max_spec_operands/2); - my($shift) = 16; my($i); for ($i = 0; $i < $max_spec_operands && defined $args[$i]; $i++) { my $t = $args[$i]; if (defined $type_bit{$t}) { - $bits[int($i/2)] |= $type_bit{$t} << (16*($i%2)); + my $shift = $max_genop_types * ($i % 2); + $bits[int($i/2)] |= $type_bit{$t} << $shift; } } @@ -753,6 +784,10 @@ sub error { die $where, @message, "\n"; } +sub sanity { + die "internal error: ", @_, "\n"; +} + sub comment { my($lang, @comments) = @_; my($prefix); diff --git a/erts/epmd/src/epmd.c b/erts/epmd/src/epmd.c index 08576d923f..2267f9b12b 100644 --- a/erts/epmd/src/epmd.c +++ b/erts/epmd/src/epmd.c @@ -324,7 +324,11 @@ static void run_daemon(EpmdVars *g) } /* move cwd to root to make sure we are not on a mounted filesystem */ - chdir("/"); + if (chdir("/") < 0) + { + dbg_perror(g,"epmd: chdir() failed"); + epmd_cleanup_exit(g,1); + } umask(0); diff --git a/erts/epmd/src/epmd_cli.c b/erts/epmd/src/epmd_cli.c index ac55ba6bb6..2377c0dfe7 100644 --- a/erts/epmd/src/epmd_cli.c +++ b/erts/epmd/src/epmd_cli.c @@ -104,7 +104,10 @@ void epmd_call(EpmdVars *g,int what) fd = conn_to_epmd(g); put_int16(1,buf); buf[2] = what; - write(fd,buf,3); + if (write(fd, buf, 3) != 3) { + printf("epmd: Can't write to epmd\n"); + epmd_cleanup_exit(g,1); + } if (read(fd,(char *)&i,4) != 4) { if (!g->silent) printf("epmd: no response from local epmd\n"); diff --git a/erts/epmd/src/epmd_int.h b/erts/epmd/src/epmd_int.h index 2a0de4df9c..a2d7559f9d 100644 --- a/erts/epmd/src/epmd_int.h +++ b/erts/epmd/src/epmd_int.h @@ -240,6 +240,14 @@ #define put_int16(i, s) {((unsigned char*)(s))[0] = ((i) >> 8) & 0xff; \ ((unsigned char*)(s))[1] = (i) & 0xff;} +#if defined(__GNUC__) +# define EPMD_INLINE __inline__ +#elif defined(__WIN32__) +# define EPMD_INLINE __inline +#else +# define EPMD_INLINE +#endif + /* ************************************************************************ */ /* Stuctures used by server */ @@ -295,6 +303,7 @@ typedef struct { unsigned delay_write; int max_conn; int active_conn; + int select_fd_top; char *progname; Connection *conn; Nodes nodes; diff --git a/erts/epmd/src/epmd_srv.c b/erts/epmd/src/epmd_srv.c index 4d9b454f97..da575affa1 100644 --- a/erts/epmd/src/epmd_srv.c +++ b/erts/epmd/src/epmd_srv.c @@ -80,6 +80,13 @@ static int reply(EpmdVars*,int,char *,int); static void dbg_print_buf(EpmdVars*,char *,int); static void print_names(EpmdVars*); +static EPMD_INLINE void select_fd_set(EpmdVars* g, int fd) +{ + FD_SET(fd, &g->orig_read_mask); + if (fd >= g->select_fd_top) { + g->select_fd_top = fd + 1; + } +} void run(EpmdVars *g) { @@ -95,7 +102,8 @@ void run(EpmdVars *g) dbg_printf(g,2,"try to initiate listening port %d", g->port); - if (g->addresses != NULL) + if (g->addresses != NULL && /* String contains non-separator characters if: */ + g->addresses[strspn(g->addresses," ,")] != '\000') { char *tmp; char *token; @@ -171,6 +179,7 @@ void run(EpmdVars *g) g->max_conn -= num_sockets; FD_ZERO(&g->orig_read_mask); + g->select_fd_top = 0; for (i = 0; i < num_sockets; i++) { @@ -232,14 +241,14 @@ void run(EpmdVars *g) dbg_perror(g,"failed to listen on socket"); epmd_cleanup_exit(g,1); } - FD_SET(listensock[i],&g->orig_read_mask); + select_fd_set(g, listensock[i]); } dbg_tty_printf(g,2,"entering the main select() loop"); select_again: while(1) - { + { fd_set read_mask = g->orig_read_mask; struct timeval timeout; int ret; @@ -251,7 +260,8 @@ void run(EpmdVars *g) timeout.tv_sec = (g->packet_timeout < IDLE_TIMEOUT) ? 1 : IDLE_TIMEOUT; timeout.tv_usec = 0; - if ((ret = select(g->max_conn,&read_mask,(fd_set *)0,(fd_set *)0,&timeout)) < 0) { + if ((ret = select(g->select_fd_top, + &read_mask, (fd_set *)0,(fd_set *)0,&timeout)) < 0) { dbg_perror(g,"error in select "); switch (errno) { case EAGAIN: @@ -821,7 +831,7 @@ static int conn_open(EpmdVars *g,int fd) s = &g->conn[i]; /* From now on we want to know if there are data to be read */ - FD_SET(fd, &g->orig_read_mask); + select_fd_set(g, fd); s->fd = fd; s->open = EPMD_TRUE; @@ -886,6 +896,7 @@ int epmd_conn_close(EpmdVars *g,Connection *s) dbg_tty_printf(g,2,"closing connection on file descriptor %d",s->fd); FD_CLR(s->fd,&g->orig_read_mask); + /* we don't bother lowering g->select_fd_top */ close(s->fd); /* Sometimes already closed but close anyway */ s->open = EPMD_FALSE; if (s->buf != NULL) { /* Should never be NULL but test anyway */ @@ -1115,7 +1126,7 @@ static Node *node_reg2(EpmdVars *g, node->extralen = extralen; memcpy(node->extra,extra,extralen); strcpy(node->symname,name); - FD_SET(fd,&g->orig_read_mask); + select_fd_set(g, fd); if (highvsn == 0) { dbg_tty_printf(g,1,"registering '%s:%d', port %d", diff --git a/erts/etc/common/erlexec.c b/erts/etc/common/erlexec.c index 7e04724f5a..2bd576d8e8 100644 --- a/erts/etc/common/erlexec.c +++ b/erts/etc/common/erlexec.c @@ -64,6 +64,7 @@ static const char plusM_au_allocs[]= { 'u', /* all alloc_util allocators */ 'B', /* binary_alloc */ + 'C', /* sbmbc_alloc */ 'D', /* std_alloc */ 'E', /* ets_alloc */ 'H', /* eheap_alloc */ @@ -93,6 +94,8 @@ static char *plusM_au_alloc_switches[] = { "rsbcst", "sbct", "smbcs", + "sbmbcs", + "sbmbct", NULL }; diff --git a/erts/etc/win32/Install.c b/erts/etc/win32/Install.c index 6e60512f6d..d680b67dd6 100644 --- a/erts/etc/win32/Install.c +++ b/erts/etc/win32/Install.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2003-2010. All Rights Reserved. + * Copyright Ericsson AB 2003-2011. All Rights Reserved. * * The contents of this file are subject to the Erlang Public License, * Version 1.1, (the "License"); you may not use this file except in @@ -213,6 +213,9 @@ int main(int argc, char **argv) fprintf(stderr,"Cannot continue installation, bailing out.\n"); exit(1); } + + /* OBS!!! If the format of the init file is changed, do not forget + to update release_handler:write_ini_file(...) */ ini_file = create_init_file(); ini_section = create_init_section("erlang"); add_init_section(ini_file,ini_section); diff --git a/erts/etc/win32/erlsrv/erlsrv_interactive.c b/erts/etc/win32/erlsrv/erlsrv_interactive.c index 13e029b364..4c990a694d 100644 --- a/erts/etc/win32/erlsrv/erlsrv_interactive.c +++ b/erts/etc/win32/erlsrv/erlsrv_interactive.c @@ -135,7 +135,12 @@ void print_last_error(void){ fprintf(stderr,"Error: %s",mes); LocalFree(mes); } - + +static int get_last_error(void) +{ + return (last_error) ? last_error : GetLastError(); +} + static BOOL install_service(void){ SC_HANDLE scm; SC_HANDLE service; @@ -508,7 +513,7 @@ int do_usage(char *arg0){ "\t[{-sn[ame] | -n[ame]} [<nodename>]]\n" "\t[-d[ebugtype] [{new|reuse|console}]]\n" "\t[-ar[gs] [<limited erl arguments>]]\n\n" - "%s {start | stop | disable | enable} <servicename>\n\n" + "%s {start | start_disabled | stop | disable | enable} <servicename>\n\n" "%s remove <servicename>\n\n" "%s rename <servicename> <servicename>\n\n" "%s list [<servicename>]\n\n" @@ -561,6 +566,45 @@ int do_manage(int argc,char **argv){ return 0; } } + if(!_stricmp(action,"start_disabled")){ + if(!enable_service()){ + fprintf(stderr,"%s: Failed to enable service %s.\n", + argv[0],service_name); + print_last_error(); + return 1; + } + if(!start_service() && get_last_error() != ERROR_SERVICE_ALREADY_RUNNING){ + fprintf(stderr,"%s: Failed to start service %s.\n", + argv[0],service_name); + print_last_error(); + goto failure_starting; + } + + if(!wait_service_trans(SERVICE_STOPPED, SERVICE_START_PENDING, + SERVICE_RUNNING, 60)){ + fprintf(stderr,"%s: Failed to start service %s.\n", + argv[0],service_name); + print_last_error(); + goto failure_starting; + } + + if(!disable_service()){ + fprintf(stderr,"%s: Failed to disable service %s.\n", + argv[0],service_name); + print_last_error(); + return 1; + } + printf("%s: Service %s started.\n", + argv[0],service_name); + return 0; + failure_starting: + if(!disable_service()){ + fprintf(stderr,"%s: Failed to disable service %s.\n", + argv[0],service_name); + print_last_error(); + } + return 1; + } if(!_stricmp(action,"stop")){ if(!stop_service()){ fprintf(stderr,"%s: Failed to stop service %s.\n", @@ -841,6 +885,7 @@ int do_add_or_set(int argc, char **argv){ argv[0], service_name); return 0; } + int do_rename(int argc, char **argv){ RegEntry *current = empty_reg_tab(); RegEntry *dummy = empty_reg_tab(); @@ -1129,35 +1174,131 @@ void read_arguments(int *pargc, char ***pargv){ *pargc = argc; *pargv = argv; } + +/* Create a free-for-all ACL to set on the semaphore */ +PACL get_acl(PSECURITY_DESCRIPTOR secdescp) +{ + DWORD acl_length = 0; + PSID auth_users_sidp = NULL; + PACL aclp = NULL; + SID_IDENTIFIER_AUTHORITY ntauth = SECURITY_NT_AUTHORITY; + + if(!InitializeSecurityDescriptor(secdescp, SECURITY_DESCRIPTOR_REVISION)) { + return NULL; + } + + if(!AllocateAndInitializeSid(&ntauth, + 1, + SECURITY_AUTHENTICATED_USER_RID, + 0, 0, 0, 0, 0, 0, 0, + &auth_users_sidp)) { + return NULL; + } + + acl_length = sizeof(ACL) + + sizeof(ACCESS_ALLOWED_ACE) - sizeof(DWORD) + + GetLengthSid(auth_users_sidp); + + if((aclp = (PACL) HeapAlloc(GetProcessHeap(), HEAP_ZERO_MEMORY, acl_length)) == NULL) { + FreeSid(auth_users_sidp); + return NULL; + } + + if(!InitializeAcl(aclp, acl_length, ACL_REVISION)) { + FreeSid(auth_users_sidp); + HeapFree(GetProcessHeap(), 0, aclp); + return NULL; + } + + if(!AddAccessAllowedAce(aclp, ACL_REVISION, SEMAPHORE_ALL_ACCESS, auth_users_sidp)) { + FreeSid(auth_users_sidp); + HeapFree(GetProcessHeap(), 0, aclp); + return NULL; + } + + if(!SetSecurityDescriptorDacl(secdescp, TRUE, aclp, FALSE)) { + FreeSid(auth_users_sidp); + HeapFree(GetProcessHeap(), 0, aclp); + return NULL; + } + return aclp; +} + +static HANDLE lock_semaphore = NULL; + +int take_lock(void) { + SECURITY_ATTRIBUTES attr; + PACL aclp; + SECURITY_DESCRIPTOR secdesc; + + if ((aclp = get_acl(&secdesc)) == NULL) { + return -1; + } + + memset(&attr,0,sizeof(attr)); + attr.nLength = sizeof(attr); + attr.lpSecurityDescriptor = &secdesc; + attr.bInheritHandle = FALSE; + + if ((lock_semaphore = CreateSemaphore(&attr, 1, 1, ERLSRV_INTERACTIVE_GLOBAL_SEMAPHORE)) == NULL) { + return -1; + } + + if (WaitForSingleObject(lock_semaphore,INFINITE) != WAIT_OBJECT_0) { + return -1; + } + + HeapFree(GetProcessHeap(), 0, aclp); + return 0; +} + +void release_lock(void) { + ReleaseSemaphore(lock_semaphore,1,NULL); +} + int interactive_main(int argc, char **argv){ char *action = argv[1]; - + int res; + + if (take_lock() != 0) { + fprintf(stderr,"%s: unable to acquire global lock (%s).\n",argv[0], + ERLSRV_INTERACTIVE_GLOBAL_SEMAPHORE); + return 1; + } + if(!_stricmp(action,"readargs")){ - read_arguments(&argc,&argv); - action = argv[1]; + read_arguments(&argc,&argv); + action = argv[1]; } if(!_stricmp(action,"set") || !_stricmp(action,"add")) - return do_add_or_set(argc,argv); - if(!_stricmp(action,"rename")) - return do_rename(argc,argv); - if(!_stricmp(action,"remove")) - return do_remove(argc,argv); - if(!_stricmp(action,"list")) - return do_list(argc,argv); - if(!_stricmp(action,"start") || - !_stricmp(action,"stop") || - !_stricmp(action,"enable") || - !_stricmp(action,"disable")) - return do_manage(argc,argv); - if(_stricmp(action,"?") && - _stricmp(action,"/?") && - _stricmp(action,"-?") && - *action != 'h' && - *action != 'H') + res = do_add_or_set(argc,argv); + else if(!_stricmp(action,"rename")) + res = do_rename(argc,argv); + else if(!_stricmp(action,"remove")) + res = do_remove(argc,argv); + else if(!_stricmp(action,"list")) + res = do_list(argc,argv); + else if(!_stricmp(action,"start") || + !_stricmp(action,"start_disabled") || + !_stricmp(action,"stop") || + !_stricmp(action,"enable") || + !_stricmp(action,"disable")) + res = do_manage(argc,argv); + else if(_stricmp(action,"?") && + _stricmp(action,"/?") && + _stricmp(action,"-?") && + *action != 'h' && + *action != 'H') { fprintf(stderr,"%s: action %s not implemented.\n",argv[0],action); - do_usage(argv[0]); - return 1; + do_usage(argv[0]); + res = 1; + } else { + do_usage(argv[0]); + res = 0; + } + release_lock(); + return res; } diff --git a/erts/etc/win32/erlsrv/erlsrv_interactive.h b/erts/etc/win32/erlsrv/erlsrv_interactive.h index deacf81899..602da24575 100644 --- a/erts/etc/win32/erlsrv/erlsrv_interactive.h +++ b/erts/etc/win32/erlsrv/erlsrv_interactive.h @@ -19,6 +19,8 @@ #ifndef _ERLSRV_INTERACTIVE_H #define _ERLSRV_INTERACTIVE_H +#define ERLSRV_INTERACTIVE_GLOBAL_SEMAPHORE "{468d6954-e355-415f-968f-d257cb0feef4}" + int interactive_main(int argc, char **argv); #endif /* _ERLSRV_INTERACTIVE_H */ diff --git a/erts/etc/win32/start_erl.c b/erts/etc/win32/start_erl.c index dcf8c8b281..6ca7dd9b99 100644 --- a/erts/etc/win32/start_erl.c +++ b/erts/etc/win32/start_erl.c @@ -44,6 +44,8 @@ char *progname; #endif #define RELEASE_SUBDIR "\\releases" +#define ERTS_SUBDIR_PREFIX "\\erts-" +#define BIN_SUBDIR "\\bin" #define REGISTRY_BASE "Software\\Ericsson\\Erlang\\" #define DEFAULT_DATAFILE "start_erl.data" @@ -101,7 +103,8 @@ void exit_help(char *err) printf("Usage:\n%s\n" " [<erlang options>] ++\n" " [-data <datafile>]\n" - " [-reldir <releasedir>]\n" + " {-rootdir <erlang root directory> | \n" + " -reldir <releasedir>}\n" " [-bootflags <bootflagsfile>]\n" " [-noconfig]\n", progname); @@ -177,8 +180,9 @@ void split_commandline(void) */ char * unquote_optionarg(char *str, char **strp) { - char *newstr = (char *)malloc(strlen(str)+1); /* This one is realloc:ed later */ - int i=0, inquote=0; + char *newstr = (char *)malloc(strlen(str)+1); /* This one is + realloc:ed later */ + int i = 0, inquote = 0; assert(newstr); assert(str); @@ -223,8 +227,8 @@ char * unquote_optionarg(char *str, char **strp) /* - * Parses MyCommandLine and tries to fill in all the required option variables - * (one way or another). + * Parses MyCommandLine and tries to fill in all the required option + * variables (in one way or another). */ void parse_commandline(void) { @@ -237,6 +241,11 @@ void parse_commandline(void) *cmdline++; if( strnicmp(cmdline, "data", 4) == 0) { DataFileName = unquote_optionarg(cmdline+4, &cmdline); + } else if( strnicmp(cmdline, "rootdir", 7) == 0) { + RootDir = unquote_optionarg(cmdline+7, &cmdline); +#ifdef _DEBUG + fprintf(stderr, "RootDir: '%s'\n", RootDir); +#endif } else if( strnicmp(cmdline, "reldir", 6) == 0) { RelDir = unquote_optionarg(cmdline+6, &cmdline); #ifdef _DEBUG @@ -266,8 +275,8 @@ void parse_commandline(void) * Read the data file specified and get the version and release number * from it. * - * This function also construct the correct RegistryKey from the version information - * retrieved. + * This function also construct the correct RegistryKey from the version + * information retrieved. */ void read_datafile(void) { @@ -325,88 +334,6 @@ void read_datafile(void) /* - * Read the registry keys we need - */ -void read_registry_keys(void) -{ - HKEY hReg; - ULONG lLen; - - /* Create the RegistryKey name */ - RegistryKey = (char *) malloc(strlen(REGISTRY_BASE) + - strlen(Version) + 1); - assert(RegistryKey); - sprintf(RegistryKey, REGISTRY_BASE "%s", Version); - - /* We always need to find BinDir */ - if( (RegOpenKeyEx(HKEY_LOCAL_MACHINE, - RegistryKey, - 0, - KEY_READ, - &hReg)) != ERROR_SUCCESS ) { - exit_help("Could not open registry key."); - } - - /* First query size of data */ - if( (RegQueryValueEx(hReg, - "Bindir", - NULL, - NULL, - NULL, - &lLen)) != ERROR_SUCCESS) { - exit_help("Failed to query BinDir of release.\n"); - } - - /* Allocate enough space */ - BinDir = (char *)malloc(lLen+1); - assert(BinDir); - /* Retrieve the value */ - if( (RegQueryValueEx(hReg, - "Bindir", - NULL, - NULL, - (unsigned char *) BinDir, - &lLen)) != ERROR_SUCCESS) { - exit_help("Failed to query BinDir of release (2).\n"); - } - -#ifdef _DEBUG - fprintf(stderr, "Bindir: '%s'\n", BinDir); -#endif - - /* We also need the rootdir, in case we need to build RelDir later */ - - /* First query size of data */ - if( (RegQueryValueEx(hReg, - "Rootdir", - NULL, - NULL, - NULL, - &lLen)) != ERROR_SUCCESS) { - exit_help("Failed to query RootDir of release.\n"); - } - - /* Allocate enough space */ - RootDir = (char *) malloc(lLen+1); - assert(RootDir); - /* Retrieve the value */ - if( (RegQueryValueEx(hReg, - "Rootdir", - NULL, - NULL, - (unsigned char *) RootDir, - &lLen)) != ERROR_SUCCESS) { - exit_help("Failed to query RootDir of release (2).\n"); - } - -#ifdef _DEBUG - fprintf(stderr, "Rootdir: '%s'\n", RootDir); -#endif - - RegCloseKey(hReg); -} - -/* * Read the bootflags. This file contains extra command line options to erl.exe */ void read_bootflags(void) @@ -424,7 +351,8 @@ void read_bootflags(void) exit_help("Need -reldir when -bootflags " "filename has relative path."); } else { - newname = (char *)malloc(strlen(BootFlagsFile)+strlen(RelDir)+strlen(Release)+3); + newname = (char *)malloc(strlen(BootFlagsFile)+ + strlen(RelDir)+strlen(Release)+3); assert(newname); sprintf(newname, "%s\\%s\\%s", RelDir, Release, BootFlagsFile); free(BootFlagsFile); @@ -436,8 +364,6 @@ void read_bootflags(void) fprintf(stderr, "BootFlagsFile: '%s'\n", BootFlagsFile); #endif - - if( (fp=fopen(BootFlagsFile, "rb")) == NULL) { exit_help("Could not open BootFlags file."); } @@ -605,32 +531,49 @@ void complete_options(void) sz = nsz; } if (RelDir == NULL) { - if(DataFileName){ - /* Needs to be absolute for this to work, but we - can try... */ - read_datafile(); - read_registry_keys(); - } else { - /* Impossible to find all data... */ - exit_help("Need either Release directory or an absolute " - "datafile name."); - } - /* Ok, construct our own RelDir from RootDir */ - RelDir = (char *) malloc(strlen(RootDir)+strlen(RELEASE_SUBDIR)+1); - assert(RelDir); - sprintf(RelDir, "%s" RELEASE_SUBDIR, RootDir); + if (!RootDir) { + /* Impossible to find all data... */ + exit_help("Need either Root directory nor Release directory."); + } + /* Ok, construct our own RelDir from RootDir */ + RelDir = (char *) malloc(strlen(RootDir)+strlen(RELEASE_SUBDIR)+1); + assert(RelDir); + sprintf(RelDir, "%s" RELEASE_SUBDIR, RootDir); + read_datafile(); } else { read_datafile(); - read_registry_keys(); } } else { read_datafile(); - read_registry_keys(); } + if( !RootDir ) { + /* Try to construct RootDir from RelDir */ + char *p; + RootDir = malloc(strlen(RelDir)+1); + strcpy(RootDir,RelDir); + p = RootDir+strlen(RootDir)-1; + if (p >= RootDir && (*p == '/' || *p == '\\')) + --p; + while (p >= RootDir && *p != '/' && *p != '\\') + --p; + if (p <= RootDir) { /* Empty RootDir is also an error */ + exit_help("Cannot determine Root directory from " + "Release directory."); + } + *p = '\0'; + } + + + BinDir = (char *) malloc(strlen(RootDir)+strlen(ERTS_SUBDIR_PREFIX)+ + strlen(Version)+strlen(BIN_SUBDIR)+1); + assert(BinDir); + sprintf(BinDir, "%s" ERTS_SUBDIR_PREFIX "%s" BIN_SUBDIR, RootDir, Version); + read_bootflags(); #ifdef _DEBUG fprintf(stderr, "RelDir: '%s'\n", RelDir); + fprintf(stderr, "BinDir: '%s'\n", BinDir); #endif } diff --git a/erts/example/matrix_nif.c b/erts/example/matrix_nif.c index c5e01dade5..43f9526ae3 100644 --- a/erts/example/matrix_nif.c +++ b/erts/example/matrix_nif.c @@ -31,7 +31,19 @@ typedef struct unsigned nrows; unsigned ncols; double* data; -}Matrix; +} Matrix; + +/* + * Use a union for pointer type conversion to avoid compiler warnings + * about strict-aliasing violations with gcc-4.1. gcc >= 4.2 does not + * emit the warning. + * TODO: Reconsider use of union once gcc-4.1 is obsolete? + */ +typedef union +{ + void* vp; + Matrix* p; +} mx_t; #define POS(MX, ROW, COL) ((MX)->data[(ROW)* (MX)->ncols + (COL)]) @@ -44,8 +56,9 @@ static ErlNifResourceType* resource_type = NULL; static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) { - ErlNifResourceType* rt = enif_open_resource_type(env, "matrix_nif_example", - matrix_dtor, + ErlNifResourceType* rt = enif_open_resource_type(env, NULL, + "matrix_nif_example", + matrix_dtor, ERL_NIF_RT_CREATE, NULL); if (rt == NULL) { return -1; @@ -90,12 +103,12 @@ static ERL_NIF_TERM create(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) } ret = enif_make_resource(env, mx); - enif_release_resource(env, mx); + enif_release_resource(mx); return ret; badarg: if (mx != NULL) { - enif_release_resource(env,mx); + enif_release_resource(mx); } return enif_make_badarg(env); } @@ -104,14 +117,14 @@ badarg: static ERL_NIF_TERM pos(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { /* pos(Matrix, Row, Column) -> float() */ - Matrix* mx; + mx_t mx; unsigned i, j; - if (!enif_get_resource(env, argv[0], resource_type, (void**)&mx) || - !enif_get_uint(env, argv[1], &i) || (--i >= mx->nrows) || - !enif_get_uint(env, argv[2], &j) || (--j >= mx->ncols)) { + if (!enif_get_resource(env, argv[0], resource_type, &mx.vp) || + !enif_get_uint(env, argv[1], &i) || (--i >= mx.p->nrows) || + !enif_get_uint(env, argv[2], &j) || (--j >= mx.p->ncols)) { return enif_make_badarg(env); } - return enif_make_double(env, POS(mx, i,j)); + return enif_make_double(env, POS(mx.p, i,j)); } static ERL_NIF_TERM add(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) @@ -119,37 +132,38 @@ static ERL_NIF_TERM add(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) /* add(Matrix_A, Matrix_B) -> Matrix_Sum */ unsigned i, j; ERL_NIF_TERM ret; - Matrix* mxA = NULL; - Matrix* mxB = NULL; - Matrix* mxS = NULL; + mx_t mxA, mxB, mxS; + mxA.p = NULL; + mxB.p = NULL; + mxS.p = NULL; - if (!enif_get_resource(env, argv[0], resource_type, (void**)&mxA) || - !enif_get_resource(env, argv[1], resource_type, (void**)&mxB) || - mxA->nrows != mxB->nrows || - mxB->ncols != mxB->ncols) { + if (!enif_get_resource(env, argv[0], resource_type, &mxA.vp) || + !enif_get_resource(env, argv[1], resource_type, &mxB.vp) || + mxA.p->nrows != mxB.p->nrows || + mxB.p->ncols != mxB.p->ncols) { return enif_make_badarg(env); } - mxS = alloc_matrix(env, mxA->nrows, mxA->ncols); - for (i = 0; i < mxA->nrows; i++) { - for (j = 0; j < mxA->ncols; j++) { - POS(mxS, i, j) = POS(mxA, i, j) + POS(mxB, i, j); + mxS.p = alloc_matrix(env, mxA.p->nrows, mxA.p->ncols); + for (i = 0; i < mxA.p->nrows; i++) { + for (j = 0; j < mxA.p->ncols; j++) { + POS(mxS.p, i, j) = POS(mxA.p, i, j) + POS(mxB.p, i, j); } } - ret = enif_make_resource(env, mxS); - enif_release_resource(env, mxS); + ret = enif_make_resource(env, mxS.p); + enif_release_resource(mxS.p); return ret; } static ERL_NIF_TERM size_of(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { /* size(Matrix) -> {Nrows, Ncols} */ - Matrix* mx; - if (!enif_get_resource(env, argv[0], resource_type, (void**)&mx)) { + mx_t mx; + if (!enif_get_resource(env, argv[0], resource_type, &mx.vp)) { return enif_make_badarg(env); } - return enif_make_tuple2(env, enif_make_uint(env, mx->nrows), - enif_make_uint(env, mx->ncols)); + return enif_make_tuple2(env, enif_make_uint(env, mx.p->nrows), + enif_make_uint(env, mx.p->ncols)); } static ERL_NIF_TERM to_term(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) @@ -157,16 +171,17 @@ static ERL_NIF_TERM to_term(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) /* to_term(Matrix) -> [[first row], [second row], ...,[last row]] */ unsigned i, j; ERL_NIF_TERM res; - Matrix* mx = NULL; + mx_t mx; + mx.p = NULL; - if (!enif_get_resource(env, argv[0], resource_type, (void**)&mx)) { + if (!enif_get_resource(env, argv[0], resource_type, &mx.vp)) { return enif_make_badarg(env); } res = enif_make_list(env, 0); - for (i = mx->nrows; i-- > 0; ) { + for (i = mx.p->nrows; i-- > 0; ) { ERL_NIF_TERM row = enif_make_list(env, 0); - for (j = mx->ncols; j-- > 0; ) { - row = enif_make_list_cell(env, enif_make_double(env, POS(mx,i,j)), + for (j = mx.p->ncols; j-- > 0; ) { + row = enif_make_list_cell(env, enif_make_double(env, POS(mx.p,i,j)), row); } res = enif_make_list_cell(env, row, res); @@ -183,17 +198,17 @@ static int get_number(ErlNifEnv* env, ERL_NIF_TERM term, double* dp) static Matrix* alloc_matrix(ErlNifEnv* env, unsigned nrows, unsigned ncols) { - Matrix* mx = enif_alloc_resource(env, resource_type, sizeof(Matrix)); + Matrix* mx = enif_alloc_resource(resource_type, sizeof(Matrix)); mx->nrows = nrows; mx->ncols = ncols; - mx->data = enif_alloc(env, nrows*ncols*sizeof(double)); + mx->data = enif_alloc(nrows*ncols*sizeof(double)); return mx; } static void matrix_dtor(ErlNifEnv* env, void* obj) { Matrix* mx = (Matrix*) obj; - enif_free(env, mx->data); + enif_free(mx->data); mx->data = NULL; } diff --git a/erts/lib_src/common/erl_misc_utils.c b/erts/lib_src/common/erl_misc_utils.c index 5dbf98c7d1..5e94ff19db 100644 --- a/erts/lib_src/common/erl_misc_utils.c +++ b/erts/lib_src/common/erl_misc_utils.c @@ -55,6 +55,12 @@ # ifdef HAVE_UNISTD_H # include <unistd.h> # endif +# if defined(_SC_NPROC_CONF) && !defined(_SC_NPROCESSORS_CONF) +# define _SC_NPROCESSORS_CONF _SC_NPROC_CONF +# endif +# if defined(_SC_NPROC_ONLN) && !defined(_SC_NPROCESSORS_ONLN) +# define _SC_NPROCESSORS_ONLN _SC_NPROC_ONLN +# endif # if (defined(NO_SYSCONF) || !defined(_SC_NPROCESSORS_CONF)) # ifdef HAVE_SYS_SYSCTL_H # include <sys/sysctl.h> @@ -1511,7 +1517,7 @@ const char* parse_topology_spec_group(erts_cpu_info_t *cpuinfo, const char* xml, } } - if (cacheLevel == 0) { + if (parentCacheLevel == 0) { *core_p = 0; *processor_p = (*processor_p)++; } else { diff --git a/erts/lib_src/common/erl_printf.c b/erts/lib_src/common/erl_printf.c index 72d18ab6f1..6aa4569d44 100644 --- a/erts/lib_src/common/erl_printf.c +++ b/erts/lib_src/common/erl_printf.c @@ -108,7 +108,7 @@ write_f_add_cr(void *vfp, char* buf, size_t len) if (PUTC(buf[i], (FILE *) vfp) == EOF) return get_error_result(); } - return 0; + return len; } static int @@ -126,13 +126,14 @@ write_f(void *vfp, char* buf, size_t len) #endif if (FWRITE((void *) buf, sizeof(char), len, (FILE *) vfp) != len) return get_error_result(); - return 0; + return len; } static int write_fd(void *vfdp, char* buf, size_t len) { ssize_t size; + size_t res = len; ASSERT(vfdp); while (len) { @@ -149,7 +150,7 @@ write_fd(void *vfdp, char* buf, size_t len) len -= size; } - return 0; + return res; } static int @@ -160,7 +161,7 @@ write_s(void *vwbufpp, char* bufp, size_t len) ASSERT(len > 0); memcpy((void *) *wbufpp, (void *) bufp, len); *wbufpp += len; - return 0; + return len; } @@ -182,6 +183,7 @@ write_sn(void *vwsnap, char* buf, size_t len) memcpy((void *) wsnap->buf, (void *) buf, sz); wsnap->buf += sz; wsnap->len -= sz; + return sz; } return 0; } @@ -201,7 +203,7 @@ write_ds(void *vdsbufp, char* buf, size_t len) } memcpy((void *) (dsbufp->str + dsbufp->str_len), (void *) buf, len); dsbufp->str_len += len; - return 0; + return len; } int diff --git a/erts/lib_src/common/erl_printf_format.c b/erts/lib_src/common/erl_printf_format.c index fba3fd723c..473791dce4 100644 --- a/erts/lib_src/common/erl_printf_format.c +++ b/erts/lib_src/common/erl_printf_format.c @@ -388,7 +388,7 @@ static int fmt_double(fmtfn_t fn,void*arg,double val, max_size++; if (precision) max_size += precision; - else if (fmt && FMTF_alt) + else if (fmt & FMTF_alt) max_size++; break; case FMTC_E: @@ -402,7 +402,7 @@ static int fmt_double(fmtfn_t fn,void*arg,double val, max_size += 4; if (precision) max_size += precision; - else if (fmt && FMTF_alt) + else if (fmt & FMTF_alt) max_size++; aexp = exp >= 0 ? exp : -exp; if (aexp < 100) diff --git a/erts/preloaded/ebin/erl_prim_loader.beam b/erts/preloaded/ebin/erl_prim_loader.beam Binary files differindex dccb92a5af..20c82c52bb 100644 --- a/erts/preloaded/ebin/erl_prim_loader.beam +++ b/erts/preloaded/ebin/erl_prim_loader.beam diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam Binary files differindex b537546071..9202b5be4f 100644 --- a/erts/preloaded/ebin/erlang.beam +++ b/erts/preloaded/ebin/erlang.beam diff --git a/erts/preloaded/ebin/init.beam b/erts/preloaded/ebin/init.beam Binary files differindex 901def5eba..faa2cf573c 100644 --- a/erts/preloaded/ebin/init.beam +++ b/erts/preloaded/ebin/init.beam diff --git a/erts/preloaded/ebin/prim_file.beam b/erts/preloaded/ebin/prim_file.beam Binary files differindex 66fcb9e6a9..00a1cf065a 100644 --- a/erts/preloaded/ebin/prim_file.beam +++ b/erts/preloaded/ebin/prim_file.beam diff --git a/erts/preloaded/ebin/zlib.beam b/erts/preloaded/ebin/zlib.beam Binary files differindex 542e266f88..cda53f7692 100644 --- a/erts/preloaded/ebin/zlib.beam +++ b/erts/preloaded/ebin/zlib.beam diff --git a/erts/preloaded/src/erl_prim_loader.erl b/erts/preloaded/src/erl_prim_loader.erl index 024b20eadb..ccfa7978c8 100644 --- a/erts/preloaded/src/erl_prim_loader.erl +++ b/erts/preloaded/src/erl_prim_loader.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% Copyright Ericsson AB 1996-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -102,8 +102,14 @@ debug(#prim_state{debug = Deb}, Term) -> %%% Interface Functions. %%% -------------------------------------------------------- --spec start(term(), atom() | string(), host() | [host()]) -> - {'ok', pid()} | {'error', term()}. +-spec start(Id, Loader, Hosts) -> + {'ok', Pid} | {'error', What} when + Id :: term(), + Loader :: atom() | string(), + Hosts :: Host | [Host], + Host :: host(), + Pid :: pid(), + What :: term(). start(Id, Pgm, Hosts) when is_atom(Hosts) -> start(Id, Pgm, [Hosts]); start(Id, Pgm0, Hosts) -> @@ -123,18 +129,6 @@ start(Id, Pgm0, Hosts) -> {error,Reason} end. -start_it("ose_inet"=Cmd, Id, Pid, Hosts) -> - %% Setup reserved port for ose_inet driver (only OSE) - case catch erlang:open_port({spawn,Cmd}, [binary]) of - {'EXIT',Why} -> - ?dbg(ose_inet_port_open_fail, Why), - Why; - OseInetPort -> - ?dbg(ose_inet_port, OseInetPort), - OseInetPort - end, - start_it("inet", Id, Pid, Hosts); - %% Hosts must be a list on form ['1.2.3.4' ...] start_it("inet", Id, Pid, Hosts) -> process_flag(trap_exit, true), @@ -174,15 +168,20 @@ init_ack(Pid) -> Pid ! {self(),ok}, ok. --spec set_path([string()]) -> 'ok'. +-spec set_path(Path) -> 'ok' when + Path :: [Dir :: string()]. set_path(Paths) when is_list(Paths) -> request({set_path,Paths}). --spec get_path() -> {'ok', [string()]}. +-spec get_path() -> {'ok', Path} when + Path :: [Dir :: string()]. get_path() -> request({get_path,[]}). --spec get_file(atom() | string()) -> {'ok', binary(), string()} | 'error'. +-spec get_file(Filename) -> {'ok', Bin, FullName} | 'error' when + Filename :: atom() | string(), + Bin :: binary(), + FullName :: string(). get_file(File) when is_atom(File) -> get_file(atom_to_list(File)); get_file(File) -> @@ -202,13 +201,15 @@ get_files(ModFiles, Fun) -> ok end. --spec list_dir(string()) -> {'ok', [string()]} | 'error'. +-spec list_dir(Dir) -> {'ok', Filenames} | 'error' when + Dir :: string(), + Filenames :: [Filename :: string()]. list_dir(Dir) -> check_file_result(list_dir, Dir, request({list_dir,Dir})). -%% -> {ok,Info} | error --spec read_file_info(string()) -> {'ok', tuple()} | 'error'. - +-spec read_file_info(Filename) -> {'ok', FileInfo} | 'error' when + Filename :: string(), + FileInfo :: file:file_info(). read_file_info(File) -> check_file_result(read_file_info, File, request({read_file_info,File})). @@ -1360,9 +1361,7 @@ pathtype(Name) when is_list(Name) -> absolute; _ -> relative - end; - {ose,_} -> - unix_pathtype(Name) + end end. unix_pathtype(Name) -> diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl index 4679a916c7..5deb69edab 100644 --- a/erts/preloaded/src/erlang.erl +++ b/erts/preloaded/src/erlang.erl @@ -53,22 +53,31 @@ -compile({no_auto_import,[spawn_opt/4]}). -compile({no_auto_import,[spawn_opt/5]}). -%%-------------------------------------------------------------------------- +-export_type([timestamp/0]). --type date() :: {pos_integer(), pos_integer(), pos_integer()}. --type time() :: {non_neg_integer(), non_neg_integer(), non_neg_integer()}. --type date_time() :: {date(), time()}. +-type timestamp() :: {MegaSecs :: non_neg_integer(), + Secs :: non_neg_integer(), + MicroSecs :: non_neg_integer()}. %%-------------------------------------------------------------------------- +-spec apply(Fun, Args) -> term() when + Fun :: function(), + Args :: [term()]. apply(Fun, Args) -> erlang:apply(Fun, Args). +-spec apply(Module, Function, Args) -> term() when + Module :: module(), + Function :: atom(), + Args :: [term()]. apply(Mod, Name, Args) -> erlang:apply(Mod, Name, Args). %% Spawns with a fun +-spec spawn(Fun) -> pid() when + Fun :: function(). spawn(F) when is_function(F) -> spawn(erlang, apply, [F, []]); spawn({M,F}=MF) when is_atom(M), is_atom(F) -> @@ -76,6 +85,9 @@ spawn({M,F}=MF) when is_atom(M), is_atom(F) -> spawn(F) -> erlang:error(badarg, [F]). +-spec spawn(Node, Fun) -> pid() when + Node :: node(), + Fun :: function(). spawn(N, F) when N =:= node() -> spawn(F); spawn(N, F) when is_function(F) -> @@ -85,6 +97,8 @@ spawn(N, {M,F}=MF) when is_atom(M), is_atom(F) -> spawn(N, F) -> erlang:error(badarg, [N, F]). +-spec spawn_link(Fun) -> pid() when + Fun :: function(). spawn_link(F) when is_function(F) -> spawn_link(erlang, apply, [F, []]); spawn_link({M,F}=MF) when is_atom(M), is_atom(F) -> @@ -92,6 +106,9 @@ spawn_link({M,F}=MF) when is_atom(M), is_atom(F) -> spawn_link(F) -> erlang:error(badarg, [F]). +-spec spawn_link(Node, Fun) -> pid() when + Node :: node(), + Fun :: function(). spawn_link(N, F) when N =:= node() -> spawn_link(F); spawn_link(N, F) when is_function(F) -> @@ -103,16 +120,30 @@ spawn_link(N, F) -> %% Spawn and atomically set up a monitor. +-spec spawn_monitor(Fun) -> {pid(), reference()} when + Fun :: function(). spawn_monitor(F) when is_function(F, 0) -> erlang:spawn_opt({erlang,apply,[F,[]],[monitor]}); spawn_monitor(F) -> erlang:error(badarg, [F]). +-spec spawn_monitor(Module, Function, Args) -> {pid(), reference()} when + Module :: module(), + Function :: atom(), + Args :: [term()]. spawn_monitor(M, F, A) when is_atom(M), is_atom(F), is_list(A) -> erlang:spawn_opt({M,F,A,[monitor]}); spawn_monitor(M, F, A) -> erlang:error(badarg, [M,F,A]). +-spec spawn_opt(Fun, Options) -> pid() | {pid(), reference()} when + Fun :: function(), + Options :: [Option], + Option :: link | monitor | {priority, Level} + | {fullsweep_after, Number :: non_neg_integer()} + | {min_heap_size, Size :: non_neg_integer()} + | {min_bin_vheap_size, VSize :: non_neg_integer()}, + Level :: low | normal | high. spawn_opt(F, O) when is_function(F) -> spawn_opt(erlang, apply, [F, []], O); spawn_opt({M,F}=MF, O) when is_atom(M), is_atom(F) -> @@ -122,6 +153,15 @@ spawn_opt({M,F,A}, O) -> % For (undocumented) backward compatibility spawn_opt(F, O) -> erlang:error(badarg, [F, O]). +-spec spawn_opt(Node, Fun, Options) -> pid() | {pid(), reference()} when + Node :: node(), + Fun :: function(), + Options :: [Option], + Option :: link | monitor | {priority, Level} + | {fullsweep_after, Number :: non_neg_integer()} + | {min_heap_size, Size :: non_neg_integer()} + | {min_bin_vheap_size, VSize :: non_neg_integer()}, + Level :: low | normal | high. spawn_opt(N, F, O) when N =:= node() -> spawn_opt(F, O); spawn_opt(N, F, O) when is_function(F) -> @@ -133,6 +173,11 @@ spawn_opt(N, F, O) -> %% Spawns with MFA +-spec spawn(Node, Module, Function, Args) -> pid() when + Node :: node(), + Module :: module(), + Function :: atom(), + Args :: [term()]. spawn(N,M,F,A) when N =:= node(), is_atom(M), is_atom(F), is_list(A) -> spawn(M,F,A); spawn(N,M,F,A) when is_atom(N), is_atom(M), is_atom(F) -> @@ -158,6 +203,11 @@ spawn(N,M,F,A) when is_atom(N), is_atom(M), is_atom(F) -> spawn(N,M,F,A) -> erlang:error(badarg, [N, M, F, A]). +-spec spawn_link(Node, Module, Function, Args) -> pid() when + Node :: node(), + Module :: module(), + Function :: atom(), + Args :: [term()]. spawn_link(N,M,F,A) when N =:= node(), is_atom(M), is_atom(F), is_list(A) -> spawn_link(M,F,A); spawn_link(N,M,F,A) when is_atom(N), is_atom(M), is_atom(F) -> @@ -183,6 +233,17 @@ spawn_link(N,M,F,A) when is_atom(N), is_atom(M), is_atom(F) -> spawn_link(N,M,F,A) -> erlang:error(badarg, [N, M, F, A]). +-spec spawn_opt(Module, Function, Args, Options) -> + pid() | {pid(), reference()} when + Module :: module(), + Function :: atom(), + Args :: [term()], + Options :: [Option], + Option :: link | monitor | {priority, Level} + | {fullsweep_after, Number :: non_neg_integer()} + | {min_heap_size, Size :: non_neg_integer()} + | {min_bin_vheap_size, VSize :: non_neg_integer()}, + Level :: low | normal | high. spawn_opt(M, F, A, Opts) -> case catch erlang:spawn_opt({M,F,A,Opts}) of {'EXIT',{Reason,_}} -> @@ -191,6 +252,18 @@ spawn_opt(M, F, A, Opts) -> Res end. +-spec spawn_opt(Node, Module, Function, Args, Options) -> + pid() | {pid(), reference()} when + Node :: node(), + Module :: module(), + Function :: atom(), + Args :: [term()], + Options :: [Option], + Option :: link | monitor | {priority, Level} + | {fullsweep_after, Number :: non_neg_integer()} + | {min_heap_size, Size :: non_neg_integer()} + | {min_bin_vheap_size, VSize :: non_neg_integer()}, + Level :: low | normal | high. spawn_opt(N, M, F, A, O) when N =:= node(), is_atom(M), is_atom(F), is_list(A), is_list(O) -> @@ -260,18 +333,25 @@ crasher(Node,Mod,Fun,Args,Opts,Reason) -> [Mod,Fun,Args,Opts,Node]), exit(Reason). --spec yield() -> 'true'. +-spec erlang:yield() -> 'true'. yield() -> erlang:yield(). --spec nodes() -> [node()]. +-spec nodes() -> Nodes when + Nodes :: [node()]. nodes() -> erlang:nodes(visible). --spec disconnect_node(node()) -> boolean(). +-spec disconnect_node(Node) -> boolean() | ignored when + Node :: node(). disconnect_node(Node) -> net_kernel:disconnect(Node). +-spec erlang:fun_info(Fun) -> [{Item, Info}] when + Fun :: function(), + Item :: arity | env | index | name + | module | new_index | new_uniq | pid | type | uniq, + Info :: term(). fun_info(Fun) when is_function(Fun) -> Keys = [type,env,arity,name,uniq,index,new_uniq,new_index,module,pid], fun_info_1(Keys, Fun, []). @@ -283,24 +363,37 @@ fun_info_1([K|Ks], Fun, A) -> end; fun_info_1([], _, A) -> A. --type dst() :: pid() | port() | atom() | {atom(), node()}. +-type dst() :: pid() + | port() + | (RegName :: atom()) + | {RegName :: atom(), Node :: node()}. --spec send_nosuspend(dst(), term()) -> boolean(). +-spec erlang:send_nosuspend(Dest, Msg) -> boolean() when + Dest :: dst(), + Msg :: term(). send_nosuspend(Pid, Msg) -> send_nosuspend(Pid, Msg, []). --spec send_nosuspend(dst(), term(), ['noconnect' | 'nosuspend']) -> boolean(). +-spec erlang:send_nosuspend(Dest, Msg, Options) -> boolean() when + Dest :: dst(), + Msg :: term(), + Options :: [noconnect]. send_nosuspend(Pid, Msg, Opts) -> case erlang:send(Pid, Msg, [nosuspend|Opts]) of ok -> true; _ -> false end. --spec localtime_to_universaltime(date_time()) -> date_time(). +-spec erlang:localtime_to_universaltime({Date1, Time1}) -> {Date2, Time2} when + Date1 :: calendar:date(), + Date2 :: calendar:date(), + Time1 :: calendar:time(), + Time2 :: calendar:time(). localtime_to_universaltime(Localtime) -> erlang:localtime_to_universaltime(Localtime, undefined). --spec suspend_process(pid()) -> 'true'. +-spec erlang:suspend_process(Suspendee) -> 'true' when + Suspendee :: pid(). suspend_process(P) -> case catch erlang:suspend_process(P, []) of {'EXIT', {Reason, _}} -> erlang:error(Reason, [P]); @@ -426,6 +519,9 @@ delay_trap(Result, Timeout) -> receive after Timeout -> Result end. %% Messages to us use our cookie. IF we change our cookie, other nodes %% have to reflect that, which we cannot forsee. %% +-spec erlang:set_cookie(Node, Cookie) -> true when + Node :: node(), + Cookie :: atom(). set_cookie(Node, C) when Node =/= nonode@nohost, is_atom(Node) -> case is_atom(C) of true -> @@ -434,14 +530,19 @@ set_cookie(Node, C) when Node =/= nonode@nohost, is_atom(Node) -> error(badarg) end. --spec get_cookie() -> atom(). +-spec erlang:get_cookie() -> Cookie | nocookie when + Cookie :: atom(). get_cookie() -> auth:get_cookie(). +-spec concat_binary(ListOfBinaries) -> binary() when + ListOfBinaries :: iolist(). concat_binary(List) -> list_to_binary(List). --spec integer_to_list(integer(), 1..255) -> string(). +-spec integer_to_list(Integer, Base) -> string() when + Integer :: integer(), + Base :: 2..36. integer_to_list(I, 10) -> erlang:integer_to_list(I); integer_to_list(I, Base) @@ -469,6 +570,9 @@ integer_to_list(I0, Base, R0) -> end. +-spec list_to_integer(String, Base) -> integer() when + String :: string(), + Base :: 2..36. list_to_integer(L, 10) -> erlang:list_to_integer(L); list_to_integer(L, Base) @@ -689,10 +793,16 @@ await_proc_exit(Proc, Op, Data) -> end end. --spec min(term(), term()) -> term(). +-spec min(Term1, Term2) -> Minimum when + Term1 :: term(), + Term2 :: term(), + Minimum :: term(). min(A, B) when A > B -> B; min(A, _) -> A. --spec max(term(), term()) -> term(). +-spec max(Term1, Term2) -> Maximum when + Term1 :: term(), + Term2 :: term(), + Maximum :: term(). max(A, B) when A < B -> B; max(A, _) -> A. diff --git a/erts/preloaded/src/init.erl b/erts/preloaded/src/init.erl index 24430a3d40..e52c813029 100644 --- a/erts/preloaded/src/init.erl +++ b/erts/preloaded/src/init.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% Copyright Ericsson AB 1996-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -28,10 +28,10 @@ %% : $Var in the boot script is expanded to %% Value. %% -loader LoaderMethod -%% : efile, inet, ose_inet +%% : efile, inet %% (Optional - default efile) %% -hosts [Node] : List of hosts from which we can boot. -%% (Mandatory if -loader inet or ose_inet) +%% (Mandatory if -loader inet) %% -mode embedded : Load all modules at startup, no automatic loading %% -mode interactive : Auto load modules (default system behaviour). %% -path : Override path in bootfile. @@ -79,19 +79,24 @@ debug(false, _) -> ok; debug(_, T) -> erlang:display(T). --spec get_arguments() -> [{atom(), [string()]}]. +-spec get_arguments() -> Flags when + Flags :: [{Flag :: atom(), Values :: [string()]}]. get_arguments() -> request(get_arguments). --spec get_plain_arguments() -> [string()]. +-spec get_plain_arguments() -> [Arg] when + Arg :: string(). get_plain_arguments() -> bs2ss(request(get_plain_arguments)). --spec get_argument(atom()) -> 'error' | {'ok', [[string()]]}. +-spec get_argument(Flag) -> {'ok', Arg} | 'error' when + Flag :: atom(), + Arg :: [Values :: [string()]]. get_argument(Arg) -> request({get_argument, Arg}). --spec script_id() -> term(). +-spec script_id() -> Id when + Id :: term(). script_id() -> request(script_id). @@ -105,7 +110,9 @@ bs2ss(L0) when is_list(L0) -> bs2ss(L) -> L. --spec get_status() -> {internal_status(), term()}. +-spec get_status() -> {InternalStatus, ProvidedStatus} when + InternalStatus :: internal_status(), + ProvidedStatus :: term(). get_status() -> request(get_status). @@ -150,10 +157,12 @@ reboot() -> init ! {stop,reboot}, ok. -spec stop() -> 'ok'. stop() -> init ! {stop,stop}, ok. --spec stop(non_neg_integer() | string()) -> 'ok'. +-spec stop(Status) -> 'ok' when + Status :: non_neg_integer() | string(). stop(Status) -> init ! {stop,{stop,Status}}, ok. --spec boot([binary()]) -> no_return(). +-spec boot(BootArgs) -> no_return() when + BootArgs :: [binary()]. boot(BootArgs) -> register(init, self()), process_flag(trap_exit, true), @@ -1024,7 +1033,7 @@ start_it({eval,Bin}) -> TsR -> reverse([{dot,1} | TsR]) end, {ok,Expr} = erl_parse:parse_exprs(Ts1), - erl_eval:exprs(Expr, []), + erl_eval:exprs(Expr, erl_eval:new_bindings()), ok; start_it([_|_]=MFA) -> Ref = make_ref(), diff --git a/erts/preloaded/src/prim_file.erl b/erts/preloaded/src/prim_file.erl index 8e0790e74a..ac7570582e 100644 --- a/erts/preloaded/src/prim_file.erl +++ b/erts/preloaded/src/prim_file.erl @@ -63,7 +63,7 @@ -include("file.hrl"). --define(DRV, efile). +-define(DRV, "efile"). -define(FD_DRV, "efile"). -define(LARGEFILESIZE, (1 bsl 63)). @@ -549,7 +549,7 @@ write_file(_, _) -> %% Returns {ok, Port}, the Port should be used as first argument in all %% the following functions. Returns {error, Reason} upon failure. start() -> - try erlang:open_port({spawn, atom_to_list(?DRV)}, [binary]) of + try erlang:open_port({spawn, ?DRV}, [binary]) of Port -> {ok, Port} catch diff --git a/erts/preloaded/src/zlib.erl b/erts/preloaded/src/zlib.erl index 51d6cd0a0b..210532edac 100644 --- a/erts/preloaded/src/zlib.erl +++ b/erts/preloaded/src/zlib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2010. All Rights Reserved. +%% Copyright Ericsson AB 2003-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -124,7 +124,6 @@ -type zwindowbits() :: -15..-9 | 9..47. -type zmemlevel() :: 1..9. -type zstrategy() :: 'default' | 'filtered' | 'huffman_only'. --type zflush() :: 'none' | 'sync' | 'full' | 'finish'. %%------------------------------------------------------------------------ @@ -134,7 +133,8 @@ open() -> open_port({spawn, "zlib_drv"}, [binary]). %% close and release z_stream --spec close(zstream()) -> 'ok'. +-spec close(Z) -> 'ok' when + Z :: zstream(). close(Z) -> try true = port_close(Z), @@ -145,16 +145,25 @@ close(Z) -> catch _:_ -> erlang:error(badarg) end. --spec deflateInit(zstream()) -> 'ok'. +-spec deflateInit(Z) -> 'ok' when + Z :: zstream(). deflateInit(Z) -> call(Z, ?DEFLATE_INIT, <<?Z_DEFAULT_COMPRESSION:32>>). --spec deflateInit(zstream(), zlevel()) -> 'ok'. +-spec deflateInit(Z, Level) -> 'ok' when + Z :: zstream(), + Level :: zlevel(). deflateInit(Z, Level) -> call(Z, ?DEFLATE_INIT, <<(arg_level(Level)):32>>). --spec deflateInit(zstream(), zlevel(), zmethod(), - zwindowbits(), zmemlevel(), zstrategy()) -> 'ok'. +-spec deflateInit(Z, Level, Method, + WindowBits, MemLevel, Strategy) -> 'ok' when + Z :: zstream(), + Level :: zlevel(), + Method :: zmethod(), + WindowBits :: zwindowbits(), + MemLevel :: zmemlevel(), + Strategy :: zstrategy(). deflateInit(Z, Level, Method, WindowBits, MemLevel, Strategy) -> call(Z, ?DEFLATE_INIT2, <<(arg_level(Level)):32, (arg_method(Method)):32, @@ -162,24 +171,38 @@ deflateInit(Z, Level, Method, WindowBits, MemLevel, Strategy) -> (arg_mem(MemLevel)):32, (arg_strategy(Strategy)):32>>). --spec deflateSetDictionary(zstream(), binary()) -> integer(). +-spec deflateSetDictionary(Z, Dictionary) -> Adler32 when + Z :: zstream(), + Dictionary :: iodata(), + Adler32 :: integer(). deflateSetDictionary(Z, Dictionary) -> call(Z, ?DEFLATE_SETDICT, Dictionary). --spec deflateReset(zstream()) -> 'ok'. +-spec deflateReset(Z) -> 'ok' when + Z :: zstream(). deflateReset(Z) -> call(Z, ?DEFLATE_RESET, []). --spec deflateParams(zstream(), zlevel(), zstrategy()) -> 'ok'. +-spec deflateParams(Z, Level, Strategy) -> ok when + Z :: zstream(), + Level :: zlevel(), + Strategy :: zstrategy(). deflateParams(Z, Level, Strategy) -> call(Z, ?DEFLATE_PARAMS, <<(arg_level(Level)):32, (arg_strategy(Strategy)):32>>). --spec deflate(zstream(), iodata()) -> iolist(). +-spec deflate(Z, Data) -> Compressed when + Z :: zstream(), + Data :: iodata(), + Compressed :: iolist(). deflate(Z, Data) -> deflate(Z, Data, none). --spec deflate(zstream(), iodata(), zflush()) -> iolist(). +-spec deflate(Z, Data, Flush) -> Compressed when + Z :: zstream(), + Data :: iodata(), + Flush :: none | sync | full | finish, + Compressed :: iolist(). deflate(Z, Data, Flush) -> try port_command(Z, Data) of true -> @@ -191,19 +214,25 @@ deflate(Z, Data, Flush) -> erlang:error(badarg) end. --spec deflateEnd(zstream()) -> 'ok'. +-spec deflateEnd(Z) -> 'ok' when + Z :: zstream(). deflateEnd(Z) -> call(Z, ?DEFLATE_END, []). --spec inflateInit(zstream()) -> 'ok'. +-spec inflateInit(Z) -> 'ok' when + Z :: zstream(). inflateInit(Z) -> call(Z, ?INFLATE_INIT, []). --spec inflateInit(zstream(), zwindowbits()) -> 'ok'. +-spec inflateInit(Z, WindowBits) -> 'ok' when + Z :: zstream(), + WindowBits :: zwindowbits(). inflateInit(Z, WindowBits) -> call(Z, ?INFLATE_INIT2, <<(arg_bitsz(WindowBits)):32>>). --spec inflateSetDictionary(zstream(), binary()) -> 'ok'. +-spec inflateSetDictionary(Z, Dictionary) -> 'ok' when + Z :: zstream(), + Dictionary :: iodata(). inflateSetDictionary(Z, Dictionary) -> call(Z, ?INFLATE_SETDICT, Dictionary). @@ -211,11 +240,15 @@ inflateSetDictionary(Z, Dictionary) -> inflateSync(Z) -> call(Z, ?INFLATE_SYNC, []). --spec inflateReset(zstream()) -> 'ok'. +-spec inflateReset(Z) -> 'ok' when + Z :: zstream(). inflateReset(Z) -> call(Z, ?INFLATE_RESET, []). --spec inflate(zstream(), iodata()) -> iolist(). +-spec inflate(Z, Data) -> Decompressed when + Z :: zstream(), + Data :: iodata(), + Decompressed :: iolist(). inflate(Z, Data) -> try port_command(Z, Data) of true -> @@ -227,50 +260,79 @@ inflate(Z, Data) -> erlang:error(badarg) end. --spec inflateEnd(zstream()) -> 'ok'. +-spec inflateEnd(Z) -> 'ok' when + Z :: zstream(). inflateEnd(Z) -> call(Z, ?INFLATE_END, []). --spec setBufSize(zstream(), non_neg_integer()) -> 'ok'. +-spec setBufSize(Z, Size) -> 'ok' when + Z :: zstream(), + Size :: non_neg_integer(). setBufSize(Z, Size) -> call(Z, ?SET_BUFSZ, <<Size:32>>). --spec getBufSize(zstream()) -> non_neg_integer(). +-spec getBufSize(Z) -> Size when + Z :: zstream(), + Size :: non_neg_integer(). getBufSize(Z) -> call(Z, ?GET_BUFSZ, []). --spec crc32(zstream()) -> integer(). +-spec crc32(Z) -> CRC when + Z :: zstream(), + CRC :: integer(). crc32(Z) -> call(Z, ?CRC32_0, []). --spec crc32(zstream(), binary()) -> integer(). -crc32(Z, Binary) -> - call(Z, ?CRC32_1, Binary). - --spec crc32(zstream(), integer(), binary()) -> integer(). -crc32(Z, CRC, Binary) when is_binary(Binary), is_integer(CRC) -> - call(Z, ?CRC32_2, <<CRC:32, Binary/binary>>); -crc32(_Z, _CRC, _Binary) -> - erlang:error(badarg). - --spec adler32(zstream(), binary()) -> integer(). -adler32(Z, Binary) -> - call(Z, ?ADLER32_1, Binary). - --spec adler32(zstream(), integer(), binary()) -> integer(). -adler32(Z, Adler, Binary) when is_binary(Binary), is_integer(Adler) -> - call(Z, ?ADLER32_2, <<Adler:32, Binary/binary>>); -adler32(_Z, _Adler, _Binary) -> +-spec crc32(Z, Data) -> CRC when + Z :: zstream(), + Data :: iodata(), + CRC :: integer(). +crc32(Z, Data) -> + call(Z, ?CRC32_1, Data). + +-spec crc32(Z, PrevCRC, Data) -> CRC when + Z :: zstream(), + PrevCRC :: integer(), + Data :: iodata(), + CRC :: integer(). +crc32(Z, CRC, Data) -> + call(Z, ?CRC32_2, [<<CRC:32>>, Data]). + +-spec adler32(Z, Data) -> CheckSum when + Z :: zstream(), + Data :: iodata(), + CheckSum :: integer(). +adler32(Z, Data) -> + call(Z, ?ADLER32_1, Data). + +-spec adler32(Z, PrevAdler, Data) -> CheckSum when + Z :: zstream(), + PrevAdler :: integer(), + Data :: iodata(), + CheckSum :: integer(). +adler32(Z, Adler, Data) when is_integer(Adler) -> + call(Z, ?ADLER32_2, [<<Adler:32>>, Data]); +adler32(_Z, _Adler, _Data) -> erlang:error(badarg). --spec crc32_combine(zstream(), integer(), integer(), integer()) -> integer(). +-spec crc32_combine(Z, CRC1, CRC2, Size2) -> CRC when + Z :: zstream(), + CRC :: integer(), + CRC1 :: integer(), + CRC2 :: integer(), + Size2 :: integer(). crc32_combine(Z, CRC1, CRC2, Len2) when is_integer(CRC1), is_integer(CRC2), is_integer(Len2) -> call(Z, ?CRC32_COMBINE, <<CRC1:32, CRC2:32, Len2:32>>); crc32_combine(_Z, _CRC1, _CRC2, _Len2) -> erlang:error(badarg). --spec adler32_combine(zstream(), integer(), integer(), integer()) -> integer(). +-spec adler32_combine(Z, Adler1, Adler2, Size2) -> Adler when + Z :: zstream(), + Adler :: integer(), + Adler1 :: integer(), + Adler2 :: integer(), + Size2 :: integer(). adler32_combine(Z, Adler1, Adler2, Len2) when is_integer(Adler1), is_integer(Adler2), is_integer(Len2) -> call(Z, ?ADLER32_COMBINE, <<Adler1:32, Adler2:32, Len2:32>>); @@ -282,64 +344,83 @@ getQSize(Z) -> call(Z, ?GET_QSIZE, []). %% compress/uncompress zlib with header --spec compress(binary()) -> binary(). -compress(Binary) -> +-spec compress(Data) -> Compressed when + Data :: iodata(), + Compressed :: binary(). +compress(Data) -> Z = open(), deflateInit(Z, default), - Bs = deflate(Z, Binary,finish), + Bs = deflate(Z, Data, finish), deflateEnd(Z), close(Z), - list_to_binary(Bs). - --spec uncompress(binary()) -> binary(). -uncompress(Binary) when byte_size(Binary) >= 8 -> - Z = open(), - inflateInit(Z), - Bs = inflate(Z, Binary), - inflateEnd(Z), - close(Z), - list_to_binary(Bs); -uncompress(Binary) when is_binary(Binary) -> erlang:error(data_error); -uncompress(_) -> erlang:error(badarg). + iolist_to_binary(Bs). + +-spec uncompress(Data) -> Decompressed when + Data :: iodata(), + Decompressed :: binary(). +uncompress(Data) -> + try iolist_size(Data) of + Size -> + if + Size >= 8 -> + Z = open(), + inflateInit(Z), + Bs = inflate(Z, Data), + inflateEnd(Z), + close(Z), + iolist_to_binary(Bs); + true -> + erlang:error(data_error) + end + catch + _:_ -> + erlang:error(badarg) + end. %% unzip/zip zlib without header (zip members) --spec zip(binary()) -> binary(). -zip(Binary) -> +-spec zip(Data) -> Compressed when + Data :: iodata(), + Compressed :: binary(). +zip(Data) -> Z = open(), deflateInit(Z, default, deflated, -?MAX_WBITS, 8, default), - Bs = deflate(Z, Binary, finish), + Bs = deflate(Z, Data, finish), deflateEnd(Z), close(Z), - list_to_binary(Bs). + iolist_to_binary(Bs). --spec unzip(binary()) -> binary(). -unzip(Binary) -> +-spec unzip(Data) -> Decompressed when + Data :: iodata(), + Decompressed :: binary(). +unzip(Data) -> Z = open(), inflateInit(Z, -?MAX_WBITS), - Bs = inflate(Z, Binary), + Bs = inflate(Z, Data), inflateEnd(Z), close(Z), - list_to_binary(Bs). + iolist_to_binary(Bs). --spec gzip(iodata()) -> binary(). -gzip(Data) when is_binary(Data); is_list(Data) -> +-spec gzip(Data) -> Compressed when + Data :: iodata(), + Compressed :: binary(). +gzip(Data) -> Z = open(), deflateInit(Z, default, deflated, 16+?MAX_WBITS, 8, default), Bs = deflate(Z, Data, finish), deflateEnd(Z), close(Z), - iolist_to_binary(Bs); -gzip(_) -> erlang:error(badarg). + iolist_to_binary(Bs). --spec gunzip(iodata()) -> binary(). -gunzip(Data) when is_binary(Data); is_list(Data) -> +-spec gunzip(Data) -> Decompressed when + Data :: iodata(), + Decompressed :: binary(). +gunzip(Data) -> Z = open(), inflateInit(Z, 16+?MAX_WBITS), Bs = inflate(Z, Data), inflateEnd(Z), close(Z), - iolist_to_binary(Bs); -gunzip(_) -> erlang:error(badarg). + iolist_to_binary(Bs). -spec collect(zstream()) -> iolist(). collect(Z) -> diff --git a/erts/test/autoimport_SUITE.erl b/erts/test/autoimport_SUITE.erl index 0e4708e046..71ed5204b1 100644 --- a/erts/test/autoimport_SUITE.erl +++ b/erts/test/autoimport_SUITE.erl @@ -87,10 +87,21 @@ autoimports(Config) when is_list(Config) -> xml(XMLFile) -> {ok,File} = file:open(XMLFile,[read]), + xskip_to_funcs(file:read_line(File),File), DocData = xloop(file:read_line(File),File), + true = DocData =/= [], file:close(File), analyze(DocData). +%% Skip lines up to and including the <funcs> tag. +xskip_to_funcs({ok,Line},File) -> + case re:run(Line,"\\<funcs\\>",[{capture,none}]) of + nomatch -> + xskip_to_funcs(file:read_line(File),File); + match -> + ok + end. + xloop({ok,Line},File) -> case re:run(Line,"\\<name\\>",[{capture,none}]) of nomatch -> diff --git a/erts/test/erlc_SUITE.erl b/erts/test/erlc_SUITE.erl index 62e0e6813d..a9e28672e3 100644 --- a/erts/test/erlc_SUITE.erl +++ b/erts/test/erlc_SUITE.erl @@ -79,7 +79,7 @@ compile_erl(Config) when is_list(Config) -> ?line run(Config, Cmd, FileName, "-Werror", ["compile: warnings being treated as errors\$", - "Warning: function foo/0 is unused\$", + "function foo/0 is unused\$", "_ERROR_"]), %% Check a bad file. @@ -213,13 +213,34 @@ deep_cwd_1(PrivDir) -> arg_overflow(Config) when is_list(Config) -> ?line {SrcDir, _OutDir, Cmd} = get_cmd(Config), ?line FileName = filename:join(SrcDir, "erl_test_ok.erl"), - ?line Args = lists:flatten([ ["-D", integer_to_list(N), "=1 "] || - N <- lists:seq(1,10000) ]), + %% Each -D option will be expanded to three arguments when + %% invoking 'erl'. + ?line NumDOptions = num_d_options(), + ?line Args = lists:flatten([ ["-D", integer_to_list(N, 36), "=1 "] || + N <- lists:seq(1, NumDOptions) ]), ?line run(Config, Cmd, FileName, Args, ["Warning: function foo/0 is unused\$", "_OK_"]), ok. +num_d_options() -> + case {os:type(),os:version()} of + {{win32,_},_} -> + %% The maximum size of a command line in the command + %% shell on Windows is 8191 characters. + %% Each -D option is expanded to "@dv NN 1", i.e. + %% 8 characters. (Numbers up to 1295 can be expressed + %% as two 36-base digits.) + 1000; + {{unix,linux},Version} when Version < {2,6,23} -> + %% On some older 64-bit versions of Linux, the maximum number + %% of arguments is 16383. + %% See: http://www.in-ulm.de/~mascheck/various/argmax/ + 5440; + {_,_} -> + 12000 + end. + erlc() -> case os:find_executable("erlc") of false -> diff --git a/erts/vsn.mk b/erts/vsn.mk index 193a914a70..18799d2fba 100644 --- a/erts/vsn.mk +++ b/erts/vsn.mk @@ -17,8 +17,8 @@ # %CopyrightEnd% # -VSN = 5.8.4 -SYSTEM_VSN = R14B03 +VSN = 5.8.5 +SYSTEM_VSN = R14B04 # Port number 4365 in 4.2 # Port number 4366 in 4.3 diff --git a/lib/asn1/doc/src/asn1ct.xml b/lib/asn1/doc/src/asn1ct.xml index 265f8735c2..50458b4a9a 100644 --- a/lib/asn1/doc/src/asn1ct.xml +++ b/lib/asn1/doc/src/asn1ct.xml @@ -53,7 +53,7 @@ <v>Option = ber_bin | per_bin | uper_bin | der | compact_bit_string | noobj | {n2n,EnumTypeName} |{outdir,Dir} | {i,IncludeDir} | optimize | driver | asn1config | undec_rest | {inline,OutputName} | inline | - {macro_name_prefix, Prefix} | {record_name_prefix, Prefix} | verbose</v> + {macro_name_prefix, Prefix} | {record_name_prefix, Prefix} | verbose | warnings_as_errors</v> <v>OldOption = ber | per</v> <v>Reason = term()</v> <v>Prefix = string()</v> @@ -289,6 +289,10 @@ Binary = binary() <p>Causes more verbose information from the compiler describing what it is doing.</p> </item> + <tag><c>warnings_as_errors</c></tag> + <item> + <p>Causes warnings to be treated as errors.</p> + </item> </taglist> <p>Any additional option that is applied will be passed to the final step when the generated .erl file is compiled. diff --git a/lib/asn1/src/asn1ct.erl b/lib/asn1/src/asn1ct.erl index a167d27f82..e26fadd160 100644 --- a/lib/asn1/src/asn1ct.erl +++ b/lib/asn1/src/asn1ct.erl @@ -39,7 +39,7 @@ add_tobe_refed_func/1,add_generated_refed_func/1, maybe_rename_function/3,latest_sindex/0,current_sindex/0, set_current_sindex/1,next_sindex/0,maybe_saved_sindex/2, - parse_and_save/2,verbose/3,warning/3,error/3]). + parse_and_save/2,verbose/3,warning/3,warning/4,error/3]). -include("asn1_records.hrl"). -include_lib("stdlib/include/erl_compile.hrl"). @@ -825,10 +825,13 @@ generate({true,{M,_Module,GenTOrV}},OutFile,EncodingRule,Options) -> case catch specialized_decode_prepare(EncodingRule,M,GenTOrV,Options) of {error, enoent} -> ok; {error, Reason} -> warning("Error in configuration " - "file: ~n~p~n",[Reason],Options); + "file: ~n~p~n",[Reason],Options, + "Error in configuration file"); {'EXIT',Reason} -> warning("Internal error when " "analyzing configuration " - "file: ~n~p~n",[Reason],Options); + "file: ~n~p~n",[Reason],Options, + "Internal error when " + "analyzing configuration"); _ -> ok end, @@ -2524,14 +2527,14 @@ type_check(#'Externaltypereference'{}) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Report functions. %% -%% Errors messages are controlled with the 'errors' compiler option +%% Error messages are controlled with the 'errors' compiler option %% Warning messages are controlled with the 'warnings' compiler option %% Verbose messages are controlled with the 'verbose' compiler option error(Format, Args, S) -> case is_error(S) of true -> - io:format("Error: " ++ Format, Args); + io:format(Format, Args); false -> ok end. @@ -2544,6 +2547,17 @@ warning(Format, Args, S) -> ok end. +warning(Format, Args, S, Reason) -> + case {is_werr(S), is_error(S), is_warning(S)} of + {true, true, _} -> + io:format(Format, Args), + throw({error, Reason}); + {false, _, true} -> + io:format(Format, Args); + _ -> + ok + end. + verbose(Format, Args, S) -> case is_verbose(S) of true -> @@ -2566,3 +2580,8 @@ is_verbose(S) when is_record(S, state) -> is_verbose(S#state.options); is_verbose(O) -> lists:member(verbose, O). + +is_werr(S) when is_record(S, state) -> + is_werr(S#state.options); +is_werr(O) -> + lists:member(warnings_as_errors, O). diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index efd731f052..e318477234 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -2031,7 +2031,7 @@ get_objectset_def2(_S,T = #typedef{typespec=#'ObjectSet'{}},_CField) -> T; get_objectset_def2(S,T,_CField) -> asn1ct:warning("get_objectset_def2: uncontrolled object set structure:~n~p~n", - [T],S). + [T],S,"get_objectset_def2: uncontrolled object set structure"). type_name(S,#type{def=Def}) -> CurrMod = S#state.mname, @@ -2705,7 +2705,7 @@ normalize_value(S,Type,{'DEFAULT',Value},NameList) -> normalize_objectclassfieldvalue(S,Value,NL); Err -> asn1ct:warning("could not check default value ~p~nType:~n~p~nNameList:~n~p~n", - [Value,Type,Err],S), + [Value,Type,Err],S,"could not check default value"), Value end; normalize_value(S,Type,Val,NameList) -> @@ -2791,22 +2791,27 @@ normalize_bitstring(S,Value,Type)-> case catch lists:map(F,RecList) of {error,Reason} -> asn1ct:warning("default value not " - "compatible with type definition ~p~n", - [Reason],S), + "compatible with type definition ~p~n", + [Reason],S, + "default value not " + "compatible with type definition"), Value; NewList -> NewList end; _ -> asn1ct:warning("default value not " - "compatible with type definition ~p~n", - [RecList],S), + "compatible with type definition ~p~n", + [RecList],S, + "default value not " + "compatible with type definition"), Value end; {Name,String} when is_atom(Name) -> normalize_bitstring(S,String,Type); Other -> - asn1ct:warning("illegal default value ~p~n",[Other],S), + asn1ct:warning("illegal default value ~p~n",[Other],S, + "illegal default value"), Value end. @@ -2846,12 +2851,14 @@ normalize_octetstring(S,Value,CType) -> lists:map(fun([])-> ok; (H)when H > 255-> asn1ct:warning("not legal octet value ~p in OCTET STRING, ~p~n", - [H,List],S); + [H,List],S, + "not legal octet value ~p in OCTET STRING"); (_)-> ok end, List), List; Other -> - asn1ct:warning("unknown default value ~p~n",[Other],S), + asn1ct:warning("unknown default value ~p~n",[Other],S, + "unknown default value"), Value end. @@ -2908,13 +2915,15 @@ normalize_enumerated(S,{Name,EnumV},CType) when is_atom(Name) -> normalize_enumerated(S,Value,{CType1,CType2}) when is_list(CType1), is_list(CType2)-> normalize_enumerated(S,Value,CType1++CType2); normalize_enumerated(S,V,CType) -> - asn1ct:warning("Enumerated unknown type ~p~n",[CType],S), + asn1ct:warning("Enumerated unknown type ~p~n",[CType],S, + "Enumerated unknown type"), V. normalize_enumerated2(S,V,Enum) -> case lists:keysearch(V,1,Enum) of {value,{Val,_}} -> Val; _ -> - asn1ct:warning("Enumerated value is not correct ~p~n",[V],S), + asn1ct:warning("enumerated value is not correct ~p~n",[V],S, + "enumerated value is not correct"), V end. @@ -2925,7 +2934,8 @@ normalize_choice(S,{'CHOICE',{C,V}},CType,NameList) when is_atom(C) -> {C,normalize_value(S,CT,{'DEFAULT',V}, [Name|NameList])}; Other -> - asn1ct:warning("Wrong format of type/value ~p/~p~n",[Other,V],S), + asn1ct:warning("Wrong format of type/value ~p/~p~n",[Other,V],S, + "Wrong format of type/value"), {C,V} end; normalize_choice(S,{'DEFAULT',ValueList},CType,NameList) when is_list(ValueList) -> @@ -3101,7 +3111,8 @@ normalize_s_of(SorS,S,Value,Type,NameList) when is_list(Value) -> List when is_list(List) -> List; _ -> - asn1ct:warning("~p could not handle value ~p~n",[SorS,Value],S), + asn1ct:warning("~p could not handle value ~p~n",[SorS,Value],S, + "could not handle value"), Value end; normalize_s_of(SorS,S,Value,Type,NameList) @@ -3159,7 +3170,8 @@ get_normalized_value(S,Val,Type,Func,AddArg) -> V2 = sort_val_if_set(AddArg,NewVal,Type), call_Func(update_state(S,ExtM),V2,Type,Func,AddArg); _ -> - asn1ct:warning("default value not comparable ~p~n",[Val],S), + asn1ct:warning("default value not comparable ~p~n",[Val],S, + "default value not comparable"), Val end. @@ -5756,7 +5768,8 @@ ascending_order_check1(S,TypeName, [C1 = #'ComponentType'{tags=[{_,T}|_]}, C2 = #'ComponentType'{tags=[{_,T}|_]}|Rest]) -> asn1ct:warning("Indistinct tag ~p in SET ~p, components ~p and ~p~n", - [T,TypeName,C1#'ComponentType'.name,C2#'ComponentType'.name],S), + [T,TypeName,C1#'ComponentType'.name,C2#'ComponentType'.name],S, + "Indistinct tag in SET"), ascending_order_check1(S,TypeName,[C2|Rest]); ascending_order_check1(S,TypeName, [C1 = #'ComponentType'{tags=[{'UNIVERSAL',T1}|_]}, @@ -5764,9 +5777,10 @@ ascending_order_check1(S,TypeName, case (decode_type(T1) == decode_type(T2)) of true -> asn1ct:warning("Indistinct tags ~p and ~p in" - " SET ~p, components ~p and ~p~n", - [T1,T2,TypeName,C1#'ComponentType'.name, - C2#'ComponentType'.name],S), + " SET ~p, components ~p and ~p~n", + [T1,T2,TypeName,C1#'ComponentType'.name, + C2#'ComponentType'.name],S, + "Indistinct tags and in SET"), ascending_order_check1(S,TypeName,[C2|Rest]); _ -> ascending_order_check1(S,TypeName,[C2|Rest]) diff --git a/lib/asn1/test/asn1_SUITE.erl.src b/lib/asn1/test/asn1_SUITE.erl.src index 582ccd877c..e7f93a4053 100644 --- a/lib/asn1/test/asn1_SUITE.erl.src +++ b/lib/asn1/test/asn1_SUITE.erl.src @@ -2236,8 +2236,10 @@ test_compile_options(Config) -> ?line ok = test_compile_options:path(Config), ?line ok = test_compile_options:noobj(Config), ?line ok = test_compile_options:record_name_prefix(Config), - ?line ok = test_compile_options:verbose(Config) + ?line ok = test_compile_options:verbose(Config), + ?line ok = test_compile_options:warnings_as_errors(Config) end. + testDoubleEllipses(suite) -> []; testDoubleEllipses(Config) -> ?line testDoubleEllipses:compile(Config,?BER,[]), diff --git a/lib/asn1/test/test_compile_options.erl b/lib/asn1/test/test_compile_options.erl index 5e027cdedb..5cb212eddf 100644 --- a/lib/asn1/test/test_compile_options.erl +++ b/lib/asn1/test/test_compile_options.erl @@ -24,7 +24,7 @@ -export([wrong_path/1,comp/2,path/1,ticket_6143/1,noobj/1, - record_name_prefix/1,verbose/1]). + record_name_prefix/1,verbose/1,warnings_as_errors/1]). %% OTP-5689 wrong_path(Config) -> @@ -141,6 +141,43 @@ verbose(Config) when is_list(Config) -> ?line [] = test_server:capture_get(), ok. +warnings_as_errors(Config) when is_list(Config) -> + PrivDir = ?config(priv_dir,Config), + Asn1File = filename:join([PrivDir,"WERROR.asn1"]), + OutFile = filename:join([PrivDir,"WERROR.erl"]), + Opts = [{outdir,PrivDir},noobj,verbose], + + %% Generate WERR.asn to emit warning + %% Warning: Wrong format of type/value + %% false/{'Externalvaluereference',_,'WERR',noInvokeId} + Warn = <<"WERROR DEFINITIONS IMPLICIT TAGS ::=\n" + "\n" + "BEGIN\n" + "\n" + "InvokeId ::= CHOICE\n" + "{\n" + " present INTEGER,\n" + " absent NULL\n" + "}\n" + "\n" + "noInvokeId InvokeId ::= absent:NULL\n" + "\n" + "NoInvokeId InvokeId ::= {noInvokeId}\n" + "\n" + "END -- end of useful definitions.\n">>, + ?line ok = file:write_file(Asn1File, Warn), + + %% Test warnings_as_errors compile + ?line false = filelib:is_regular(OutFile), + ?line {error, _} = asn1ct:compile(Asn1File, [warnings_as_errors|Opts]), + ?line false = filelib:is_regular(OutFile), + + %% Test normal compile + ?line ok = asn1ct:compile(Asn1File, Opts), + ?line true = filelib:is_regular(OutFile), + ?line ok = file:delete(OutFile), + ok. + outfiles_check(OutDir) -> outfiles_check(OutDir,outfiles1()). diff --git a/lib/common_test/doc/src/common_test_app.xml b/lib/common_test/doc/src/common_test_app.xml index c92566de37..57b032b3fd 100644 --- a/lib/common_test/doc/src/common_test_app.xml +++ b/lib/common_test/doc/src/common_test_app.xml @@ -144,7 +144,7 @@ <v> UserData = term()</v> <v> Conns = [atom()]</v> <v> CSSFile = string()</v> - <v> CTHs = [CTHModule | {CTHModule, CTHInitArgs}]</v> + <v> CTHs = [CTHModule | {CTHModule, CTHInitArgs} | {CTHModule, CTHInitArgs, CTHPriority}]</v> <v> CTHModule = atom()</v> <v> CTHInitArgs = term()</v> </type> diff --git a/lib/common_test/doc/src/ct_hooks.xml b/lib/common_test/doc/src/ct_hooks.xml index 7d5c9f4750..0ece3199bb 100644 --- a/lib/common_test/doc/src/ct_hooks.xml +++ b/lib/common_test/doc/src/ct_hooks.xml @@ -81,12 +81,14 @@ <funcs> <func> - <name>Module:init(Id, Opts) -> State</name> + <name>Module:init(Id, Opts) -> {ok, State} | + {ok, State, Priority}</name> <fsummary>Initiates the Common Test Hook</fsummary> <type> <v>Id = reference() | term()</v> <v>Opts = term()</v> <v>State = term()</v> + <v>Priority = integer()</v> </type> <desc> @@ -103,6 +105,10 @@ if <seealso marker="#Module:id-1">id/1</seealso> is not implemented. </p> + <p><c>Priority</c> is the relative priority of this hook. Hooks with a + lower priority will be executed first. If no priority is given, + it will be set to 0. </p> + <p>For details about when init is called see <seealso marker="ct_hooks_chapter#scope">scope</seealso> in the User's Guide.</p> diff --git a/lib/common_test/doc/src/ct_hooks_chapter.xml b/lib/common_test/doc/src/ct_hooks_chapter.xml index fc5ab48e1b..dbb4310040 100644 --- a/lib/common_test/doc/src/ct_hooks_chapter.xml +++ b/lib/common_test/doc/src/ct_hooks_chapter.xml @@ -94,9 +94,11 @@ <seealso marker="common_test#Module:init_per_group-2"> init_per_group/2</seealso>. <c>CTH</c> in this case can be either only the module name of the CTH or a tuple with the module name and the - initial arguments to the CTH. Eg: + initial arguments and optionally the hook priority of the CTH. Eg: <c>{ct_hooks,[my_cth_module]}</c> or - <c>{ct_hooks,[{my_cth_module,[{debug,true}]}]}</c></p> + <c>{ct_hooks,[{my_cth_module,[{debug,true}]}]}</c> or + <c>{ct_hooks,[{my_cth_module,[{debug,true}],500}]}</c> + </p> <section> <title>Overriding CTHs</title> @@ -109,7 +111,16 @@ <c>id</c> in both places, Common Test knows that this CTH has already been installed and will not try to install it again.</p> </section> - + + <section> + <title>CTH Priority</title> + <p>By default each CTH installed will be executed in the order which + they are installed. This is not always wanted so common_test allows + the user to specify a priority for each hook. The priority can either + be specified in the CTH <seealso marker="ct_hooks#Module:init-2">init/2 + </seealso> function or when installing the hook. The priority given at + installation will override the priority returned by the CTH. </p> + </section> </section> <marker id="scope"/> @@ -331,7 +342,7 @@ id(Opts) -> %% any common state. init(Id, Opts) -> {ok,D} = file:open(Id,[write]), - #state{ file_handle = D, total = 0, data = [] }. + {ok, #state{ file_handle = D, total = 0, data = [] }}. %% @doc Called before init_per_suite is called. pre_init_per_suite(Suite,Config,State) -> diff --git a/lib/common_test/doc/src/run_test_chapter.xml b/lib/common_test/doc/src/run_test_chapter.xml index e6fb85634f..e668568795 100644 --- a/lib/common_test/doc/src/run_test_chapter.xml +++ b/lib/common_test/doc/src/run_test_chapter.xml @@ -488,7 +488,7 @@ LogDir = string() EventHandlers = atom() | [atom()] InitArgs = [term()] - CTHModules = [CTHModule | {CTHModule, CTHInitArgs}] + CTHModules = [CTHModule | {CTHModule, CTHInitArgs} | {CTHModule, CTHInitArgs, CTHPriority}] CTHModule = atom() CTHInitArgs = term() DirRef = DirAlias | Dir diff --git a/lib/common_test/src/ct_framework.erl b/lib/common_test/src/ct_framework.erl index 809616d8e3..9e597edf38 100644 --- a/lib/common_test/src/ct_framework.erl +++ b/lib/common_test/src/ct_framework.erl @@ -240,7 +240,8 @@ add_defaults(Mod,Func,FuncInfo,DoInit) -> case (catch Mod:suite()) of {'EXIT',{undef,_}} -> SuiteInfo = merge_with_suite_defaults(Mod,[]), - case add_defaults1(Mod,Func,FuncInfo,SuiteInfo,DoInit) of + SuiteInfoNoCTH = [I || I <- SuiteInfo, element(1,I) =/= ct_hooks], + case add_defaults1(Mod,Func,FuncInfo,SuiteInfoNoCTH,DoInit) of Error = {error,_} -> {SuiteInfo,Error}; MergedInfo -> {SuiteInfo,MergedInfo} end; @@ -251,10 +252,11 @@ add_defaults(Mod,Func,FuncInfo,DoInit) -> (_) -> false end, SuiteInfo) of true -> - SuiteInfoNoCTH = - lists:keydelete(ct_hooks,1,SuiteInfo), - SuiteInfo1 = merge_with_suite_defaults(Mod,SuiteInfoNoCTH), - case add_defaults1(Mod,Func,FuncInfo,SuiteInfo1,DoInit) of + SuiteInfo1 = merge_with_suite_defaults(Mod,SuiteInfo), + SuiteInfoNoCTH = [I || I <- SuiteInfo1, + element(1,I) =/= ct_hooks], + case add_defaults1(Mod,Func,FuncInfo, + SuiteInfoNoCTH,DoInit) of Error = {error,_} -> {SuiteInfo1,Error}; MergedInfo -> {SuiteInfo1,MergedInfo} end; diff --git a/lib/common_test/src/ct_hooks.erl b/lib/common_test/src/ct_hooks.erl index 984e04b90f..f243b87f54 100644 --- a/lib/common_test/src/ct_hooks.erl +++ b/lib/common_test/src/ct_hooks.erl @@ -31,11 +31,11 @@ -export([on_tc_skip/2]). -export([on_tc_fail/2]). --type proplist() :: [{atom(),term()}]. - %% If you change this, remember to update ct_util:look -> stop clause as well. -define(config_name, ct_hooks). +-record(ct_hook_config, {id, module, prio, scope, opts = [], state = []}). + %% ------------------------------------------------------------------------- %% API Functions %% ------------------------------------------------------------------------- @@ -44,22 +44,22 @@ -spec init(State :: term()) -> ok | {error, Reason :: term()}. init(Opts) -> - call([{Hook, call_id, undefined} || Hook <- get_new_hooks(Opts)], - ok, init, []). + call(get_new_hooks(Opts, undefined), ok, init, []). %% @doc Called after all suites are done. -spec terminate(Hooks :: term()) -> ok. terminate(Hooks) -> - call([{HookId, fun call_terminate/3} || {HookId,_,_} <- Hooks], + call([{HookId, fun call_terminate/3} + || #ct_hook_config{id = HookId} <- Hooks], ct_hooks_terminate_dummy, terminate, Hooks), ok. %% @doc Called as each test case is started. This includes all configuration %% tests. -spec init_tc(Mod :: atom(), Func :: atom(), Args :: list()) -> - NewConfig :: proplist() | + NewConfig :: proplists:proplist() | {skip, Reason :: term()} | {auto_skip, Reason :: term()} | {fail, Reason :: term()}. @@ -68,11 +68,11 @@ init_tc(ct_framework, _Func, Args) -> init_tc(Mod, init_per_suite, Config) -> Info = try proplists:get_value(ct_hooks, Mod:suite(),[]) of List when is_list(List) -> - [{ct_hooks,List}]; + [{?config_name,List}]; CTHook when is_atom(CTHook) -> - [{ct_hooks,[CTHook]}] + [{?config_name,[CTHook]}] catch error:undef -> - [{ct_hooks,[]}] + [{?config_name,[]}] end, call(fun call_generic/3, Config ++ Info, [pre_init_per_suite, Mod]); init_tc(Mod, end_per_suite, Config) -> @@ -92,7 +92,7 @@ init_tc(_Mod, TC, Config) -> Args :: list(), Result :: term(), Resturn :: term()) -> - NewConfig :: proplist() | + NewConfig :: proplists:proplist() | {skip, Reason :: term()} | {auto_skip, Reason :: term()} | {fail, Reason :: term()} | @@ -131,36 +131,48 @@ on_tc_fail(_How, {Suite, Case, Reason}) -> %% ------------------------------------------------------------------------- %% Internal Functions %% ------------------------------------------------------------------------- -call_id(Mod, Config, Meta) when is_atom(Mod) -> - call_id({Mod, []}, Config, Meta); -call_id({Mod, Opts}, Config, Scope) -> +call_id(#ct_hook_config{ module = Mod, opts = Opts} = Hook, Config, Scope) -> Id = catch_apply(Mod,id,[Opts], make_ref()), - {Config, {Id, scope(Scope), {Mod, {Id,Opts}}}}. + {Config, Hook#ct_hook_config{ id = Id, scope = scope(Scope)}}. -call_init({Mod,{Id,Opts}},Config,_Meta) -> - NewState = Mod:init(Id, Opts), - {Config, {Mod, NewState}}. - -call_terminate({Mod, State}, _, _) -> +call_init(#ct_hook_config{ module = Mod, opts = Opts, id = Id, prio = P} = Hook, + Config,_Meta) -> + case Mod:init(Id, Opts) of + {ok, NewState} when P =:= undefined -> + {Config, Hook#ct_hook_config{ state = NewState, prio = 0 } }; + {ok, NewState} -> + {Config, Hook#ct_hook_config{ state = NewState } }; + {ok, NewState, Prio} when P =:= undefined -> + %% Only set prio if not already set when installing hook + {Config, Hook#ct_hook_config{ state = NewState, prio = Prio } }; + {ok, NewState, _} -> + {Config, Hook#ct_hook_config{ state = NewState } }; + NewState -> %% Keep for backward compatability reasons + {Config, Hook#ct_hook_config{ state = NewState } } + end. + +call_terminate(#ct_hook_config{ module = Mod, state = State} = Hook, _, _) -> catch_apply(Mod,terminate,[State], ok), - {[],{Mod,State}}. + {[],Hook}. -call_cleanup({Mod, State}, Reason, [Function, _Suite | Args]) -> +call_cleanup(#ct_hook_config{ module = Mod, state = State} = Hook, + Reason, [Function, _Suite | Args]) -> NewState = catch_apply(Mod,Function, Args ++ [Reason, State], State), - {Reason, {Mod, NewState}}. + {Reason, Hook#ct_hook_config{ state = NewState } }. -call_generic({Mod, State}, Value, [Function | Args]) -> +call_generic(#ct_hook_config{ module = Mod, state = State} = Hook, + Value, [Function | Args]) -> {NewValue, NewState} = catch_apply(Mod, Function, Args ++ [Value, State], {Value,State}), - {NewValue, {Mod, NewState}}. + {NewValue, Hook#ct_hook_config{ state = NewState } }. %% Generic call function call(Fun, Config, Meta) -> maybe_lock(), Hooks = get_hooks(), - Res = call([{HookId,Fun} || {HookId,_, _} <- Hooks] ++ - get_new_hooks(Config, Fun), + Res = call(get_new_hooks(Config, Fun) ++ + [{HookId,Fun} || #ct_hook_config{id = HookId} <- Hooks], remove(?config_name,Config), Meta, Hooks), maybe_unlock(), Res. @@ -173,19 +185,20 @@ call(Fun, Config, Meta, NoChangeRet) when is_function(Fun) -> call([{Hook, call_id, NextFun} | Rest], Config, Meta, Hooks) -> try - {Config, {NewId, _, _} = NewHook} = call_id(Hook, Config, Meta), + {Config, #ct_hook_config{ id = NewId } = NewHook} = + call_id(Hook, Config, Meta), {NewHooks, NewRest} = - case lists:keyfind(NewId, 1, Hooks) of + case lists:keyfind(NewId, #ct_hook_config.id, Hooks) of false when NextFun =:= undefined -> {Hooks ++ [NewHook], - [{NewId, fun call_init/3} | Rest]}; + [{NewId, call_init} | Rest]}; ExistingHook when is_tuple(ExistingHook) -> {Hooks, Rest}; _ -> {Hooks ++ [NewHook], - [{NewId, fun call_init/3},{NewId,NextFun} | Rest]} + [{NewId, call_init}, {NewId,NextFun} | Rest]} end, - call(NewRest, Config, Meta, NewHooks) + call(resort(NewRest,NewHooks), Config, Meta, NewHooks) catch Error:Reason -> Trace = erlang:get_stacktrace(), ct_logs:log("Suite Hook","Failed to start a CTH: ~p:~p", @@ -193,13 +206,16 @@ call([{Hook, call_id, NextFun} | Rest], Config, Meta, Hooks) -> call([], {fail,"Failed to start CTH" ", see the CT Log for details"}, Meta, Hooks) end; +call([{HookId, call_init} | Rest], Config, Meta, Hooks) -> + call([{HookId, fun call_init/3} | Rest], Config, Meta, Hooks); call([{HookId, Fun} | Rest], Config, Meta, Hooks) -> try - {_,Scope,ModState} = lists:keyfind(HookId, 1, Hooks), - {NewConf, NewHookInfo} = Fun(ModState, Config, Meta), + Hook = lists:keyfind(HookId, #ct_hook_config.id, Hooks), + {NewConf, NewHook} = Fun(Hook, Config, Meta), NewCalls = get_new_hooks(NewConf, Fun), - NewHooks = lists:keyreplace(HookId, 1, Hooks, {HookId, Scope, NewHookInfo}), - call(NewCalls ++ Rest, remove(?config_name, NewConf), Meta, + NewHooks = lists:keyreplace(HookId, #ct_hook_config.id, Hooks, NewHook), + call(resort(NewCalls ++ Rest,NewHooks), %% Resort if call_init changed prio + remove(?config_name, NewConf), Meta, terminate_if_scope_ends(HookId, Meta, NewHooks)) catch throw:{error_in_cth_call,Reason} -> call(Rest, {fail, Reason}, Meta, @@ -237,19 +253,26 @@ terminate_if_scope_ends(HookId, [on_tc_skip,Suite,end_per_suite], Hooks) -> terminate_if_scope_ends(HookId, [Function,Tag|T], Hooks) when T =/= [] -> terminate_if_scope_ends(HookId,[Function,Tag],Hooks); terminate_if_scope_ends(HookId, Function, Hooks) -> - case lists:keyfind(HookId, 1, Hooks) of - {HookId, Function, _ModState} = Hook -> + case lists:keyfind(HookId, #ct_hook_config.id, Hooks) of + #ct_hook_config{ id = HookId, scope = Function} = Hook -> terminate([Hook]), - lists:keydelete(HookId, 1, Hooks); + lists:keydelete(HookId, #ct_hook_config.id, Hooks); _ -> Hooks end. %% Fetch hook functions get_new_hooks(Config, Fun) -> - lists:foldl(fun(NewHook, Acc) -> - [{NewHook, call_id, Fun} | Acc] - end, [], get_new_hooks(Config)). + lists:map(fun(NewHook) when is_atom(NewHook) -> + {#ct_hook_config{ module = NewHook }, call_id, Fun}; + ({NewHook,Opts}) -> + {#ct_hook_config{ module = NewHook, + opts = Opts}, call_id, Fun}; + ({NewHook,Opts,Prio}) -> + {#ct_hook_config{ module = NewHook, + opts = Opts, + prio = Prio }, call_id, Fun} + end, get_new_hooks(Config)). get_new_hooks(Config) when is_list(Config) -> lists:flatmap(fun({?config_name, HookConfigs}) -> @@ -264,7 +287,43 @@ save_suite_data_async(Hooks) -> ct_util:save_suite_data_async(?config_name, Hooks). get_hooks() -> - ct_util:read_suite_data(?config_name). + lists:keysort(#ct_hook_config.prio,ct_util:read_suite_data(?config_name)). + +%% Sort all calls in this order: +%% call_id < call_init < Hook Priority 1 < .. < Hook Priority N +%% If Hook Priority is equal, check when it has been installed and +%% sort on that instead. +resort(Calls, Hooks) -> + lists:sort( + fun({_,_,_},_) -> + true; + (_,{_,_,_}) -> + false; + ({_,call_init},_) -> + true; + (_,{_,call_init}) -> + false; + ({Id1,_},{Id2,_}) -> + P1 = (lists:keyfind(Id1, #ct_hook_config.id, Hooks))#ct_hook_config.prio, + P2 = (lists:keyfind(Id2, #ct_hook_config.id, Hooks))#ct_hook_config.prio, + if + P1 == P2 -> + %% If priorities are equal, we check the position in the + %% hooks list + pos(Id1,Hooks) < pos(Id2,Hooks); + true -> + P1 < P2 + end + end,Calls). + +pos(Id,Hooks) -> + pos(Id,Hooks,0). +pos(Id,[#ct_hook_config{ id = Id}|_],Num) -> + Num; +pos(Id,[_|Rest],Num) -> + pos(Id,Rest,Num+1). + + catch_apply(M,F,A, Default) -> try diff --git a/lib/common_test/src/ct_run.erl b/lib/common_test/src/ct_run.erl index c01e97b358..877ec9c7dd 100644 --- a/lib/common_test/src/ct_run.erl +++ b/lib/common_test/src/ct_run.erl @@ -521,8 +521,8 @@ script_usage() -> "\n\t[-silent_connections [ConnType1 ConnType2 .. ConnTypeN]]" "\n\t[-stylesheet CSSFile]" "\n\t[-cover CoverCfgFile]" - "\n\t[-event_handler EvHandler1 EvHandler2 .. EvHandlerN]" - "\n\t[-ct_hooks CTHook1 CTHook2 .. CTHookN]" + "\n\t[-event_handler EvHandler1 and EvHandler2 .. EvHandlerN]" + "\n\t[-ct_hooks CTHook1 and CTHook2 .. CTHookN]" "\n\t[-include InclDir1 InclDir2 .. InclDirN]" "\n\t[-no_auto_compile]" "\n\t[-multiply_timetraps N]" @@ -540,8 +540,8 @@ script_usage() -> "\n\t[-silent_connections [ConnType1 ConnType2 .. ConnTypeN]]" "\n\t[-stylesheet CSSFile]" "\n\t[-cover CoverCfgFile]" - "\n\t[-event_handler EvHandler1 EvHandler2 .. EvHandlerN]" - "\n\t[-ct_hooks CTHook1 CTHook2 .. CTHookN]" + "\n\t[-event_handler EvHandler1 and EvHandler2 .. EvHandlerN]" + "\n\t[-ct_hooks CTHook1 and CTHook2 .. CTHookN]" "\n\t[-include InclDir1 InclDir2 .. InclDirN]" "\n\t[-no_auto_compile]" "\n\t[-multiply_timetraps N]" @@ -2070,15 +2070,21 @@ ct_hooks_args2opts(Args) -> ct_hooks_args2opts( proplists:get_value(ct_hooks, Args, []),[]). +ct_hooks_args2opts([CTH,Arg,Prio,"and"| Rest],Acc) -> + ct_hooks_args2opts(Rest,[{list_to_atom(CTH), + parse_cth_args(Arg), + parse_cth_args(Prio)}|Acc]); ct_hooks_args2opts([CTH,Arg,"and"| Rest],Acc) -> ct_hooks_args2opts(Rest,[{list_to_atom(CTH), - parse_cth_args(Arg)}|Acc]); + parse_cth_args(Arg)}|Acc]); ct_hooks_args2opts([CTH], Acc) -> ct_hooks_args2opts([CTH,"and"],Acc); ct_hooks_args2opts([CTH, "and" | Rest], Acc) -> ct_hooks_args2opts(Rest,[list_to_atom(CTH)|Acc]); ct_hooks_args2opts([CTH, Args], Acc) -> ct_hooks_args2opts([CTH, Args, "and"],Acc); +ct_hooks_args2opts([CTH, Args, Prio], Acc) -> + ct_hooks_args2opts([CTH, Args, Prio, "and"],Acc); ct_hooks_args2opts([],Acc) -> lists:reverse(Acc). @@ -2225,7 +2231,14 @@ opts2args(EnvStartOpts) -> ({ct_hooks,CTHs}) when is_list(CTHs) -> io:format(user,"ct_hooks: ~p",[CTHs]), Strs = lists:flatmap( - fun({CTH,Arg}) -> + fun({CTH,Arg,Prio}) -> + [atom_to_list(CTH), + lists:flatten( + io_lib:format("~p",[Arg])), + lists:flatten( + io_lib:format("~p",[Prio])), + "and"]; + ({CTH,Arg}) -> [atom_to_list(CTH), lists:flatten( io_lib:format("~p",[Arg])), diff --git a/lib/common_test/test/ct_hooks_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE.erl index 8574d7aabc..5c99f0f9f7 100644 --- a/lib/common_test/test/ct_hooks_SUITE.erl +++ b/lib/common_test/test/ct_hooks_SUITE.erl @@ -83,7 +83,7 @@ all(suite) -> fail_post_suite_cth, skip_pre_suite_cth, skip_post_suite_cth, recover_post_suite_cth, update_config_cth, state_update_cth, options_cth, same_id_cth, - fail_n_skip_with_minimal_cth + fail_n_skip_with_minimal_cth, prio_cth ] ) . @@ -209,6 +209,11 @@ fail_n_skip_with_minimal_cth(Config) when is_list(Config) -> do_test(fail_n_skip_with_minimal_cth, "ct_cth_fail_one_skip_one_SUITE.erl", [minimal_terminate_cth],Config). +prio_cth(Config) when is_list(Config) -> + do_test(prio_cth, "ct_cth_prio_SUITE.erl", + [{empty_cth,[1000],1000},{empty_cth,[900],900}, + {prio_cth,[1100,100],100},{prio_cth,[1100]}],Config). + %%%----------------------------------------------------------------- %%% HELP FUNCTIONS %%%----------------------------------------------------------------- @@ -296,9 +301,9 @@ test_events(two_empty_cth) -> {?eh,start_logging,{'DEF','RUNDIR'}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, {?eh,cth,{'_',id,[[]]}}, - {?eh,cth,{'_',init,['_',[]]}}, {?eh,cth,{'_',id,[[]]}}, {?eh,cth,{'_',init,['_',[]]}}, + {?eh,cth,{'_',init,['_',[]]}}, {?eh,tc_start,{ct_cth_empty_SUITE,init_per_suite}}, {?eh,cth,{'_',pre_init_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}}, {?eh,cth,{'_',pre_init_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}}, @@ -365,9 +370,9 @@ test_events(minimal_and_maximal_cth) -> [ {?eh,start_logging,{'DEF','RUNDIR'}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{'_',id,[[]]}}, {negative,{?eh,cth,{'_',id,['_',[]]}}, {?eh,cth,{'_',init,['_',[]]}}}, - {?eh,cth,{'_',id,[[]]}}, {?eh,cth,{'_',init,['_',[]]}}, {?eh,tc_start,{ct_cth_empty_SUITE,init_per_suite}}, {?eh,cth,{'_',pre_init_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}}, @@ -954,8 +959,8 @@ test_events(same_id_cth) -> {?eh,start_logging,{'DEF','RUNDIR'}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, {?eh,cth,{'_',id,[[]]}}, - {?eh,cth,{'_',init,[same_id_cth,[]]}}, {?eh,cth,{'_',id,[[]]}}, + {?eh,cth,{'_',init,[same_id_cth,[]]}}, {?eh,tc_start,{ct_cth_empty_SUITE,init_per_suite}}, {?eh,cth,{'_',pre_init_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}}, {negative, @@ -1001,6 +1006,73 @@ test_events(fail_n_skip_with_minimal_cth) -> {?eh,stop_logging,[]} ]; +test_events(prio_cth) -> + + GenPre = fun(Func,States) -> + [{?eh,cth,{'_',Func,['_','_',State]}} || + State <- States] + end, + + GenPost = fun(Func,States) -> + [{?eh,cth,{'_',Func,['_','_','_',State]}} || + State <- States] + end, + + [{?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}] ++ + + [{?eh,tc_start,{ct_cth_prio_SUITE,init_per_suite}}] ++ + GenPre(pre_init_per_suite, + [[1100,100],[800],[900],[1000],[1200,1050],[1100],[1200]]) ++ + GenPost(post_init_per_suite, + [[1100,100],[600,200],[600,600],[700],[800],[900],[1000], + [1200,1050],[1100],[1200]]) ++ + [{?eh,tc_done,{ct_cth_prio_SUITE,init_per_suite,ok}}, + + + [{?eh,tc_start,{ct_cth_prio_SUITE,{init_per_group,'_',[]}}}] ++ + GenPre(pre_init_per_group, + [[1100,100],[600,200],[600,600],[700],[800], + [900],[1000],[1200,1050],[1100],[1200]]) ++ + GenPost(post_init_per_group, + [[1100,100],[600,200],[600,600],[600],[700],[800], + [900],[900,900],[500,900],[1000],[1200,1050], + [1100],[1200]]) ++ + [{?eh,tc_done,{ct_cth_prio_SUITE,{init_per_group,'_',[]},ok}}] ++ + + [{?eh,tc_start,{ct_cth_prio_SUITE,test_case}}] ++ + GenPre(pre_init_per_testcase, + [[1100,100],[600,200],[600,600],[600],[700],[800], + [900],[900,900],[500,900],[1000],[1200,1050], + [1100],[1200]]) ++ + GenPost(post_end_per_testcase, + [[1100,100],[600,200],[600,600],[600],[700],[800], + [900],[900,900],[500,900],[1000],[1200,1050], + [1100],[1200]]) ++ + [{?eh,tc_done,{ct_cth_prio_SUITE,test_case,ok}}, + + {?eh,tc_start,{ct_cth_prio_SUITE,{end_per_group,'_',[]}}}] ++ + GenPre(pre_end_per_group, + [[1100,100],[600,200],[600,600],[600],[700],[800], + [900],[900,900],[500,900],[1000],[1200,1050], + [1100],[1200]]) ++ + GenPost(post_end_per_group, + [[1100,100],[600,200],[600,600],[600],[700],[800], + [900],[900,900],[500,900],[1000],[1200,1050], + [1100],[1200]]) ++ + [{?eh,tc_done,{ct_cth_prio_SUITE,{end_per_group,'_',[]},ok}}], + + {?eh,tc_start,{ct_cth_prio_SUITE,end_per_suite}}] ++ + GenPre(pre_end_per_suite, + [[1100,100],[600,200],[600,600],[700],[800],[900],[1000], + [1200,1050],[1100],[1200]]) ++ + GenPost(post_end_per_suite, + [[1100,100],[600,200],[600,600],[700],[800],[900],[1000], + [1200,1050],[1100],[1200]]) ++ + [{?eh,tc_done,{ct_cth_prio_SUITE,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}]; + test_events(ok) -> ok. diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_cth_prio_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_cth_prio_SUITE.erl new file mode 100644 index 0000000000..d564398cd0 --- /dev/null +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_cth_prio_SUITE.erl @@ -0,0 +1,62 @@ +%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2011. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(ct_cth_prio_SUITE).
+
+%% Note: This directive should only be used in test suites.
+-compile(export_all).
+
+-include("ct.hrl").
+
+suite() ->
+ ([{timetrap, {minutes, 10}},
+ {ct_hooks, [{empty_cth,[800],800},
+ {prio_cth,[1200]},{prio_cth,[1200,1050],1050}]}]).
+
+%% Test server callback functions
+init_per_suite(Config) ->
+ [{ct_hooks, [{empty_cth,[700],700},
+ {prio_cth,[600,600]},
+ {prio_cth,[600,200],200}]}|Config].
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_G, Config) ->
+ [{ct_hooks, [{empty_cth,[600],600},
+ {prio_cth,[900,900]},{prio_cth,[500,900],900}]}|Config].
+
+end_per_group(_G, _Config) ->
+ ok.
+
+init_per_testcase(_TestCase, Config) ->
+ Config.
+
+end_per_testcase(_TestCase, _Config) ->
+ ok.
+
+all() ->
+ [{group,test_group}].
+
+groups() ->
+ [{test_group,[],[test_case]}].
+
+%% Test cases starts here.
+test_case(Config) when is_list(Config) ->
+ ok.
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/empty_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/empty_cth.erl index ebebfd18a9..7befcfa57c 100644 --- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/empty_cth.erl +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/empty_cth.erl @@ -59,8 +59,7 @@ -include_lib("common_test/src/ct_util.hrl").
-include_lib("common_test/include/ct_event.hrl").
--type proplist() :: list({atom(),term()}).
--type config() :: proplist().
+-type config() :: proplists:proplist(). -type reason() :: term().
-type skip_or_fail() :: {skip, reason()} |
{auto_skip, reason()} |
@@ -71,17 +70,17 @@ %% @doc Always called before any other callback function. Use this to initiate
%% any common state. It should return an state for this CTH.
--spec init(Id :: term(), Opts :: proplist()) ->
- State :: #state{}.
+-spec init(Id :: term(), Opts :: proplists:proplist()) -> + {ok, State :: #state{}}.
init(Id, Opts) ->
gen_event:notify(?CT_EVMGR_REF, #event{ name = cth, node = node(),
data = {?MODULE, init, [Id, Opts]}}),
- Opts.
+ {ok,Opts}.
%% @doc The ID is used to uniquly identify an CTH instance, if two CTH's
%% return the same ID the seconds CTH is ignored. This function should NOT
%% have any side effects as it might be called multiple times by common test.
--spec id(Opts :: proplist()) ->
+-spec id(Opts :: proplists:proplist()) -> Id :: term().
id(Opts) ->
gen_event:notify(?CT_EVMGR_REF, #event{ name = cth, node = node(),
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/prio_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/prio_cth.erl new file mode 100644 index 0000000000..82511ab0d3 --- /dev/null +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/prio_cth.erl @@ -0,0 +1,74 @@ +%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2011. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+
+-module(prio_cth).
+
+
+-include_lib("common_test/src/ct_util.hrl").
+
+
+%% CT Hooks
+-compile(export_all).
+
+id(Opts) ->
+ empty_cth:id(Opts).
+
+init(Id, Opts) ->
+ {ok, [Prio|_] = State} = empty_cth:init(Id, Opts),
+ {ok, State, Prio}.
+
+pre_init_per_suite(Suite, Config, State) ->
+ empty_cth:pre_init_per_suite(Suite,Config,State).
+
+post_init_per_suite(Suite,Config,Return,State) ->
+ empty_cth:post_init_per_suite(Suite,Config,Return,State).
+
+pre_end_per_suite(Suite,Config,State) ->
+ empty_cth:pre_end_per_suite(Suite,Config,State).
+
+post_end_per_suite(Suite,Config,Return,State) ->
+ empty_cth:post_end_per_suite(Suite,Config,Return,State).
+
+pre_init_per_group(Group,Config,State) ->
+ empty_cth:pre_init_per_group(Group,Config,State).
+
+post_init_per_group(Group,Config,Return,State) ->
+ empty_cth:post_init_per_group(Group,Config,Return,State).
+
+pre_end_per_group(Group,Config,State) ->
+ empty_cth:pre_end_per_group(Group,Config,State).
+
+post_end_per_group(Group,Config,Return,State) ->
+ empty_cth:post_end_per_group(Group,Config,Return,State).
+
+pre_init_per_testcase(TC,Config,State) ->
+ empty_cth:pre_init_per_testcase(TC,Config,State).
+
+post_end_per_testcase(TC,Config,Return,State) ->
+ empty_cth:post_end_per_testcase(TC,Config,Return,State).
+
+on_tc_fail(TC, Reason, State) ->
+ empty_cth:on_tc_fail(TC,Reason,State).
+
+on_tc_skip(TC, Reason, State) ->
+ empty_cth:on_tc_skip(TC,Reason,State).
+
+terminate(State) ->
+ empty_cth:terminate(State).
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/state_update_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/state_update_cth.erl index 35c990c0be..9da48d3a4c 100644 --- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/state_update_cth.erl +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/state_update_cth.erl @@ -29,7 +29,7 @@ init(Id, Opts) ->
State = empty_cth:init(Id, Opts),
- [init|State].
+ {ok, [init|State]}.
pre_init_per_suite(Suite, Config, State) ->
empty_cth:pre_init_per_suite(Suite,Config,State),
diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index ce8a5bf864..e46c667e47 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -113,7 +113,7 @@ noenv_forms(Forms, Opt) when is_atom(Opt) -> noenv_output_generated(Opts) -> {_,Passes} = passes(file, expand_opts(Opts)), - any(fun ({save_binary,_F}) -> true; + any(fun ({save_binary,_T,_F}) -> true; (_Other) -> false end, Passes). @@ -122,6 +122,7 @@ noenv_output_generated(Opts) -> %% -define(pass(P), {P,fun P/1}). +-define(pass(P,T), {P,fun T/1,fun P/1}). env_default_opts() -> Key = "ERL_COMPILER_OPTIONS", @@ -304,7 +305,7 @@ run_tc({Name,Fun}, St) -> Val. comp_ret_ok(#compile{code=Code,warnings=Warn0,module=Mod,options=Opts}=St) -> - case member(warnings_as_errors, Opts) andalso length(Warn0) > 0 of + case werror(St) of true -> case member(report_warnings, Opts) of true -> @@ -339,6 +340,11 @@ comp_ret_err(#compile{warnings=Warn0,errors=Err0,options=Opts}=St) -> false -> error end. +not_werror(St) -> not werror(St). + +werror(#compile{options=Opts,warnings=Ws}) -> + Ws =/= [] andalso member(warnings_as_errors, Opts). + %% messages_per_file([{File,[Message]}]) -> [{File,[Message]}] messages_per_file(Ms) -> T = lists:sort([{File,M} || {File,Messages} <- Ms, M <- Messages]), @@ -373,7 +379,7 @@ passes(Type, Opts) -> %% insert a first pass to remove the file (unless the %% source file is a BEAM file). {Ext,case last(Passes) of - {save_binary,_Fun} -> + {save_binary,_TestFun,_Fun} -> case Passes of [{read_beam_file,_}|_] -> %% The BEAM is both input and output. @@ -655,7 +661,7 @@ asm_passes() -> binary_passes() -> [{native_compile,fun test_native/1,fun native_compile/1}, - {unless,binary,?pass(save_binary)}]. + {unless,binary,?pass(save_binary,not_werror)}]. %%% %%% Compiler passes. @@ -1379,28 +1385,34 @@ report_errors(#compile{options=Opts,errors=Errors}) -> end. report_warnings(#compile{options=Opts,warnings=Ws0}) -> - case member(report_warnings, Opts) of + Werror = member(warnings_as_errors, Opts), + P = case Werror of + true -> ""; + false -> "Warning: " + end, + ReportWerror = Werror andalso member(report_errors, Opts), + case member(report_warnings, Opts) orelse ReportWerror of true -> - Ws1 = flatmap(fun({{F,_L},Eds}) -> format_message(F, Eds); - ({F,Eds}) -> format_message(F, Eds) end, + Ws1 = flatmap(fun({{F,_L},Eds}) -> format_message(F, P, Eds); + ({F,Eds}) -> format_message(F, P, Eds) end, Ws0), Ws = lists:sort(Ws1), foreach(fun({_,Str}) -> io:put_chars(Str) end, Ws); false -> ok end. -format_message(F, [{{Line,Column}=Loc,Mod,E}|Es]) -> - M = {{F,Loc},io_lib:format("~s:~w:~w Warning: ~s\n", - [F,Line,Column,Mod:format_error(E)])}, - [M|format_message(F, Es)]; -format_message(F, [{Line,Mod,E}|Es]) -> - M = {{F,{Line,0}},io_lib:format("~s:~w: Warning: ~s\n", - [F,Line,Mod:format_error(E)])}, - [M|format_message(F, Es)]; -format_message(F, [{Mod,E}|Es]) -> - M = {none,io_lib:format("~s: Warning: ~s\n", [F,Mod:format_error(E)])}, - [M|format_message(F, Es)]; -format_message(_, []) -> []. +format_message(F, P, [{{Line,Column}=Loc,Mod,E}|Es]) -> + M = {{F,Loc},io_lib:format("~s:~w:~w ~s~s\n", + [F,Line,Column,P,Mod:format_error(E)])}, + [M|format_message(F, P, Es)]; +format_message(F, P, [{Line,Mod,E}|Es]) -> + M = {{F,{Line,0}},io_lib:format("~s:~w: ~s~s\n", + [F,Line,P,Mod:format_error(E)])}, + [M|format_message(F, P, Es)]; +format_message(F, P, [{Mod,E}|Es]) -> + M = {none,io_lib:format("~s: ~s~s\n", [F,P,Mod:format_error(E)])}, + [M|format_message(F, P, Es)]; +format_message(_, _, []) -> []. %% list_errors(File, ErrorDescriptors) -> ok diff --git a/lib/compiler/src/sys_pre_expand.erl b/lib/compiler/src/sys_pre_expand.erl index 480954adac..dd6f24e21f 100644 --- a/lib/compiler/src/sys_pre_expand.erl +++ b/lib/compiler/src/sys_pre_expand.erl @@ -223,10 +223,8 @@ attribute(export, Es, _L, St) -> St#expand{exports=union(from_list(Es), St#expand.exports)}; attribute(import, Is, _L, St) -> import(Is, St); -attribute(compile, C, _L, St) when is_list(C) -> - St#expand{compile=St#expand.compile ++ C}; -attribute(compile, C, _L, St) -> - St#expand{compile=St#expand.compile ++ [C]}; +attribute(compile, _C, _L, St) -> + St; attribute(Name, Val, Line, St) when is_list(Val) -> St#expand{attributes=St#expand.attributes ++ [{Name,Line,Val}]}; attribute(Name, Val, Line, St) -> diff --git a/lib/compiler/test/error_SUITE.erl b/lib/compiler/test/error_SUITE.erl index 6e0aadf007..eb5e50818e 100644 --- a/lib/compiler/test/error_SUITE.erl +++ b/lib/compiler/test/error_SUITE.erl @@ -183,23 +183,47 @@ get_compilation_errors(Config, Filename) -> E. warnings_as_errors(Config) when is_list(Config) -> - Ts = [{warnings_as_errors, + ?line TestFile = test_filename(Config), + ?line BeamFile = filename:rootname(TestFile, ".erl") ++ ".beam", + ?line OutDir = ?config(priv_dir, Config), + + Ts1 = [{warnings_as_errors, <<" t() -> A = unused, ok. ">>, - [export_all,warnings_as_errors], - {error, - [], - [{3,erl_lint,{unused_var,'A'}}]} }], - ?line [] = run(Config, Ts), + [warnings_as_errors, export_all, {outdir, OutDir}], + {error, + [], + [{3,erl_lint,{unused_var,'A'}}]} }], + ?line [] = run(Ts1, TestFile, write_beam), + ?line false = filelib:is_regular(BeamFile), + + Ts2 = [{warning_unused_var, + <<" + t() -> + A = unused, + ok. + ">>, + [return_warnings, export_all, {outdir, OutDir}], + {warning, + [{3,erl_lint,{unused_var,'A'}}]} }], + + ?line [] = run(Ts2, TestFile, write_beam), + ?line true = filelib:is_regular(BeamFile), + ?line ok = file:delete(BeamFile), + ok. run(Config, Tests) -> + ?line File = test_filename(Config), + run(Tests, File, dont_write_beam). + +run(Tests, File, WriteBeam) -> F = fun({N,P,Ws,E}, BadL) -> - case catch run_test(Config, P, Ws) of + case catch run_test(P, File, Ws, WriteBeam) of E -> BadL; Bad -> @@ -211,8 +235,12 @@ run(Config, Tests) -> lists:foldl(F, [], Tests). run2(Config, Tests) -> + ?line File = test_filename(Config), + run2(Tests, File, dont_write_beam). + +run2(Tests, File, WriteBeam) -> F = fun({N,P,Ws,E}, BadL) -> - case catch filter(run_test(Config, P, Ws)) of + case catch filter(run_test(P, File, Ws, WriteBeam)) of E -> BadL; Bad -> @@ -231,12 +259,19 @@ filter(X) -> %% Compiles a test module and returns the list of errors and warnings. -run_test(Conf, Test0, Warnings) -> - Filename = 'errors_test.erl', - ?line DataDir = ?config(priv_dir, Conf), +test_filename(Conf) -> + Filename = "errors_test.erl", + DataDir = ?config(priv_dir, Conf), + filename:join(DataDir, Filename). + +run_test(Test0, File, Warnings, WriteBeam) -> ?line Test = ["-module(errors_test). ", Test0], - ?line File = filename:join(DataDir, Filename), - ?line Opts = [binary,return_errors|Warnings], + ?line Opts = case WriteBeam of + dont_write_beam -> + [binary,return_errors|Warnings]; + write_beam -> + [return_errors|Warnings] + end, ?line ok = file:write_file(File, Test), %% Compile once just to print all errors and warnings. @@ -252,6 +287,10 @@ run_test(Conf, Test0, Warnings) -> %io:format("compile:file(~s,~p) ->~n~p~n", % [File,Opts,Ws]), []; + {ok,errors_test,[{_File,Ws}]} -> + {warning,Ws}; + {ok,errors_test,[]} -> + []; {error,[{XFile,Es}],Ws} = _ZZ when is_list(XFile) -> %io:format("compile:file(~s,~p) ->~n~p~n", % [File,Opts,_ZZ]), diff --git a/lib/crypto/c_src/Makefile.in b/lib/crypto/c_src/Makefile.in index 276c84d601..c2a986c334 100644 --- a/lib/crypto/c_src/Makefile.in +++ b/lib/crypto/c_src/Makefile.in @@ -41,6 +41,7 @@ CFLAGS = $(DED_CFLAGS) SSL_LIBDIR = @SSL_LIBDIR@ SSL_INCLUDE = @SSL_INCLUDE@ SSL_CRYPTO_LIBNAME = @SSL_CRYPTO_LIBNAME@ +SSL_SSL_LIBNAME = @SSL_SSL_LIBNAME@ INCLUDES = $(SSL_INCLUDE) $(DED_INCLUDES) @@ -84,7 +85,7 @@ DYNAMIC_CRYPTO_LIB=@SSL_DYNAMIC_ONLY@ ifeq ($(DYNAMIC_CRYPTO_LIB),yes) SSL_DED_LD_RUNTIME_LIBRARY_PATH = @SSL_DED_LD_RUNTIME_LIBRARY_PATH@ -CRYPTO_LINK_LIB=$(SSL_DED_LD_RUNTIME_LIBRARY_PATH) -L$(SSL_LIBDIR) -l$(SSL_CRYPTO_LIBNAME) +CRYPTO_LINK_LIB=$(SSL_DED_LD_RUNTIME_LIBRARY_PATH) -L$(SSL_LIBDIR) -l$(SSL_CRYPTO_LIBNAME) -l$(SSL_SSL_LIBNAME) else SSL_DED_LD_RUNTIME_LIBRARY_PATH= CRYPTO_LINK_LIB=$(SSL_LIBDIR)/lib$(SSL_CRYPTO_LIBNAME).a @@ -112,7 +113,7 @@ $(LIBDIR)/crypto$(TYPEMARKER).so: $(OBJS) $(LIBDIR)/crypto$(TYPEMARKER).dll: $(OBJS) $(INSTALL_DIR) $(LIBDIR) - $(LD) $(LDFLAGS) -o $@ $(SSL_DED_LD_RUNTIME_LIBRARY_PATH) -L$(SSL_LIBDIR) $(OBJS) -l$(SSL_CRYPTO_LIBNAME) + $(LD) $(LDFLAGS) -o $@ $(SSL_DED_LD_RUNTIME_LIBRARY_PATH) -L$(SSL_LIBDIR) $(OBJS) -l$(SSL_CRYPTO_LIBNAME) -l$(SSL_SSL_LIBNAME) clean: ifeq ($(findstring win32,$(TARGET)), win32) diff --git a/lib/crypto/doc/src/crypto.xml b/lib/crypto/doc/src/crypto.xml index 179ba4498c..96c4a072e1 100644 --- a/lib/crypto/doc/src/crypto.xml +++ b/lib/crypto/doc/src/crypto.xml @@ -744,7 +744,7 @@ Mpint() = <![CDATA[<<ByteLen:32/integer-big, Bytes:ByteLen/binary>>]]> <p>Generate a random number <c><![CDATA[N, Lo =< N < Hi.]]></c> Uses the <c>crypto</c> library pseudo-random number generator. The arguments (and result) can be either erlang integers or binary - multi-precision integers.</p> + multi-precision integers. <c>Hi</c> must be larger than <c>Lo</c>.</p> </desc> </func> <func> diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl index c35dfcebab..c3e13d6b91 100644 --- a/lib/crypto/src/crypto.erl +++ b/lib/crypto/src/crypto.erl @@ -415,6 +415,13 @@ rand_uniform(From,To) when is_binary(From), is_binary(To) -> Whatever end; rand_uniform(From,To) when is_integer(From),is_integer(To) -> + if From < 0 -> + rand_uniform_pos(0, To - From) + From; + true -> + rand_uniform_pos(From, To) + end. + +rand_uniform_pos(From,To) when From < To -> BinFrom = mpint(From), BinTo = mpint(To), case rand_uniform(BinFrom, BinTo) of @@ -422,7 +429,9 @@ rand_uniform(From,To) when is_integer(From),is_integer(To) -> erlint(Result); Other -> Other - end. + end; +rand_uniform_pos(_,_) -> + error(badarg). rand_uniform_nif(_From,_To) -> ?nif_stub. diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl index 283aadb6ea..8d2f42469b 100644 --- a/lib/crypto/test/crypto_SUITE.erl +++ b/lib/crypto/test/crypto_SUITE.erl @@ -878,10 +878,17 @@ rand_uniform_aux_test(0) -> rand_uniform_aux_test(N) -> ?line L = N*1000, ?line H = N*100000+1, + ?line crypto_rand_uniform(L, H), + ?line crypto_rand_uniform(-L, L), + ?line crypto_rand_uniform(-H, -L), + ?line crypto_rand_uniform(-H, L), + ?line rand_uniform_aux_test(N-1). + +crypto_rand_uniform(L,H) -> ?line R1 = crypto:rand_uniform(L, H), ?line t(R1 >= L), - ?line t(R1 < H), - ?line rand_uniform_aux_test(N-1). + ?line t(R1 < H). + %% %% diff --git a/lib/dialyzer/src/dialyzer_dataflow.erl b/lib/dialyzer/src/dialyzer_dataflow.erl index 7137dbc036..659297f993 100644 --- a/lib/dialyzer/src/dialyzer_dataflow.erl +++ b/lib/dialyzer/src/dialyzer_dataflow.erl @@ -528,7 +528,7 @@ handle_apply(Tree, Map, State) -> {CallSitesKnown, FunList} = case state__lookup_call_site(Tree, State2) of error -> {false, []}; - {ok, [external]} -> {false, {}}; + {ok, [external]} -> {false, []}; {ok, List} -> {true, List} end, case CallSitesKnown of @@ -554,7 +554,13 @@ handle_apply(Tree, Map, State) -> {State3, enter_type(Op, OpType1, Map2), t_none()}; false -> Map3 = enter_type_lists(Args, NewArgs, Map2), - {State2, enter_type(Op, OpType1, Map3), t_fun_range(OpType1)} + Range0 = t_fun_range(OpType1), + Range = + case t_is_unit(Range0) of + true -> t_none(); + false -> Range0 + end, + {State2, enter_type(Op, OpType1, Map3), Range} end end; true -> @@ -1414,6 +1420,17 @@ do_clause(C, Arg, ArgType0, OrigArgType, Map, false -> true end; + [Pat0, Pat1] -> % binary comprehension + case cerl:is_c_cons(Pat0) of + true -> + not (cerl:is_c_var(cerl:cons_hd(Pat0)) andalso + cerl:is_c_var(cerl:cons_tl(Pat0)) andalso + cerl:is_c_var(Pat1) andalso + cerl:is_literal(Guard) andalso + (cerl:concrete(Guard) =:= true)); + false -> + true + end; _ -> true end; false -> @@ -2915,7 +2932,7 @@ state__get_warnings(#state{tree_map = TreeMap, fun_tab = FunTab, {Warn, Msg} = case dialyzer_callgraph:lookup_name(FunLbl, Callgraph) of error -> {true, {unused_fun, []}}; - {ok, {_M, F, A}} = MFA -> + {ok, {_M, F, A} = MFA} -> {not sets:is_element(MFA, NoWarnUnused), {unused_fun, [F, A]}} end, @@ -2935,7 +2952,7 @@ state__get_warnings(#state{tree_map = TreeMap, fun_tab = FunTab, %% Check if the function has a contract that allows this. Warn = case Contract of - none -> true; + none -> not parent_allows_this(FunLbl, State); {value, C} -> GenRet = dialyzer_contracts:get_contract_return(C), not t_is_unit(GenRet) @@ -3423,6 +3440,33 @@ map_pats(Pats) -> end, cerl_trees:map(Fun, Pats). +parent_allows_this(FunLbl, #state{callgraph = Callgraph, plt = Plt} =State) -> + case state__is_escaping(FunLbl, State) of + false -> false; % if it isn't escaping it can't be a return value + true -> + case state__lookup_name(FunLbl, State) of + {_M, _F, _A} -> false; % if it has a name it is not a fun + _ -> + case dialyzer_callgraph:in_neighbours(FunLbl, Callgraph) of + [Parent] -> + case state__lookup_name(Parent, State) of + {_M, _F, _A} = PMFA -> + case dialyzer_plt:lookup_contract(Plt, PMFA) of + none -> false; + {value, C} -> + GenRet = dialyzer_contracts:get_contract_return(C), + case erl_types:t_is_fun(GenRet) of + false -> false; % element of structure? far-fetched... + true -> t_is_unit(t_fun_range(GenRet)) + end + end; + _ -> false % parent should have a name to have a contract + end; + _ -> false % called in other funs? far-fetched... + end + end + end. + classify_returns(Tree) -> case find_terminals(cerl:fun_body(Tree)) of {false, false} -> no_match; diff --git a/lib/dialyzer/src/dialyzer_typesig.erl b/lib/dialyzer/src/dialyzer_typesig.erl index c45615d670..06863d89a7 100644 --- a/lib/dialyzer/src/dialyzer_typesig.erl +++ b/lib/dialyzer/src/dialyzer_typesig.erl @@ -62,7 +62,8 @@ -type dep() :: integer(). %% type variable names used as constraint ids -type type_var() :: erl_types:erl_type(). %% actually: {'c','var',_,_} --record(fun_var, {'fun' :: fun((_) -> erl_types:erl_type()), deps :: [dep()]}). +-record(fun_var, {'fun' :: fun((_) -> erl_types:erl_type()), deps :: [dep()], + origin :: integer()}). -type constr_op() :: 'eq' | 'sub'. -type fvar_or_type() :: #fun_var{} | erl_types:erl_type(). @@ -121,8 +122,10 @@ -ifdef(DEBUG). -define(debug(__String, __Args), io:format(__String, __Args)). +-define(mk_fun_var(Fun, Vars), mk_fun_var(?LINE, Fun, Vars)). -else. -define(debug(__String, __Args), ok). +-define(mk_fun_var(Fun, Vars), mk_fun_var(Fun, Vars)). -endif. %% ============================================================================ @@ -218,10 +221,10 @@ traverse(Tree, DefinedVars, State) -> binary -> {State1, SegTypes} = traverse_list(cerl:binary_segments(Tree), DefinedVars, State), - Type = mk_fun_var(fun(Map) -> - TmpSegTypes = lookup_type_list(SegTypes, Map), - t_bitstr_concat(TmpSegTypes) - end, SegTypes), + Type = ?mk_fun_var(fun(Map) -> + TmpSegTypes = lookup_type_list(SegTypes, Map), + t_bitstr_concat(TmpSegTypes) + end, SegTypes), {state__store_conj(mk_var(Tree), sub, Type, State1), mk_var(Tree)}; bitstr -> Size = cerl:bitstr_size(Tree), @@ -236,7 +239,7 @@ traverse(Tree, DefinedVars, State) -> N when is_integer(N) -> {State1, t_bitstr(0, N)}; any -> % Size is not a literal {state__store_conj(SizeType, sub, t_non_neg_integer(), State1), - mk_fun_var(bitstr_constr(SizeType, UnitVal), [SizeType])} + ?mk_fun_var(bitstr_constr(SizeType, UnitVal), [SizeType])} end, ValTypeConstr = case cerl:concrete(cerl:bitstr_type(Tree)) of @@ -250,8 +253,8 @@ traverse(Tree, DefinedVars, State) -> case state__is_in_match(State1) of true -> Flags = cerl:concrete(cerl:bitstr_flags(Tree)), - mk_fun_var(bitstr_val_constr(SizeType, UnitVal, Flags), - [SizeType]); + ?mk_fun_var(bitstr_val_constr(SizeType, UnitVal, Flags), + [SizeType]); false -> t_integer() end; utf8 -> t_integer(); @@ -281,24 +284,24 @@ traverse(Tree, DefinedVars, State) -> {State, t_cons(HdVar, TlVar)}; false -> ConsVar = mk_var(Tree), - ConsType = mk_fun_var(fun(Map) -> - t_cons(lookup_type(HdVar, Map), - lookup_type(TlVar, Map)) - end, [HdVar, TlVar]), - HdType = mk_fun_var(fun(Map) -> - Cons = lookup_type(ConsVar, Map), - case t_is_cons(Cons) of - false -> t_any(); - true -> t_cons_hd(Cons) - end - end, [ConsVar]), - TlType = mk_fun_var(fun(Map) -> - Cons = lookup_type(ConsVar, Map), - case t_is_cons(Cons) of - false -> t_any(); - true -> t_cons_tl(Cons) - end - end, [ConsVar]), + ConsType = ?mk_fun_var(fun(Map) -> + t_cons(lookup_type(HdVar, Map), + lookup_type(TlVar, Map)) + end, [HdVar, TlVar]), + HdType = ?mk_fun_var(fun(Map) -> + Cons = lookup_type(ConsVar, Map), + case t_is_cons(Cons) of + false -> t_any(); + true -> t_cons_hd(Cons) + end + end, [ConsVar]), + TlType = ?mk_fun_var(fun(Map) -> + Cons = lookup_type(ConsVar, Map), + case t_is_cons(Cons) of + false -> t_any(); + true -> t_cons_tl(Cons) + end + end, [ConsVar]), State2 = state__store_conj_lists([HdVar, TlVar, ConsVar], sub, [HdType, TlType, ConsType], State1), @@ -656,25 +659,25 @@ get_plt_constr(MFA, Dst, ArgVars, State) -> {RetType, ArgCs} = case PltRes of none -> - {mk_fun_var(fun(Map) -> - ArgTypes = lookup_type_list(ArgVars, Map), - dialyzer_contracts:get_contract_return(C, ArgTypes) - end, ArgVars), GenArgs}; + {?mk_fun_var(fun(Map) -> + ArgTypes = lookup_type_list(ArgVars, Map), + dialyzer_contracts:get_contract_return(C, ArgTypes) + end, ArgVars), GenArgs}; {value, {PltRetType, PltArgTypes}} -> %% Need to combine the contract with the success typing. - {mk_fun_var( - fun(Map) -> - ArgTypes0 = lookup_type_list(ArgVars, Map), - ArgTypes = case FunModule =:= Module of - false -> - List = lists:zip(PltArgTypes, ArgTypes0), - [erl_types:t_unopaque_on_mismatch(T1, T2, Opaques) - || {T1, T2} <- List]; - true -> ArgTypes0 - end, - CRet = dialyzer_contracts:get_contract_return(C, ArgTypes), - t_inf(CRet, PltRetType, opaque) - end, ArgVars), + {?mk_fun_var( + fun(Map) -> + ArgTypes0 = lookup_type_list(ArgVars, Map), + ArgTypes = case FunModule =:= Module of + false -> + List = lists:zip(PltArgTypes, ArgTypes0), + [erl_types:t_unopaque_on_mismatch(T1, T2, Opaques) + || {T1, T2} <- List]; + true -> ArgTypes0 + end, + CRet = dialyzer_contracts:get_contract_return(C, ArgTypes), + t_inf(CRet, PltRetType, opaque) + end, ArgVars), [t_inf(X, Y, opaque) || {X, Y} <- lists:zip(GenArgs, PltArgTypes)]} end, state__store_conj_lists([Dst|ArgVars], sub, [RetType|ArgCs], State) @@ -766,10 +769,10 @@ handle_clauses_1([Clause|Tail], TopVar, Arg, DefinedVars, case SubtrTypes =:= overflow of true -> S; false -> - SubtrPatVar = mk_fun_var(fun(Map) -> - TmpType = lookup_type(Arg, Map), - t_subtract_list(TmpType, SubtrTypes) - end, [Arg]), + SubtrPatVar = ?mk_fun_var(fun(Map) -> + TmpType = lookup_type(Arg, Map), + t_subtract_list(TmpType, SubtrTypes) + end, [Arg]), state__store_conj(Arg, sub, SubtrPatVar, S) end end, @@ -1043,10 +1046,10 @@ handle_guard(Guard, DefinedVars, State) -> get_bif_constr({erlang, Op, 2}, Dst, Args = [Arg1, Arg2], _State) when Op =:= '+'; Op =:= '-'; Op =:= '*' -> - ReturnType = mk_fun_var(fun(Map) -> - TmpArgTypes = lookup_type_list(Args, Map), - erl_bif_types:type(erlang, Op, 2, TmpArgTypes) - end, Args), + ReturnType = ?mk_fun_var(fun(Map) -> + TmpArgTypes = lookup_type_list(Args, Map), + erl_bif_types:type(erlang, Op, 2, TmpArgTypes) + end, Args), ArgFun = fun(A, Pos) -> F = @@ -1074,7 +1077,7 @@ get_bif_constr({erlang, Op, 2}, Dst, Args = [Arg1, Arg2], _State) end end end, - mk_fun_var(F, [Dst, A]) + ?mk_fun_var(F, [Dst, A]) end, Arg1FunVar = ArgFun(Arg2, 2), Arg2FunVar = ArgFun(Arg1, 1), @@ -1131,12 +1134,12 @@ get_bif_constr({erlang, Op, 2}, Dst, [Arg1, Arg2] = Args, _State) '>=' -> {ArgFun(Arg1, Arg2, '>='), ArgFun(Arg2, Arg1, '=<')} end, DstArgs = [Dst, Arg1, Arg2], - Arg1Var = mk_fun_var(Arg1Fun, DstArgs), - Arg2Var = mk_fun_var(Arg2Fun, DstArgs), - DstVar = mk_fun_var(fun(Map) -> - TmpArgTypes = lookup_type_list(Args, Map), - erl_bif_types:type(erlang, Op, 2, TmpArgTypes) - end, Args), + Arg1Var = ?mk_fun_var(Arg1Fun, DstArgs), + Arg2Var = ?mk_fun_var(Arg2Fun, DstArgs), + DstVar = ?mk_fun_var(fun(Map) -> + TmpArgTypes = lookup_type_list(Args, Map), + erl_bif_types:type(erlang, Op, 2, TmpArgTypes) + end, Args), mk_conj_constraint_list([mk_constraint(Dst, sub, DstVar), mk_constraint(Arg1, sub, Arg1Var), mk_constraint(Arg2, sub, Arg2Var)]); @@ -1172,13 +1175,13 @@ get_bif_constr({erlang, '++', 2}, Dst, [Hd, Tl] = Args, _State) -> end end, DstL = [Dst], - HdVar = mk_fun_var(HdFun, DstL), - TlVar = mk_fun_var(TlFun, DstL), + HdVar = ?mk_fun_var(HdFun, DstL), + TlVar = ?mk_fun_var(TlFun, DstL), ArgTypes = erl_bif_types:arg_types(erlang, '++', 2), - ReturnType = mk_fun_var(fun(Map) -> - TmpArgTypes = lookup_type_list(Args, Map), - erl_bif_types:type(erlang, '++', 2, TmpArgTypes) - end, Args), + ReturnType = ?mk_fun_var(fun(Map) -> + TmpArgTypes = lookup_type_list(Args, Map), + erl_bif_types:type(erlang, '++', 2, TmpArgTypes) + end, Args), Cs = mk_constraints(Args, sub, ArgTypes), mk_conj_constraint_list([mk_constraint(Dst, sub, ReturnType), mk_constraint(Hd, sub, HdVar), @@ -1209,7 +1212,7 @@ get_bif_constr({erlang, is_function, 2}, Dst, [Fun, Arity], _State) -> false -> t_any() end end, - ArgV = mk_fun_var(ArgFun, [Dst, Arity]), + ArgV = ?mk_fun_var(ArgFun, [Dst, Arity]), mk_conj_constraint_list([mk_constraint(Dst, sub, t_boolean()), mk_constraint(Arity, sub, t_integer()), mk_constraint(Fun, sub, ArgV)]); @@ -1232,12 +1235,12 @@ get_bif_constr({erlang, is_record, 2}, Dst, [Var, Tag] = Args, _State) -> false -> t_any() end end, - ArgV = mk_fun_var(ArgFun, [Dst]), + ArgV = ?mk_fun_var(ArgFun, [Dst]), DstFun = fun(Map) -> TmpArgTypes = lookup_type_list(Args, Map), erl_bif_types:type(erlang, is_record, 2, TmpArgTypes) end, - DstV = mk_fun_var(DstFun, Args), + DstV = ?mk_fun_var(DstFun, Args), mk_conj_constraint_list([mk_constraint(Dst, sub, DstV), mk_constraint(Tag, sub, t_atom()), mk_constraint(Var, sub, ArgV)]); @@ -1280,7 +1283,7 @@ get_bif_constr({erlang, is_record, 3}, Dst, [Var, Tag, Arity] = Args, State) -> false -> t_any() end end, - ArgV = mk_fun_var(ArgFun, [Tag, Arity, Dst]), + ArgV = ?mk_fun_var(ArgFun, [Tag, Arity, Dst]), DstFun = fun(Map) -> [TmpVar, TmpTag, TmpArity] = TmpArgTypes = lookup_type_list(Args, Map), TmpArgTypes2 = @@ -1314,7 +1317,7 @@ get_bif_constr({erlang, is_record, 3}, Dst, [Var, Tag, Arity] = Args, State) -> end, erl_bif_types:type(erlang, is_record, 3, TmpArgTypes2) end, - DstV = mk_fun_var(DstFun, Args), + DstV = ?mk_fun_var(DstFun, Args), mk_conj_constraint_list([mk_constraint(Dst, sub, DstV), mk_constraint(Arity, sub, t_integer()), mk_constraint(Tag, sub, t_atom()), @@ -1359,9 +1362,9 @@ get_bif_constr({erlang, 'and', 2}, Dst, [Arg1, Arg2] = Args, _State) -> end end end, - ArgV1 = mk_fun_var(ArgFun(Arg2), [Arg2, Dst]), - ArgV2 = mk_fun_var(ArgFun(Arg1), [Arg1, Dst]), - DstV = mk_fun_var(DstFun, Args), + ArgV1 = ?mk_fun_var(ArgFun(Arg2), [Arg2, Dst]), + ArgV2 = ?mk_fun_var(ArgFun(Arg1), [Arg1, Dst]), + DstV = ?mk_fun_var(DstFun, Args), mk_conj_constraint_list([mk_constraint(Dst, sub, DstV), mk_constraint(Arg1, sub, ArgV1), mk_constraint(Arg2, sub, ArgV2)]); @@ -1403,9 +1406,9 @@ get_bif_constr({erlang, 'or', 2}, Dst, [Arg1, Arg2] = Args, _State) -> end end end, - ArgV1 = mk_fun_var(ArgFun(Arg2), [Arg2, Dst]), - ArgV2 = mk_fun_var(ArgFun(Arg1), [Arg1, Dst]), - DstV = mk_fun_var(DstFun, Args), + ArgV1 = ?mk_fun_var(ArgFun(Arg2), [Arg2, Dst]), + ArgV2 = ?mk_fun_var(ArgFun(Arg1), [Arg1, Dst]), + DstV = ?mk_fun_var(DstFun, Args), F = fun(A) -> try [mk_constraint(A, sub, True)] catch throw:error -> [] @@ -1433,8 +1436,8 @@ get_bif_constr({erlang, 'not', 1}, Dst, [Arg] = Args, _State) -> end end end, - ArgV = mk_fun_var(Fun(Dst), [Dst]), - DstV = mk_fun_var(Fun(Arg), Args), + ArgV = ?mk_fun_var(Fun(Dst), [Dst]), + DstV = ?mk_fun_var(Fun(Arg), Args), mk_conj_constraint_list([mk_constraint(Arg, sub, ArgV), mk_constraint(Dst, sub, DstV)]); get_bif_constr({erlang, '=:=', 2}, Dst, [Arg1, Arg2] = Args, _State) -> @@ -1467,9 +1470,9 @@ get_bif_constr({erlang, '=:=', 2}, Dst, [Arg1, Arg2] = Args, _State) -> end end, DstArgs = [Dst, Arg1, Arg2], - ArgV1 = mk_fun_var(ArgFun(Arg1, Arg2), DstArgs), - ArgV2 = mk_fun_var(ArgFun(Arg2, Arg1), DstArgs), - DstV = mk_fun_var(DstFun, Args), + ArgV1 = ?mk_fun_var(ArgFun(Arg1, Arg2), DstArgs), + ArgV2 = ?mk_fun_var(ArgFun(Arg2, Arg1), DstArgs), + DstV = ?mk_fun_var(DstFun, Args), mk_conj_constraint_list([mk_constraint(Dst, sub, DstV), mk_constraint(Arg1, sub, ArgV1), mk_constraint(Arg2, sub, ArgV2)]); @@ -1510,10 +1513,10 @@ get_bif_constr({erlang, '==', 2}, Dst, [Arg1, Arg2] = Args, _State) -> end end end, - DstV = mk_fun_var(DstFun, Args), + DstV = ?mk_fun_var(DstFun, Args), ArgL = [Arg1, Arg2, Dst], - ArgV1 = mk_fun_var(ArgFun(Arg2, Arg1), ArgL), - ArgV2 = mk_fun_var(ArgFun(Arg1, Arg2), ArgL), + ArgV1 = ?mk_fun_var(ArgFun(Arg2, Arg1), ArgL), + ArgV2 = ?mk_fun_var(ArgFun(Arg1, Arg2), ArgL), mk_conj_constraint_list([mk_constraint(Dst, sub, DstV), mk_constraint(Arg1, sub, ArgV1), mk_constraint(Arg2, sub, ArgV2)]); @@ -1531,7 +1534,7 @@ get_bif_constr({erlang, element, 2} = _BIF, Dst, Args, end, erl_bif_types:type(erlang, element, 2, ATs2) end, - ReturnType = mk_fun_var(Fun, Args), + ReturnType = ?mk_fun_var(Fun, Args), ArgTypes = erl_bif_types:arg_types(erlang, element, 2), Cs = mk_constraints(Args, sub, ArgTypes), NewCs = @@ -1553,7 +1556,7 @@ get_bif_constr({M, F, A} = _BIF, Dst, Args, State) -> false -> T end end, - ReturnType = mk_fun_var(fun(Map) -> + ReturnType = ?mk_fun_var(fun(Map) -> TmpArgTypes0 = lookup_type_list(Args, Map), TmpArgTypes = [UnopaqueFun(T) || T<- TmpArgTypes0], erl_bif_types:type(M, F, A, TmpArgTypes) @@ -1608,7 +1611,7 @@ get_bif_test_constr(Dst, Arg, Type, State) -> false -> t_any() end end, - ArgV = mk_fun_var(ArgFun, [Dst]), + ArgV = ?mk_fun_var(ArgFun, [Dst]), DstFun = fun(Map) -> ArgType = lookup_type(Arg, Map), case t_is_none(t_inf(ArgType, Type)) of @@ -1633,7 +1636,7 @@ get_bif_test_constr(Dst, Arg, Type, State) -> end end end, - DstV = mk_fun_var(DstFun, [Arg]), + DstV = ?mk_fun_var(DstFun, [Arg]), mk_conj_constraint_list([mk_constraint(Dst, sub, DstV), mk_constraint(Arg, sub, ArgV)]). @@ -1684,11 +1687,14 @@ solve_scc(SCC, Map, State, TryingUnit) -> true -> ?debug("SCC ~w reached fixpoint\n", [SCC]), NewTypes = unsafe_lookup_type_list(Funs, Map2), - case lists:all(fun(T) -> t_is_none(t_fun_range(T)) end, NewTypes) + case erl_types:any_none([t_fun_range(T) || T <- NewTypes]) andalso TryingUnit =:= false of true -> - UnitTypes = [t_fun(state__fun_arity(F, State), t_unit()) - || F <- Funs], + UnitTypes = + [case t_is_none(t_fun_range(T)) of + false -> T; + true -> t_fun(t_fun_args(T), t_unit()) + end || T <- NewTypes], Map3 = enter_type_lists(Funs, UnitTypes, Map2), solve_scc(SCC, Map3, State, true); false -> @@ -2320,12 +2326,25 @@ mk_constraint(Lhs, Op, Rhs) -> constraint_opnd_is_any(#fun_var{}) -> false; constraint_opnd_is_any(Type) -> t_is_any(Type). +-ifdef(DEBUG). + +-spec mk_fun_var(fun((_) -> erl_types:erl_type()), [erl_types:erl_type()], + integer()) -> #fun_var{}. + +mk_fun_var(Line, Fun, Types) -> + Deps = [t_var_name(Var) || Var <- t_collect_vars(t_product(Types))], + #fun_var{'fun' = Fun, deps = ordsets:from_list(Deps), origin = Line}. + +-else. + -spec mk_fun_var(fun((_) -> erl_types:erl_type()), [erl_types:erl_type()]) -> #fun_var{}. mk_fun_var(Fun, Types) -> Deps = [t_var_name(Var) || Var <- t_collect_vars(t_product(Types))], #fun_var{'fun' = Fun, deps = ordsets:from_list(Deps)}. +-endif. + -spec get_deps(constr()) -> [dep()]. get_deps(#constraint{deps = D}) -> D; @@ -2676,8 +2695,9 @@ find_constraint(Tuple, [_|Cs]) -> -endif. -ifdef(DEBUG). -format_type(#fun_var{deps = Deps}) -> - io_lib:format("Fun(~s)", [lists:flatten([format_type(t_var(X))||X<-Deps])]); +format_type(#fun_var{deps = Deps, origin = Origin}) -> + io_lib:format("Fun@L~p(~s)", + [Origin, lists:flatten([format_type(t_var(X))||X<-Deps])]); format_type(Type) -> case cerl:is_literal(Type) of true -> io_lib:format("~w", [cerl:concrete(Type)]); diff --git a/lib/dialyzer/test/Makefile b/lib/dialyzer/test/Makefile index 69a8fd742e..47deb17f1d 100644 --- a/lib/dialyzer/test/Makefile +++ b/lib/dialyzer/test/Makefile @@ -26,7 +26,7 @@ include $(ERL_TOP)/make/otp_release_targets.mk release_tests_spec: $(INSTALL_DIR) $(RELSYSDIR) - chmod -f -R u+w $(RELSYSDIR) + chmod -R u+w $(RELSYSDIR) $(INSTALL_DATA) $(AUXILIARY_FILES) $(RELSYSDIR) @tar cf - *_SUITE_data | (cd $(RELSYSDIR); tar xf -) cd $(RELSYSDIR);\ diff --git a/lib/dialyzer/test/r9c_SUITE_data/results/asn1 b/lib/dialyzer/test/r9c_SUITE_data/results/asn1 index ac83366bc8..571e562d0d 100644 --- a/lib/dialyzer/test/r9c_SUITE_data/results/asn1 +++ b/lib/dialyzer/test/r9c_SUITE_data/results/asn1 @@ -2,7 +2,7 @@ asn1ct.erl:1500: The variable Err can never match since previous clauses completely covered the type #type{} asn1ct.erl:1596: The variable _ can never match since previous clauses completely covered the type 'ber_bin_v2' asn1ct.erl:1673: The pattern 'all' can never match the type 'asn1_module' | 'exclusive_decode' | 'partial_decode' -asn1ct.erl:672: The pattern <{'false', Result}, _, _> can never match the type <{'true','true'},atom() | binary() | [atom() | binary() | [atom() | binary() | [any()] | char()] | char()],[any()]> +asn1ct.erl:672: The pattern <{'false', Result}, _, _> can never match the type <{'true','true'},atom() | binary() | [atom() | [any()] | char()],[any()]> asn1ct.erl:909: Guard test is_atom(Ext::[49 | 97 | 98 | 100 | 110 | 115]) can never succeed asn1ct_check.erl:1698: The pattern {'error', _} can never match the type [any()] asn1ct_check.erl:2733: The pattern {'type', Tag, _, _, _, _} can never match the type 'ASN1_OPEN_TYPE' | {_,_} | {'fixedtypevaluefield',_,_} diff --git a/lib/dialyzer/test/r9c_SUITE_data/results/inets b/lib/dialyzer/test/r9c_SUITE_data/results/inets index fd5e36a3cd..0177dcc88c 100644 --- a/lib/dialyzer/test/r9c_SUITE_data/results/inets +++ b/lib/dialyzer/test/r9c_SUITE_data/results/inets @@ -3,13 +3,15 @@ ftp.erl:1243: The pattern {'ok', {N, Bytes}} can never match the type 'eof' | {' ftp.erl:640: The pattern {'closed', _Why} can never match the type 'perm_fname_not_allowed' | 'perm_neg_compl' | 'perm_no_space' | 'pos_compl' | 'pos_interm' | 'pos_interm_acct' | 'trans_neg_compl' | 'trans_no_space' | {'error' | 'perm_fname_not_allowed' | 'perm_neg_compl' | 'perm_no_space' | 'pos_compl' | 'pos_interm' | 'pos_interm_acct' | 'pos_prel' | 'trans_neg_compl' | 'trans_no_space',atom() | [any()] | {'invalid_server_response',[any(),...]}} http.erl:117: The pattern {'error', Reason} can never match the type #req_headers{connection::[45 | 97 | 101 | 105 | 107 | 108 | 112 | 118,...],content_length::[48,...],other::[{_,_}]} http.erl:138: Function close_session/2 will never be called -http_lib.erl:286: The call http_lib:close('ip_comm' | {'ssl',_},any()) will never return since it differs in the 1st argument from the success typing arguments: ('http' | 'https',any()) -http_lib.erl:424: The variable _ can never match since previous clauses completely covered the type any() -http_lib.erl:438: The variable _ can never match since previous clauses completely covered the type any() +http_lib.erl:286: The call http_lib:close('ip_comm' | {'ssl',_},port() | {'sslsocket',_,_}) will never return since it differs in the 1st argument from the success typing arguments: ('http' | 'https',port() | {'sslsocket',_,pid() | {_,{'config',_,_,_,_,{_,_,_,_}}} | {'sslsocket',_,pid() | {'sslsocket',_,pid() | {_,_,_}}}}) +http_lib.erl:415: The pattern 61 can never match the type 'http_eoh' | binary() | maybe_improper_list(any(),binary() | []) | {'http_error',binary() | string()} | #http_request{method::'DELETE' | 'GET' | 'HEAD' | 'OPTIONS' | 'POST' | 'PUT' | 'TRACE' | binary() | string(),path::'*' | binary() | string() | {'abs_path',binary() | string()} | {'scheme',binary() | string(),binary() | string()} | {'absoluteURI','http' | 'https',binary() | string(),'undefined' | non_neg_integer(),binary() | string()},version::{non_neg_integer(),non_neg_integer()}} | #http_response{version::{non_neg_integer(),non_neg_integer()},status::integer(),phrase::binary() | string()} | {'http_header',integer(),atom() | binary() | string(),_,binary() | string()} +http_lib.erl:417: The pattern 59 can never match the type 'http_eoh' | binary() | maybe_improper_list(any(),binary() | []) | {'http_error',binary() | string()} | #http_request{method::'DELETE' | 'GET' | 'HEAD' | 'OPTIONS' | 'POST' | 'PUT' | 'TRACE' | binary() | string(),path::'*' | binary() | string() | {'abs_path',binary() | string()} | {'scheme',binary() | string(),binary() | string()} | {'absoluteURI','http' | 'https',binary() | string(),'undefined' | non_neg_integer(),binary() | string()},version::{non_neg_integer(),non_neg_integer()}} | #http_response{version::{non_neg_integer(),non_neg_integer()},status::integer(),phrase::binary() | string()} | {'http_header',integer(),atom() | binary() | string(),_,binary() | string()} +http_lib.erl:420: The pattern 13 can never match the type 'http_eoh' | binary() | maybe_improper_list(any(),binary() | []) | {'http_error',binary() | string()} | #http_request{method::'DELETE' | 'GET' | 'HEAD' | 'OPTIONS' | 'POST' | 'PUT' | 'TRACE' | binary() | string(),path::'*' | binary() | string() | {'abs_path',binary() | string()} | {'scheme',binary() | string(),binary() | string()} | {'absoluteURI','http' | 'https',binary() | string(),'undefined' | non_neg_integer(),binary() | string()},version::{non_neg_integer(),non_neg_integer()}} | #http_response{version::{non_neg_integer(),non_neg_integer()},status::integer(),phrase::binary() | string()} | {'http_header',integer(),atom() | binary() | string(),_,binary() | string()} +http_lib.erl:424: The variable _ can never match since previous clauses completely covered the type 'http_eoh' | binary() | maybe_improper_list(any(),binary() | []) | {'http_error',binary() | string()} | #http_request{method::'DELETE' | 'GET' | 'HEAD' | 'OPTIONS' | 'POST' | 'PUT' | 'TRACE' | binary() | string(),path::'*' | binary() | string() | {'abs_path',binary() | string()} | {'scheme',binary() | string(),binary() | string()} | {'absoluteURI','http' | 'https',binary() | string(),'undefined' | non_neg_integer(),binary() | string()},version::{non_neg_integer(),non_neg_integer()}} | #http_response{version::{non_neg_integer(),non_neg_integer()},status::integer(),phrase::binary() | string()} | {'http_header',integer(),atom() | binary() | string(),_,binary() | string()} +http_lib.erl:428: Function read_chunk_ext_val/6 will never be called +http_lib.erl:444: The pattern 10 can never match the type 'http_eoh' | binary() | maybe_improper_list(any(),binary() | []) | {'http_error',binary() | string()} | #http_request{method::'DELETE' | 'GET' | 'HEAD' | 'OPTIONS' | 'POST' | 'PUT' | 'TRACE' | binary() | string(),path::'*' | binary() | string() | {'abs_path',binary() | string()} | {'scheme',binary() | string(),binary() | string()} | {'absoluteURI','http' | 'https',binary() | string(),'undefined' | non_neg_integer(),binary() | string()},version::{non_neg_integer(),non_neg_integer()}} | #http_response{version::{non_neg_integer(),non_neg_integer()},status::integer(),phrase::binary() | string()} | {'http_header',integer(),atom() | binary() | string(),_,binary() | string()} +http_lib.erl:552: Call to missing or unexported function ssl:accept/2 http_lib.erl:99: Function getHeaderValue/2 will never be called -httpc_handler.erl:322: Function status_continue/2 has no local return -httpc_handler.erl:37: Function init_connection/2 has no local return -httpc_handler.erl:65: Function next_response_with_request/2 has no local return httpc_handler.erl:660: Function exit_session_ok/2 has no local return httpc_manager.erl:145: The pattern {ErrorReply, State2} can never match the type {{'ok',number()},number(),#state{reqid::number()}} httpc_manager.erl:160: The pattern {ErrorReply, State2} can never match the type {{'ok',number()},number(),#state{reqid::number()}} @@ -24,11 +26,14 @@ httpd_manager.erl:885: The pattern {'EXIT', Reason} can never match since previo httpd_manager.erl:919: Function auth_status/1 will never be called httpd_manager.erl:926: Function sec_status/1 will never be called httpd_manager.erl:933: Function acceptor_status/1 will never be called -httpd_request_handler.erl:374: The call httpd_response:send_status(Info::#mod{parsed_header::maybe_improper_list()},417,[32 | 66 | 98 | 100 | 103 | 105 | 111 | 116 | 121,...]) will never return since it differs in the 2nd argument from the success typing arguments: (#mod{socket_type::'ip_comm' | {'ssl',_}},100 | 301 | 304 | 400 | 401 | 403 | 404 | 412 | 414 | 416 | 500 | 501 | 503,any()) -httpd_request_handler.erl:378: The call httpd_response:send_status(Info::#mod{parsed_header::maybe_improper_list()},417,[32 | 77 | 97 | 100 | 101 | 104 | 108 | 110 | 111 | 116 | 119,...]) will never return since it differs in the 2nd argument from the success typing arguments: (#mod{socket_type::'ip_comm' | {'ssl',_}},100 | 301 | 304 | 400 | 401 | 403 | 404 | 412 | 414 | 416 | 500 | 501 | 503,any()) -httpd_request_handler.erl:401: The call httpd_response:send_status(Info::#mod{parsed_header::maybe_improper_list()},417,[32 | 77 | 97 | 100 | 101 | 104 | 108 | 110 | 111 | 116 | 119,...]) will never return since it differs in the 2nd argument from the success typing arguments: (#mod{socket_type::'ip_comm' | {'ssl',_}},100 | 301 | 304 | 400 | 401 | 403 | 404 | 412 | 414 | 416 | 500 | 501 | 503,any()) -httpd_request_handler.erl:644: The call lists:reverse(Fields0::{'error',_} | {'ok',[[any()]]}) will never return since it differs in the 1st argument from the success typing arguments: ([any()]) +httpd_request_handler.erl:374: The call httpd_response:send_status(Info::#mod{parsed_header::maybe_improper_list()},417,[32 | 66 | 98 | 100 | 103 | 105 | 111 | 116 | 121,...]) will never return since it differs in the 2nd argument from the success typing arguments: (#mod{socket_type::'ip_comm' | {'ssl',_},socket::port() | {'sslsocket',_,_}},100 | 301 | 304 | 400 | 401 | 403 | 404 | 412 | 414 | 416 | 500 | 501 | 503,any()) +httpd_request_handler.erl:378: The call httpd_response:send_status(Info::#mod{parsed_header::maybe_improper_list()},417,[32 | 77 | 97 | 100 | 101 | 104 | 108 | 110 | 111 | 116 | 119,...]) will never return since it differs in the 2nd argument from the success typing arguments: (#mod{socket_type::'ip_comm' | {'ssl',_},socket::port() | {'sslsocket',_,_}},100 | 301 | 304 | 400 | 401 | 403 | 404 | 412 | 414 | 416 | 500 | 501 | 503,any()) +httpd_request_handler.erl:401: The call httpd_response:send_status(Info::#mod{parsed_header::maybe_improper_list()},417,[32 | 77 | 97 | 100 | 101 | 104 | 108 | 110 | 111 | 116 | 119,...]) will never return since it differs in the 2nd argument from the success typing arguments: (#mod{socket_type::'ip_comm' | {'ssl',_},socket::port() | {'sslsocket',_,_}},100 | 301 | 304 | 400 | 401 | 403 | 404 | 412 | 414 | 416 | 500 | 501 | 503,any()) +httpd_request_handler.erl:489: The variable Other can never match since previous clauses completely covered the type {'error',_} | {'ok','http_eoh' | binary() | maybe_improper_list(any(),binary() | []) | {'http_error',binary() | string()} | {'http_request','DELETE' | 'GET' | 'HEAD' | 'OPTIONS' | 'POST' | 'PUT' | 'TRACE' | binary() | string(),'*' | binary() | string() | {'abs_path',binary() | [any()]} | {'scheme',binary() | [any()],binary() | [any()]} | {'absoluteURI','http' | 'https',binary() | [any()],'undefined' | non_neg_integer(),binary() | [any()]},{non_neg_integer(),non_neg_integer()}} | {'http_response',{non_neg_integer(),non_neg_integer()},integer(),binary() | string()} | {'http_header',integer(),atom() | binary() | string(),_,binary() | string()}} +httpd_request_handler.erl:644: The call lists:reverse(Fields0::{'error',_} | {'ok',_}) will never return since it differs in the 1st argument from the success typing arguments: ([any()]) httpd_request_handler.erl:645: Function will never be called +httpd_socket.erl:129: Call to missing or unexported function ssl:accept/2 +httpd_socket.erl:49: The pattern {'ok', _} can never match the type {'error',_} httpd_sup.erl:63: The variable Else can never match since previous clauses completely covered the type {'error',_} | {'ok',[any()],_,_} httpd_sup.erl:88: The pattern {'error', Reason} can never match the type {'ok',_,_} httpd_sup.erl:92: The variable Else can never match since previous clauses completely covered the type {'ok',_,_} @@ -38,17 +43,17 @@ mod_auth_plain.erl:100: The variable _ can never match since previous clauses co mod_auth_plain.erl:159: The variable _ can never match since previous clauses completely covered the type [any()] mod_auth_plain.erl:83: The variable O can never match since previous clauses completely covered the type [any()] mod_cgi.erl:372: The pattern {'http_response', NewAccResponse} can never match the type 'ok' -mod_dir.erl:101: The call lists:flatten(nonempty_improper_list(atom() | binary() | [any()] | char(),atom())) will never return since it differs in the 1st argument from the success typing arguments: ([any()]) +mod_dir.erl:101: The call lists:flatten(nonempty_improper_list(atom() | [any()] | char(),atom())) will never return since it differs in the 1st argument from the success typing arguments: ([any()]) mod_dir.erl:72: The pattern {'error', Reason} can never match the type {'ok',[[[any()] | char()],...]} -mod_get.erl:135: The pattern <{'enfile', _}, _Info, Path> can never match the type <atom(),#mod{},atom() | binary() | [atom() | binary() | [any()] | char()]> -mod_head.erl:80: The pattern <{'enfile', _}, _Info, Path> can never match the type <atom(),#mod{},atom() | binary() | [atom() | binary() | [atom() | binary() | [any()] | char()] | char()]> +mod_get.erl:135: The pattern <{'enfile', _}, _Info, Path> can never match the type <atom(),#mod{},atom() | binary() | [atom() | [any()] | char()]> +mod_head.erl:80: The pattern <{'enfile', _}, _Info, Path> can never match the type <atom(),#mod{},atom() | binary() | [atom() | [any()] | char()]> mod_htaccess.erl:460: The pattern {'error', BadData} can never match the type {'ok',_} -mod_include.erl:193: The pattern {_, Name, {[], []}} can never match the type {[any()],[any()],maybe_improper_list()} -mod_include.erl:195: The pattern {_, Name, {PathInfo, []}} can never match the type {[any()],[any()],maybe_improper_list()} -mod_include.erl:197: The pattern {_, Name, {PathInfo, QueryString}} can never match the type {[any()],[any()],maybe_improper_list()} -mod_include.erl:201: The variable Gurka can never match since previous clauses completely covered the type {[any()],[any()],maybe_improper_list()} -mod_include.erl:692: The pattern <{'read', Reason}, Info, Path> can never match the type <{'open',atom()},#mod{},atom() | binary() | [atom() | binary() | [atom() | binary() | [any()] | char()] | char()]> -mod_include.erl:706: The pattern <{'enfile', _}, _Info, Path> can never match the type <atom(),#mod{},atom() | binary() | [atom() | binary() | [atom() | binary() | [any()] | char()] | char()]> +mod_include.erl:193: The pattern {_, Name, {[], []}} can never match the type {[any()],[any()],string()} +mod_include.erl:195: The pattern {_, Name, {PathInfo, []}} can never match the type {[any()],[any()],string()} +mod_include.erl:197: The pattern {_, Name, {PathInfo, QueryString}} can never match the type {[any()],[any()],string()} +mod_include.erl:201: The variable Gurka can never match since previous clauses completely covered the type {[any()],[any()],string()} +mod_include.erl:692: The pattern <{'read', Reason}, Info, Path> can never match the type <{'open',atom()},#mod{},atom() | binary() | [atom() | [any()] | char()]> +mod_include.erl:706: The pattern <{'enfile', _}, _Info, Path> can never match the type <atom(),#mod{},atom() | binary() | [atom() | [any()] | char()]> mod_include.erl:716: Function read_error/3 will never be called mod_include.erl:719: Function read_error/4 will never be called mod_security_server.erl:386: The variable O can never match since previous clauses completely covered the type [any()] diff --git a/lib/dialyzer/test/r9c_SUITE_data/results/mnesia b/lib/dialyzer/test/r9c_SUITE_data/results/mnesia index e199581a0e..2be71ac7d7 100644 --- a/lib/dialyzer/test/r9c_SUITE_data/results/mnesia +++ b/lib/dialyzer/test/r9c_SUITE_data/results/mnesia @@ -6,6 +6,7 @@ mnesia_bup.erl:111: The created fun has no local return mnesia_bup.erl:574: Function fallback_receiver/2 has no local return mnesia_bup.erl:967: Function uninstall_fallback_master/2 has no local return mnesia_checkpoint.erl:1014: The variable Error can never match since previous clauses completely covered the type {'ok',#checkpoint_args{nodes::[any()],retainers::[any(),...]}} +mnesia_checkpoint.erl:894: The call sys:handle_system_msg(Msg::any(),From::any(),'no_parent','mnesia_checkpoint',[],Cp::#checkpoint_args{}) breaks the contract (Msg,From,Parent,Module,Debug,Misc) -> Void when is_subtype(Msg,term()), is_subtype(From,{pid(),Tag::_}), is_subtype(Parent,pid()), is_subtype(Module,module()), is_subtype(Debug,[dbg_opt()]), is_subtype(Misc,term()), is_subtype(Void,term()) mnesia_controller.erl:1666: The variable Tab can never match since previous clauses completely covered the type [any()] mnesia_controller.erl:1679: The pattern {'stop', Reason, Reply, State2} can never match the type {'noreply',_} | {'reply',_,_} | {'stop','shutdown',#state{}} mnesia_controller.erl:1685: The pattern {'noreply', State2, _Timeout} can never match the type {'reply',_,_} @@ -15,6 +16,7 @@ mnesia_frag.erl:294: The call mnesia_frag:remote_collect(Ref::reference(),{'erro mnesia_frag.erl:304: The call mnesia_frag:remote_collect(Ref::reference(),{'error',{'node_not_running',_}},[],OldSelectFun::fun(() -> [any()])) will never return since it differs in the 2nd argument from the success typing arguments: (reference(),'ok',[any()],fun(() -> [any()])) mnesia_frag.erl:312: The call mnesia_frag:remote_collect(Ref::reference(),LocalRes::{'error',_},[],OldSelectFun::fun(() -> [any()])) will never return since it differs in the 2nd argument from the success typing arguments: (reference(),'ok',[any()],fun(() -> [any()])) mnesia_index.erl:52: The call mnesia_lib:other_val(Var::{_,'commit_work' | 'index' | 'setorbag' | 'storage_type' | {'index',_}},_ReASoN_::any()) will never return since it differs in the 1st argument from the success typing arguments: ({_,'active_replicas' | 'where_to_read' | 'where_to_write'},any()) +mnesia_lib.erl:1028: The pattern {'EXIT', Reason} can never match the type [any()] | {'error',_} mnesia_lib.erl:957: The pattern {'ok', {0, _}} can never match the type 'eof' | {'error',atom()} | {'ok',binary() | string()} mnesia_lib.erl:959: The pattern {'ok', {_, Bin}} can never match the type 'eof' | {'error',atom()} | {'ok',binary() | string()} mnesia_loader.erl:36: The call mnesia_lib:other_val(Var::{_,'access_mode' | 'cstruct' | 'db_nodes' | 'setorbag' | 'snmp' | 'storage_type'},Reason::any()) will never return since it differs in the 1st argument from the success typing arguments: ({_,'active_replicas' | 'where_to_read' | 'where_to_write'},any()) @@ -30,5 +32,6 @@ mnesia_schema.erl:1258: Guard test FromS::'disc_copies' | 'disc_only_copies' | ' mnesia_schema.erl:1639: The pattern {'false', 'mandatory'} can never match the type {'false','optional'} mnesia_schema.erl:2434: The variable Reason can never match since previous clauses completely covered the type {'error',_} | {'ok',_} mnesia_schema.erl:451: Guard test UseDirAnyway::'false' == 'true' can never succeed +mnesia_text.erl:180: The variable T can never match since previous clauses completely covered the type {'error',{integer(),atom() | tuple(),_}} | {'ok',_} mnesia_tm.erl:1522: Function commit_participant/5 has no local return mnesia_tm.erl:2169: Function system_terminate/4 has no local return diff --git a/lib/dialyzer/test/race_SUITE_data/results/extract_translations b/lib/dialyzer/test/race_SUITE_data/results/extract_translations index f7d5abc6f5..62aa1aa511 100644 --- a/lib/dialyzer/test/race_SUITE_data/results/extract_translations +++ b/lib/dialyzer/test/race_SUITE_data/results/extract_translations @@ -1,5 +1,5 @@ -extract_translations.erl:140: The call ets:insert('files',{atom() | binary() | [atom() | binary() | [atom() | binary() | [any()] | char()] | char()]}) might have an unintended effect due to a possible race condition caused by its combination with the ets:lookup('files',File::atom() | binary() | [atom() | binary() | [atom() | binary() | [any()] | char()] | char()]) call in extract_translations.erl on line 135 +extract_translations.erl:140: The call ets:insert('files',{atom() | binary() | [atom() | [any()] | char()]}) might have an unintended effect due to a possible race condition caused by its combination with the ets:lookup('files',File::atom() | binary() | [atom() | [any()] | char()]) call in extract_translations.erl on line 135 extract_translations.erl:146: The call ets:insert('translations',{_,[]}) might have an unintended effect due to a possible race condition caused by its combination with the ets:lookup('translations',Str::any()) call in extract_translations.erl on line 126 -extract_translations.erl:152: The call ets:insert('files',{atom() | binary() | [atom() | binary() | [atom() | binary() | [any()] | char()] | char()]}) might have an unintended effect due to a possible race condition caused by its combination with the ets:lookup('files',File::atom() | binary() | [atom() | binary() | [atom() | binary() | [any()] | char()] | char()]) call in extract_translations.erl on line 148 +extract_translations.erl:152: The call ets:insert('files',{atom() | binary() | [atom() | [any()] | char()]}) might have an unintended effect due to a possible race condition caused by its combination with the ets:lookup('files',File::atom() | binary() | [atom() | [any()] | char()]) call in extract_translations.erl on line 148 extract_translations.erl:154: The call ets:insert('translations',{_,[]}) might have an unintended effect due to a possible race condition caused by its combination with the ets:lookup('translations',Str::any()) call in extract_translations.erl on line 126 diff --git a/lib/dialyzer/test/small_SUITE_data/results/common_eunit b/lib/dialyzer/test/small_SUITE_data/results/common_eunit new file mode 100644 index 0000000000..bb5fd1c9ac --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/common_eunit @@ -0,0 +1,2 @@ + +common_eunit.erl:57: The created fun has no local return diff --git a/lib/dialyzer/test/small_SUITE_data/results/comparisons b/lib/dialyzer/test/small_SUITE_data/results/comparisons new file mode 100644 index 0000000000..642585d25e --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/comparisons @@ -0,0 +1,153 @@ + +comparisons.erl:100: The pattern 'true' can never match the type 'false' +comparisons.erl:101: The pattern 'true' can never match the type 'false' +comparisons.erl:102: The pattern 'false' can never match the type 'true' +comparisons.erl:103: The pattern 'false' can never match the type 'true' +comparisons.erl:104: The pattern 'true' can never match the type 'false' +comparisons.erl:105: The pattern 'true' can never match the type 'false' +comparisons.erl:107: The pattern 'true' can never match the type 'false' +comparisons.erl:108: The pattern 'true' can never match the type 'false' +comparisons.erl:109: The pattern 'false' can never match the type 'true' +comparisons.erl:110: The pattern 'false' can never match the type 'true' +comparisons.erl:111: The pattern 'true' can never match the type 'false' +comparisons.erl:112: The pattern 'true' can never match the type 'false' +comparisons.erl:113: The pattern 'false' can never match the type 'true' +comparisons.erl:114: The pattern 'false' can never match the type 'true' +comparisons.erl:115: The pattern 'true' can never match the type 'false' +comparisons.erl:116: The pattern 'true' can never match the type 'false' +comparisons.erl:117: The pattern 'false' can never match the type 'true' +comparisons.erl:118: The pattern 'false' can never match the type 'true' +comparisons.erl:123: The pattern 'false' can never match the type 'true' +comparisons.erl:124: The pattern 'false' can never match the type 'true' +comparisons.erl:125: The pattern 'true' can never match the type 'false' +comparisons.erl:126: The pattern 'true' can never match the type 'false' +comparisons.erl:127: The pattern 'false' can never match the type 'true' +comparisons.erl:128: The pattern 'false' can never match the type 'true' +comparisons.erl:129: The pattern 'true' can never match the type 'false' +comparisons.erl:130: The pattern 'true' can never match the type 'false' +comparisons.erl:132: The pattern 'true' can never match the type 'false' +comparisons.erl:133: The pattern 'true' can never match the type 'false' +comparisons.erl:134: The pattern 'false' can never match the type 'true' +comparisons.erl:135: The pattern 'false' can never match the type 'true' +comparisons.erl:136: The pattern 'true' can never match the type 'false' +comparisons.erl:137: The pattern 'true' can never match the type 'false' +comparisons.erl:138: The pattern 'false' can never match the type 'true' +comparisons.erl:139: The pattern 'false' can never match the type 'true' +comparisons.erl:140: The pattern 'true' can never match the type 'false' +comparisons.erl:141: The pattern 'true' can never match the type 'false' +comparisons.erl:142: The pattern 'false' can never match the type 'true' +comparisons.erl:143: The pattern 'false' can never match the type 'true' +comparisons.erl:144: The pattern 'true' can never match the type 'false' +comparisons.erl:145: The pattern 'true' can never match the type 'false' +comparisons.erl:146: The pattern 'false' can never match the type 'true' +comparisons.erl:147: The pattern 'false' can never match the type 'true' +comparisons.erl:152: The pattern 'false' can never match the type 'true' +comparisons.erl:153: The pattern 'false' can never match the type 'true' +comparisons.erl:154: The pattern 'true' can never match the type 'false' +comparisons.erl:155: The pattern 'true' can never match the type 'false' +comparisons.erl:157: The pattern 'true' can never match the type 'false' +comparisons.erl:158: The pattern 'true' can never match the type 'false' +comparisons.erl:159: The pattern 'false' can never match the type 'true' +comparisons.erl:160: The pattern 'false' can never match the type 'true' +comparisons.erl:161: The pattern 'true' can never match the type 'false' +comparisons.erl:162: The pattern 'true' can never match the type 'false' +comparisons.erl:163: The pattern 'false' can never match the type 'true' +comparisons.erl:164: The pattern 'false' can never match the type 'true' +comparisons.erl:165: The pattern 'true' can never match the type 'false' +comparisons.erl:166: The pattern 'true' can never match the type 'false' +comparisons.erl:167: The pattern 'false' can never match the type 'true' +comparisons.erl:168: The pattern 'false' can never match the type 'true' +comparisons.erl:169: The pattern 'true' can never match the type 'false' +comparisons.erl:170: The pattern 'true' can never match the type 'false' +comparisons.erl:171: The pattern 'false' can never match the type 'true' +comparisons.erl:172: The pattern 'false' can never match the type 'true' +comparisons.erl:173: The pattern 'true' can never match the type 'false' +comparisons.erl:174: The pattern 'true' can never match the type 'false' +comparisons.erl:175: The pattern 'false' can never match the type 'true' +comparisons.erl:176: The pattern 'false' can never match the type 'true' +comparisons.erl:186: The pattern 'false' can never match the type 'true' +comparisons.erl:187: The pattern 'false' can never match the type 'true' +comparisons.erl:188: The pattern 'true' can never match the type 'false' +comparisons.erl:189: The pattern 'true' can never match the type 'false' +comparisons.erl:190: The pattern 'false' can never match the type 'true' +comparisons.erl:191: The pattern 'false' can never match the type 'true' +comparisons.erl:192: The pattern 'true' can never match the type 'false' +comparisons.erl:193: The pattern 'true' can never match the type 'false' +comparisons.erl:203: The pattern 'false' can never match the type 'true' +comparisons.erl:204: The pattern 'false' can never match the type 'true' +comparisons.erl:205: The pattern 'true' can never match the type 'false' +comparisons.erl:206: The pattern 'true' can never match the type 'false' +comparisons.erl:208: The pattern 'true' can never match the type 'false' +comparisons.erl:209: The pattern 'true' can never match the type 'false' +comparisons.erl:210: The pattern 'false' can never match the type 'true' +comparisons.erl:211: The pattern 'false' can never match the type 'true' +comparisons.erl:221: The pattern 'true' can never match the type 'false' +comparisons.erl:222: The pattern 'true' can never match the type 'false' +comparisons.erl:223: The pattern 'false' can never match the type 'true' +comparisons.erl:224: The pattern 'false' can never match the type 'true' +comparisons.erl:225: The pattern 'true' can never match the type 'false' +comparisons.erl:226: The pattern 'true' can never match the type 'false' +comparisons.erl:227: The pattern 'false' can never match the type 'true' +comparisons.erl:228: The pattern 'false' can never match the type 'true' +comparisons.erl:242: The pattern 'false' can never match the type 'true' +comparisons.erl:243: The pattern 'false' can never match the type 'true' +comparisons.erl:244: The pattern 'true' can never match the type 'false' +comparisons.erl:245: The pattern 'true' can never match the type 'false' +comparisons.erl:246: The pattern 'false' can never match the type 'true' +comparisons.erl:247: The pattern 'false' can never match the type 'true' +comparisons.erl:248: The pattern 'true' can never match the type 'false' +comparisons.erl:249: The pattern 'true' can never match the type 'false' +comparisons.erl:251: The pattern 'true' can never match the type 'false' +comparisons.erl:252: The pattern 'true' can never match the type 'false' +comparisons.erl:253: The pattern 'false' can never match the type 'true' +comparisons.erl:254: The pattern 'false' can never match the type 'true' +comparisons.erl:263: The pattern 'false' can never match the type 'true' +comparisons.erl:264: The pattern 'false' can never match the type 'true' +comparisons.erl:265: The pattern 'true' can never match the type 'false' +comparisons.erl:266: The pattern 'true' can never match the type 'false' +comparisons.erl:268: The pattern 'true' can never match the type 'false' +comparisons.erl:269: The pattern 'true' can never match the type 'false' +comparisons.erl:270: The pattern 'false' can never match the type 'true' +comparisons.erl:271: The pattern 'false' can never match the type 'true' +comparisons.erl:272: The pattern 'true' can never match the type 'false' +comparisons.erl:273: The pattern 'true' can never match the type 'false' +comparisons.erl:274: The pattern 'false' can never match the type 'true' +comparisons.erl:275: The pattern 'false' can never match the type 'true' +comparisons.erl:293: The pattern 'false' can never match the type 'true' +comparisons.erl:294: The pattern 'false' can never match the type 'true' +comparisons.erl:295: The pattern 'true' can never match the type 'false' +comparisons.erl:296: The pattern 'true' can never match the type 'false' +comparisons.erl:311: The pattern 'true' can never match the type 'false' +comparisons.erl:312: The pattern 'true' can never match the type 'false' +comparisons.erl:313: The pattern 'false' can never match the type 'true' +comparisons.erl:314: The pattern 'false' can never match the type 'true' +comparisons.erl:44: The pattern 'false' can never match the type 'true' +comparisons.erl:45: The pattern 'false' can never match the type 'true' +comparisons.erl:46: The pattern 'true' can never match the type 'false' +comparisons.erl:47: The pattern 'true' can never match the type 'false' +comparisons.erl:48: The pattern 'false' can never match the type 'true' +comparisons.erl:49: The pattern 'false' can never match the type 'true' +comparisons.erl:50: The pattern 'true' can never match the type 'false' +comparisons.erl:51: The pattern 'true' can never match the type 'false' +comparisons.erl:52: The pattern 'false' can never match the type 'true' +comparisons.erl:53: The pattern 'false' can never match the type 'true' +comparisons.erl:54: The pattern 'true' can never match the type 'false' +comparisons.erl:55: The pattern 'true' can never match the type 'false' +comparisons.erl:69: The pattern 'false' can never match the type 'true' +comparisons.erl:70: The pattern 'false' can never match the type 'true' +comparisons.erl:71: The pattern 'true' can never match the type 'false' +comparisons.erl:72: The pattern 'true' can never match the type 'false' +comparisons.erl:73: The pattern 'false' can never match the type 'true' +comparisons.erl:74: The pattern 'false' can never match the type 'true' +comparisons.erl:75: The pattern 'true' can never match the type 'false' +comparisons.erl:76: The pattern 'true' can never match the type 'false' +comparisons.erl:77: The pattern 'false' can never match the type 'true' +comparisons.erl:78: The pattern 'false' can never match the type 'true' +comparisons.erl:79: The pattern 'true' can never match the type 'false' +comparisons.erl:80: The pattern 'true' can never match the type 'false' +comparisons.erl:94: The pattern 'false' can never match the type 'true' +comparisons.erl:95: The pattern 'false' can never match the type 'true' +comparisons.erl:96: The pattern 'true' can never match the type 'false' +comparisons.erl:97: The pattern 'true' can never match the type 'false' +comparisons.erl:98: The pattern 'false' can never match the type 'true' +comparisons.erl:99: The pattern 'false' can never match the type 'true' diff --git a/lib/dialyzer/test/small_SUITE_data/results/failing_funs b/lib/dialyzer/test/small_SUITE_data/results/failing_funs new file mode 100644 index 0000000000..a1fb22cbc6 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/failing_funs @@ -0,0 +1,20 @@ + +failing_funs.erl:101: The created fun has no local return +failing_funs.erl:104: The created fun has no local return +failing_funs.erl:127: The created fun has no local return +failing_funs.erl:135: The created fun has no local return +failing_funs.erl:138: The created fun has no local return +failing_funs.erl:13: Function foo3/0 has no local return +failing_funs.erl:13: The pattern 'b' can never match the type 'a' +failing_funs.erl:161: The created fun has no local return +failing_funs.erl:169: The created fun has no local return +failing_funs.erl:172: The created fun has no local return +failing_funs.erl:17: The pattern 'b' can never match the type 'a' +failing_funs.erl:195: The created fun has no local return +failing_funs.erl:203: The created fun has no local return +failing_funs.erl:206: The created fun has no local return +failing_funs.erl:229: The created fun has no local return +failing_funs.erl:55: The created fun has no local return +failing_funs.erl:62: The created fun has no local return +failing_funs.erl:69: The created fun has no local return +failing_funs.erl:76: The created fun has no local return diff --git a/lib/dialyzer/test/small_SUITE_data/results/flatten b/lib/dialyzer/test/small_SUITE_data/results/flatten index 4571214e49..8aa44dd002 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/flatten +++ b/lib/dialyzer/test/small_SUITE_data/results/flatten @@ -1,2 +1,2 @@ -flatten.erl:17: The call lists:flatten(nonempty_improper_list(atom() | binary() | [any()] | char(),atom())) will never return since it differs in the 1st argument from the success typing arguments: ([any()]) +flatten.erl:17: The call lists:flatten(nonempty_improper_list(atom() | [any()] | char(),atom())) will never return since it differs in the 1st argument from the success typing arguments: ([any()]) diff --git a/lib/dialyzer/test/small_SUITE_data/src/binary_lc_bug.erl b/lib/dialyzer/test/small_SUITE_data/src/binary_lc_bug.erl new file mode 100644 index 0000000000..c1e82bfa59 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/binary_lc_bug.erl @@ -0,0 +1,8 @@ +-module(test). + +-export([bin_compr/0]). + +bin_compr() -> +% [ 0 || {N, V} <- [{a, b}] ]. % Works ok + << <<>> || {A, B} <- [{a, b}] >>. % Complains +% << <<>> || X <- [{a, b}] >>. % Works ok diff --git a/lib/dialyzer/test/small_SUITE_data/src/codec_can.erl b/lib/dialyzer/test/small_SUITE_data/src/codec_can.erl new file mode 100644 index 0000000000..8abf872b37 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/codec_can.erl @@ -0,0 +1,35 @@ +%%--------------------------------------------------------------------- +%% From: Peer Stritzinger +%% Date: 1 May 2011 +%% Subject: Dialyzer v2.2.0 crash +%% +%% Binaries of the form <<_:N,_:_*M>> in specs resulted in a crash: +%% dialyzer: Analysis failed with error: {{case_clause,8}, +%% [{erl_types,t_form_to_string,1}, +%% {erl_types,t_form_to_string,1}, +%% {dialyzer_contracts,contract_to_string_1,1}, +%% {dialyzer_contracts,extra_contract_warning,6}, +%% {dialyzer_contracts,picky_contract_check,7}, +%% because function erl_types:t_form_to_string/1 was not the inverse +%% of erl_types:t_to_string/2. +%% +%% Fixed on the same date and send to OTP for inclusion. +%%--------------------------------------------------------------------- +-module(codec_can). + +-export([recv/3, decode/1]). + +-record(can_pkt, {id, data :: binary(), timestamp}). + +-type can_pkt() :: #can_pkt{}. +-type channel() :: atom() | pid() | {atom(),_}. + +-spec recv(<<_:64,_:_*8>>, fun((can_pkt()) -> R), channel()) -> R. +recv(Packet, Fun, Chan) -> + #can_pkt{id = Can_id, data = Can_data} = P = decode(Packet), + Fun(P). + +-spec decode(<<_:64,_:_*8>>) -> #can_pkt{id::<<_:11>>,timestamp::char()}. +decode(<<_:12, Len:4, Timestamp:16, 0:3, Id:11/bitstring, 0:18, + Data:Len/binary, _/binary>>) -> + #can_pkt{id = Id, data = Data, timestamp = Timestamp}. diff --git a/lib/dialyzer/test/small_SUITE_data/src/common_eunit.erl b/lib/dialyzer/test/small_SUITE_data/src/common_eunit.erl new file mode 100644 index 0000000000..bca390068e --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/common_eunit.erl @@ -0,0 +1,121 @@ +%%===================================================================== +%% Program with an erroneous type declaration that caused dialyzer to +%% go into an infinite loop. There are some comments that explain the +%% symptoms and the culprit: the return of test_fun() is erroneous and +%% its type should read +%% fun((config()) -> test_rep() | [test_rep()]) +%% instead. But this should not throw dialyzer into an infinite loop. +%% This concerned dialyzer in R14B02 (and probably prior). +%%===================================================================== +-module(common_eunit). + +-export([expand_cases/2]). + +-type test_name() :: atom() | {'group', atom()}. + +-type test_rep() :: {{atom(), atom(), arity()}, fun()} + | {'setup', fun(), fun()} + | {'setup', fun(), fun(), fun()} + | {atom(), test_rep()} + | {atom(), term(), test_rep()}. + +-type config() :: [proplists:property()]. + +-type control() :: tuple() | atom(). + +%% The combination of the following type and the (erroneous) spec for +%% expand_cases/2 is the reason for the infinite loop in dialyzer. +-type test_fun() :: fun((config()) -> test_rep()). + +%% If one comments out this spec the infinite loop disappears. +-spec expand_cases(atom(), test_name() | [test_name()]) -> test_fun(). +expand_cases(Module, Cases) -> + if is_list(Cases) -> + TestFuns = [expand_case(Module, Case) || Case <- Cases], + fun(Config) -> [F(Config) || F <- TestFuns] end; + is_atom(Cases); is_tuple(Cases) -> + expand_cases(Module, [Cases]) + end. + +-spec expand_case(atom(), test_name()) -> test_fun(). +expand_case(Module, CaseName) when is_atom(CaseName) -> + TestFun = fun(Config) -> + {{Module, CaseName, 1}, + fun() -> apply(Module, CaseName, [Config]) end} + end, + setup_wrapper(Module, TestFun, {init_per_testcase, [CaseName]}, + {end_per_testcase, [CaseName]}); +expand_case(Module, {group, GroupName}) -> + {Control, Cases} = group_specification(Module, GroupName), + TestFun = control_wrapper(Control, expand_cases(Module, Cases)), + setup_wrapper(Module, TestFun, {init_per_group, [GroupName]}, + {end_per_group, [GroupName]}). + +-spec control_wrapper([control()], test_fun()) -> test_fun(). +control_wrapper([Control|T], TestFun0) -> + TestFun1 = control_wrapper(T, TestFun0), + fun(Config) -> + case Control of + parallel -> + {inparallel, TestFun1(Config)}; + sequence -> + {inorder, TestFun1(Config)}; + {timetrap, Time} -> + Seconds = case Time of + {hours, Hs} -> Hs * 60 * 60; + {minutes, Ms} -> Ms * 60; + {seconds, Ss} -> Ss; + MSs -> MSs / 1000 + end, + {timeout, Seconds, TestFun1(Config)}; + C when is_atom(C) -> + {C, TestFun1(Config)}; + {C, Arg} -> + {C, Arg, TestFun1(Config)} + end + end; +control_wrapper([], TestFun) -> + TestFun. + +-spec setup_wrapper(atom(), test_fun(), Callback, Callback) -> test_fun() + when Callback :: {atom(), list()}. +setup_wrapper(Module, TestFun, {Setup, SA}, {Cleanup, CA}) -> + case erlang:function_exported(Module, Setup, length(SA) + 1) of + true -> + case erlang:function_exported(Module, Cleanup, length(CA) + 1) of + true -> + fun(Config0) -> + {setup, + fun() -> + apply(Module, Setup, SA ++ [Config0]) + end, + fun(Config1) -> + apply(Module, Cleanup, CA ++ [Config1]) + end, + TestFun} + end; + false -> + fun(Config) -> + {setup, + fun() -> + apply(Module, Setup, SA ++ [Config]) + end, + TestFun} + end + end; + false -> + TestFun + end. + +-spec group_specification(atom(), atom()) -> {[control()], [test_name()]}. +group_specification(Module, GroupName) -> + case lists:keyfind(GroupName, 1, Module:groups()) of + {_, Control, Cases} when is_list(Control), is_list(Cases) -> + {Control, Cases}; + {_, Cases} when is_list(Cases) -> + {[], Cases}; + false -> + exit({missing_group, GroupName}); + _ -> + exit({bad_group_spec, GroupName}) + end. diff --git a/lib/dialyzer/test/small_SUITE_data/src/comparisons.erl b/lib/dialyzer/test/small_SUITE_data/src/comparisons.erl new file mode 100644 index 0000000000..70e3cb6af4 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/comparisons.erl @@ -0,0 +1,322 @@ +-module(comparisons). + +-compile(export_all). + +-define(r, get(r)). + +integer() -> integer(?r). +integer(X) when is_integer(X) -> X. + +mfloat() -> float(?r). +mfloat(X) when is_float(X) -> X. + +atom() -> atom(?r). +atom(X) when is_atom(X) -> X. + +tuple() -> tuple(?r). +tuple(X) when is_tuple(X) -> X. + +list() -> list(?r). +list(X) when is_list(X) -> X. + +i() -> integer(). +f() -> mfloat(). +n() -> case ?r of 1 -> i(); 2 -> f() end. +a() -> atom(). +t() -> tuple(). +l() -> list(). +na() -> case ?r of 1 -> n(); 2 -> a() end. +at() -> case ?r of 1 -> t(); 2 -> a() end. +tl() -> case ?r of 1 -> t(); 2 -> l() end. + +test_i_ll_i() -> case i() < i() of true -> maybe; false -> maybe_too end. +test_i_le_i() -> case i() =< i() of true -> maybe; false -> maybe_too end. +test_i_gg_i() -> case i() > i() of true -> maybe; false -> maybe_too end. +test_i_ge_i() -> case i() >= i() of true -> maybe; false -> maybe_too end. +test_i_ll_f() -> case i() < f() of true -> maybe; false -> maybe_too end. +test_i_le_f() -> case i() =< f() of true -> maybe; false -> maybe_too end. +test_i_gg_f() -> case i() > f() of true -> maybe; false -> maybe_too end. +test_i_ge_f() -> case i() >= f() of true -> maybe; false -> maybe_too end. +test_i_ll_n() -> case i() < n() of true -> maybe; false -> maybe_too end. +test_i_le_n() -> case i() =< n() of true -> maybe; false -> maybe_too end. +test_i_gg_n() -> case i() > n() of true -> maybe; false -> maybe_too end. +test_i_ge_n() -> case i() >= n() of true -> maybe; false -> maybe_too end. +test_i_ll_a() -> case i() < a() of true -> always; false -> never end. +test_i_le_a() -> case i() =< a() of true -> always; false -> never end. +test_i_gg_a() -> case i() > a() of true -> never; false -> always end. +test_i_ge_a() -> case i() >= a() of true -> never; false -> always end. +test_i_ll_t() -> case i() < t() of true -> always; false -> never end. +test_i_le_t() -> case i() =< t() of true -> always; false -> never end. +test_i_gg_t() -> case i() > t() of true -> never; false -> always end. +test_i_ge_t() -> case i() >= t() of true -> never; false -> always end. +test_i_ll_l() -> case i() < l() of true -> always; false -> never end. +test_i_le_l() -> case i() =< l() of true -> always; false -> never end. +test_i_gg_l() -> case i() > l() of true -> never; false -> always end. +test_i_ge_l() -> case i() >= l() of true -> never; false -> always end. + +test_f_ll_i() -> case f() < i() of true -> maybe; false -> maybe_too end. +test_f_le_i() -> case f() =< i() of true -> maybe; false -> maybe_too end. +test_f_gg_i() -> case f() > i() of true -> maybe; false -> maybe_too end. +test_f_ge_i() -> case f() >= i() of true -> maybe; false -> maybe_too end. +test_f_ll_f() -> case f() < f() of true -> maybe; false -> maybe_too end. +test_f_le_f() -> case f() =< f() of true -> maybe; false -> maybe_too end. +test_f_gg_f() -> case f() > f() of true -> maybe; false -> maybe_too end. +test_f_ge_f() -> case f() >= f() of true -> maybe; false -> maybe_too end. +test_f_ll_n() -> case f() < n() of true -> maybe; false -> maybe_too end. +test_f_le_n() -> case f() =< n() of true -> maybe; false -> maybe_too end. +test_f_gg_n() -> case f() > n() of true -> maybe; false -> maybe_too end. +test_f_ge_n() -> case f() >= n() of true -> maybe; false -> maybe_too end. +test_f_ll_a() -> case f() < a() of true -> always; false -> never end. +test_f_le_a() -> case f() =< a() of true -> always; false -> never end. +test_f_gg_a() -> case f() > a() of true -> never; false -> always end. +test_f_ge_a() -> case f() >= a() of true -> never; false -> always end. +test_f_ll_t() -> case f() < t() of true -> always; false -> never end. +test_f_le_t() -> case f() =< t() of true -> always; false -> never end. +test_f_gg_t() -> case f() > t() of true -> never; false -> always end. +test_f_ge_t() -> case f() >= t() of true -> never; false -> always end. +test_f_ll_l() -> case f() < l() of true -> always; false -> never end. +test_f_le_l() -> case f() =< l() of true -> always; false -> never end. +test_f_gg_l() -> case f() > l() of true -> never; false -> always end. +test_f_ge_l() -> case f() >= l() of true -> never; false -> always end. + +test_n_ll_i() -> case n() < i() of true -> maybe; false -> maybe_too end. +test_n_le_i() -> case n() =< i() of true -> maybe; false -> maybe_too end. +test_n_gg_i() -> case n() > i() of true -> maybe; false -> maybe_too end. +test_n_ge_i() -> case n() >= i() of true -> maybe; false -> maybe_too end. +test_n_ll_f() -> case n() < f() of true -> maybe; false -> maybe_too end. +test_n_le_f() -> case n() =< f() of true -> maybe; false -> maybe_too end. +test_n_gg_f() -> case n() > f() of true -> maybe; false -> maybe_too end. +test_n_ge_f() -> case n() >= f() of true -> maybe; false -> maybe_too end. +test_n_ll_n() -> case n() < n() of true -> maybe; false -> maybe_too end. +test_n_le_n() -> case n() =< n() of true -> maybe; false -> maybe_too end. +test_n_gg_n() -> case n() > n() of true -> maybe; false -> maybe_too end. +test_n_ge_n() -> case n() >= n() of true -> maybe; false -> maybe_too end. +test_n_ll_a() -> case n() < a() of true -> always; false -> never end. +test_n_le_a() -> case n() =< a() of true -> always; false -> never end. +test_n_gg_a() -> case n() > a() of true -> never; false -> always end. +test_n_ge_a() -> case n() >= a() of true -> never; false -> always end. +test_n_ll_t() -> case n() < t() of true -> always; false -> never end. +test_n_le_t() -> case n() =< t() of true -> always; false -> never end. +test_n_gg_t() -> case n() > t() of true -> never; false -> always end. +test_n_ge_t() -> case n() >= t() of true -> never; false -> always end. +test_n_ll_l() -> case n() < l() of true -> always; false -> never end. +test_n_le_l() -> case n() =< l() of true -> always; false -> never end. +test_n_gg_l() -> case n() > l() of true -> never; false -> always end. +test_n_ge_l() -> case n() >= l() of true -> never; false -> always end. + +test_a_ll_i() -> case a() < i() of true -> never; false -> always end. +test_a_le_i() -> case a() =< i() of true -> never; false -> always end. +test_a_gg_i() -> case a() > i() of true -> always; false -> never end. +test_a_ge_i() -> case a() >= i() of true -> always; false -> never end. +test_a_ll_f() -> case a() < f() of true -> never; false -> always end. +test_a_le_f() -> case a() =< f() of true -> never; false -> always end. +test_a_gg_f() -> case a() > f() of true -> always; false -> never end. +test_a_ge_f() -> case a() >= f() of true -> always; false -> never end. +test_a_ll_n() -> case a() < n() of true -> never; false -> always end. +test_a_le_n() -> case a() =< n() of true -> never; false -> always end. +test_a_gg_n() -> case a() > n() of true -> always; false -> never end. +test_a_ge_n() -> case a() >= n() of true -> always; false -> never end. +test_a_ll_a() -> case a() < a() of true -> maybe; false -> maybe_too end. +test_a_le_a() -> case a() =< a() of true -> maybe; false -> maybe_too end. +test_a_gg_a() -> case a() > a() of true -> maybe; false -> maybe_too end. +test_a_ge_a() -> case a() >= a() of true -> maybe; false -> maybe_too end. +test_a_ll_t() -> case a() < t() of true -> always; false -> never end. +test_a_le_t() -> case a() =< t() of true -> always; false -> never end. +test_a_gg_t() -> case a() > t() of true -> never; false -> always end. +test_a_ge_t() -> case a() >= t() of true -> never; false -> always end. +test_a_ll_l() -> case a() < l() of true -> always; false -> never end. +test_a_le_l() -> case a() =< l() of true -> always; false -> never end. +test_a_gg_l() -> case a() > l() of true -> never; false -> always end. +test_a_ge_l() -> case a() >= l() of true -> never; false -> always end. + +test_t_ll_i() -> case t() < i() of true -> never; false -> always end. +test_t_le_i() -> case t() =< i() of true -> never; false -> always end. +test_t_gg_i() -> case t() > i() of true -> always; false -> never end. +test_t_ge_i() -> case t() >= i() of true -> always; false -> never end. +test_t_ll_f() -> case t() < f() of true -> never; false -> always end. +test_t_le_f() -> case t() =< f() of true -> never; false -> always end. +test_t_gg_f() -> case t() > f() of true -> always; false -> never end. +test_t_ge_f() -> case t() >= f() of true -> always; false -> never end. +test_t_ll_n() -> case t() < n() of true -> never; false -> always end. +test_t_le_n() -> case t() =< n() of true -> never; false -> always end. +test_t_gg_n() -> case t() > n() of true -> always; false -> never end. +test_t_ge_n() -> case t() >= n() of true -> always; false -> never end. +test_t_ll_a() -> case t() < a() of true -> never; false -> always end. +test_t_le_a() -> case t() =< a() of true -> never; false -> always end. +test_t_gg_a() -> case t() > a() of true -> always; false -> never end. +test_t_ge_a() -> case t() >= a() of true -> always; false -> never end. +test_t_ll_t() -> case t() < t() of true -> maybe; false -> maybe_too end. +test_t_le_t() -> case t() =< t() of true -> maybe; false -> maybe_too end. +test_t_gg_t() -> case t() > t() of true -> maybe; false -> maybe_too end. +test_t_ge_t() -> case t() >= t() of true -> maybe; false -> maybe_too end. +test_t_ll_l() -> case t() < l() of true -> always; false -> never end. +test_t_le_l() -> case t() =< l() of true -> always; false -> never end. +test_t_gg_l() -> case t() > l() of true -> never; false -> always end. +test_t_ge_l() -> case t() >= l() of true -> never; false -> always end. + +test_l_ll_i() -> case l() < i() of true -> never; false -> always end. +test_l_le_i() -> case l() =< i() of true -> never; false -> always end. +test_l_gg_i() -> case l() > i() of true -> always; false -> never end. +test_l_ge_i() -> case l() >= i() of true -> always; false -> never end. +test_l_ll_f() -> case l() < f() of true -> never; false -> always end. +test_l_le_f() -> case l() =< f() of true -> never; false -> always end. +test_l_gg_f() -> case l() > f() of true -> always; false -> never end. +test_l_ge_f() -> case l() >= f() of true -> always; false -> never end. +test_l_ll_n() -> case l() < n() of true -> never; false -> always end. +test_l_le_n() -> case l() =< n() of true -> never; false -> always end. +test_l_gg_n() -> case l() > n() of true -> always; false -> never end. +test_l_ge_n() -> case l() >= n() of true -> always; false -> never end. +test_l_ll_a() -> case l() < a() of true -> never; false -> always end. +test_l_le_a() -> case l() =< a() of true -> never; false -> always end. +test_l_gg_a() -> case l() > a() of true -> always; false -> never end. +test_l_ge_a() -> case l() >= a() of true -> always; false -> never end. +test_l_ll_t() -> case l() < t() of true -> never; false -> always end. +test_l_le_t() -> case l() =< t() of true -> never; false -> always end. +test_l_gg_t() -> case l() > t() of true -> always; false -> never end. +test_l_ge_t() -> case l() >= t() of true -> always; false -> never end. +test_l_ll_l() -> case l() < l() of true -> maybe; false -> maybe_too end. +test_l_le_l() -> case l() =< l() of true -> maybe; false -> maybe_too end. +test_l_gg_l() -> case l() > l() of true -> maybe; false -> maybe_too end. +test_l_ge_l() -> case l() >= l() of true -> maybe; false -> maybe_too end. + +test_n_ll_na() -> case n() < na() of true -> maybe; false -> maybe_too end. +test_n_le_na() -> case n() =< na() of true -> maybe; false -> maybe_too end. +test_n_gg_na() -> case n() > na() of true -> maybe; false -> maybe_too end. +test_n_ge_na() -> case n() >= na() of true -> maybe; false -> maybe_too end. +test_n_ll_at() -> case n() < at() of true -> always; false -> never end. +test_n_le_at() -> case n() =< at() of true -> always; false -> never end. +test_n_gg_at() -> case n() > at() of true -> never; false -> always end. +test_n_ge_at() -> case n() >= at() of true -> never; false -> always end. +test_n_ll_tl() -> case n() < tl() of true -> always; false -> never end. +test_n_le_tl() -> case n() =< tl() of true -> always; false -> never end. +test_n_gg_tl() -> case n() > tl() of true -> never; false -> always end. +test_n_ge_tl() -> case n() >= tl() of true -> never; false -> always end. + +test_a_ll_na() -> case a() < na() of true -> maybe; false -> maybe_too end. +test_a_le_na() -> case a() =< na() of true -> maybe; false -> maybe_too end. +test_a_gg_na() -> case a() > na() of true -> maybe; false -> maybe_too end. +test_a_ge_na() -> case a() >= na() of true -> maybe; false -> maybe_too end. +test_a_ll_at() -> case a() < at() of true -> maybe; false -> maybe_too end. +test_a_le_at() -> case a() =< at() of true -> maybe; false -> maybe_too end. +test_a_gg_at() -> case a() > at() of true -> maybe; false -> maybe_too end. +test_a_ge_at() -> case a() >= at() of true -> maybe; false -> maybe_too end. +test_a_ll_tl() -> case a() < tl() of true -> always; false -> never end. +test_a_le_tl() -> case a() =< tl() of true -> always; false -> never end. +test_a_gg_tl() -> case a() > tl() of true -> never; false -> always end. +test_a_ge_tl() -> case a() >= tl() of true -> never; false -> always end. + +test_t_ll_na() -> case t() < na() of true -> never; false -> always end. +test_t_le_na() -> case t() =< na() of true -> never; false -> always end. +test_t_gg_na() -> case t() > na() of true -> always; false -> never end. +test_t_ge_na() -> case t() >= na() of true -> always; false -> never end. +test_t_ll_at() -> case t() < at() of true -> maybe; false -> maybe_too end. +test_t_le_at() -> case t() =< at() of true -> maybe; false -> maybe_too end. +test_t_gg_at() -> case t() > at() of true -> maybe; false -> maybe_too end. +test_t_ge_at() -> case t() >= at() of true -> maybe; false -> maybe_too end. +test_t_ll_tl() -> case t() < tl() of true -> maybe; false -> maybe_too end. +test_t_le_tl() -> case t() =< tl() of true -> maybe; false -> maybe_too end. +test_t_gg_tl() -> case t() > tl() of true -> maybe; false -> maybe_too end. +test_t_ge_tl() -> case t() >= tl() of true -> maybe; false -> maybe_too end. + +test_l_ll_na() -> case l() < na() of true -> never; false -> always end. +test_l_le_na() -> case l() =< na() of true -> never; false -> always end. +test_l_gg_na() -> case l() > na() of true -> always; false -> never end. +test_l_ge_na() -> case l() >= na() of true -> always; false -> never end. +test_l_ll_at() -> case l() < at() of true -> never; false -> always end. +test_l_le_at() -> case l() =< at() of true -> never; false -> always end. +test_l_gg_at() -> case l() > at() of true -> always; false -> never end. +test_l_ge_at() -> case l() >= at() of true -> always; false -> never end. +test_l_ll_tl() -> case l() < tl() of true -> maybe; false -> maybe_too end. +test_l_le_tl() -> case l() =< tl() of true -> maybe; false -> maybe_too end. +test_l_gg_tl() -> case l() > tl() of true -> maybe; false -> maybe_too end. +test_l_ge_tl() -> case l() >= tl() of true -> maybe; false -> maybe_too end. + +test_na_ll_n() -> case na() < n() of true -> maybe; false -> maybe_too end. +test_na_le_n() -> case na() =< n() of true -> maybe; false -> maybe_too end. +test_na_gg_n() -> case na() > n() of true -> maybe; false -> maybe_too end. +test_na_ge_n() -> case na() >= n() of true -> maybe; false -> maybe_too end. +test_na_ll_a() -> case na() < a() of true -> maybe; false -> maybe_too end. +test_na_le_a() -> case na() =< a() of true -> maybe; false -> maybe_too end. +test_na_gg_a() -> case na() > a() of true -> maybe; false -> maybe_too end. +test_na_ge_a() -> case na() >= a() of true -> maybe; false -> maybe_too end. +test_na_ll_t() -> case na() < t() of true -> always; false -> never end. +test_na_le_t() -> case na() =< t() of true -> always; false -> never end. +test_na_gg_t() -> case na() > t() of true -> never; false -> always end. +test_na_ge_t() -> case na() >= t() of true -> never; false -> always end. +test_na_ll_l() -> case na() < l() of true -> always; false -> never end. +test_na_le_l() -> case na() =< l() of true -> always; false -> never end. +test_na_gg_l() -> case na() > l() of true -> never; false -> always end. +test_na_ge_l() -> case na() >= l() of true -> never; false -> always end. + +test_at_ll_n() -> case at() < n() of true -> never; false -> always end. +test_at_le_n() -> case at() =< n() of true -> never; false -> always end. +test_at_gg_n() -> case at() > n() of true -> always; false -> never end. +test_at_ge_n() -> case at() >= n() of true -> always; false -> never end. +test_at_ll_a() -> case at() < a() of true -> maybe; false -> maybe_too end. +test_at_le_a() -> case at() =< a() of true -> maybe; false -> maybe_too end. +test_at_gg_a() -> case at() > a() of true -> maybe; false -> maybe_too end. +test_at_ge_a() -> case at() >= a() of true -> maybe; false -> maybe_too end. +test_at_ll_t() -> case at() < t() of true -> maybe; false -> maybe_too end. +test_at_le_t() -> case at() =< t() of true -> maybe; false -> maybe_too end. +test_at_gg_t() -> case at() > t() of true -> maybe; false -> maybe_too end. +test_at_ge_t() -> case at() >= t() of true -> maybe; false -> maybe_too end. +test_at_ll_l() -> case at() < l() of true -> always; false -> never end. +test_at_le_l() -> case at() =< l() of true -> always; false -> never end. +test_at_gg_l() -> case at() > l() of true -> never; false -> always end. +test_at_ge_l() -> case at() >= l() of true -> never; false -> always end. + +test_tl_ll_n() -> case tl() < n() of true -> never; false -> always end. +test_tl_le_n() -> case tl() =< n() of true -> never; false -> always end. +test_tl_gg_n() -> case tl() > n() of true -> always; false -> never end. +test_tl_ge_n() -> case tl() >= n() of true -> always; false -> never end. +test_tl_ll_a() -> case tl() < a() of true -> never; false -> always end. +test_tl_le_a() -> case tl() =< a() of true -> never; false -> always end. +test_tl_gg_a() -> case tl() > a() of true -> always; false -> never end. +test_tl_ge_a() -> case tl() >= a() of true -> always; false -> never end. +test_tl_ll_t() -> case tl() < t() of true -> maybe; false -> maybe_too end. +test_tl_le_t() -> case tl() =< t() of true -> maybe; false -> maybe_too end. +test_tl_gg_t() -> case tl() > t() of true -> maybe; false -> maybe_too end. +test_tl_ge_t() -> case tl() >= t() of true -> maybe; false -> maybe_too end. +test_tl_ll_l() -> case tl() < l() of true -> maybe; false -> maybe_too end. +test_tl_le_l() -> case tl() =< l() of true -> maybe; false -> maybe_too end. +test_tl_gg_l() -> case tl() > l() of true -> maybe; false -> maybe_too end. +test_tl_ge_l() -> case tl() >= l() of true -> maybe; false -> maybe_too end. + +test_na_ll_na() -> case na() < na() of true -> maybe; false -> maybe_too end. +test_na_le_na() -> case na() =< na() of true -> maybe; false -> maybe_too end. +test_na_gg_na() -> case na() > na() of true -> maybe; false -> maybe_too end. +test_na_ge_na() -> case na() >= na() of true -> maybe; false -> maybe_too end. +test_na_ll_at() -> case na() < at() of true -> maybe; false -> maybe_too end. +test_na_le_at() -> case na() =< at() of true -> maybe; false -> maybe_too end. +test_na_gg_at() -> case na() > at() of true -> maybe; false -> maybe_too end. +test_na_ge_at() -> case na() >= at() of true -> maybe; false -> maybe_too end. +test_na_ll_tl() -> case na() < tl() of true -> always; false -> never end. +test_na_le_tl() -> case na() =< tl() of true -> always; false -> never end. +test_na_gg_tl() -> case na() > tl() of true -> never; false -> always end. +test_na_ge_tl() -> case na() >= tl() of true -> never; false -> always end. + +test_at_ll_na() -> case at() < na() of true -> maybe; false -> maybe_too end. +test_at_le_na() -> case at() =< na() of true -> maybe; false -> maybe_too end. +test_at_gg_na() -> case at() > na() of true -> maybe; false -> maybe_too end. +test_at_ge_na() -> case at() >= na() of true -> maybe; false -> maybe_too end. +test_at_ll_at() -> case at() < at() of true -> maybe; false -> maybe_too end. +test_at_le_at() -> case at() =< at() of true -> maybe; false -> maybe_too end. +test_at_gg_at() -> case at() > at() of true -> maybe; false -> maybe_too end. +test_at_ge_at() -> case at() >= at() of true -> maybe; false -> maybe_too end. +test_at_ll_tl() -> case at() < tl() of true -> maybe; false -> maybe_too end. +test_at_le_tl() -> case at() =< tl() of true -> maybe; false -> maybe_too end. +test_at_gg_tl() -> case at() > tl() of true -> maybe; false -> maybe_too end. +test_at_ge_tl() -> case at() >= tl() of true -> maybe; false -> maybe_too end. + +test_tl_ll_na() -> case tl() < na() of true -> never; false -> always end. +test_tl_le_na() -> case tl() =< na() of true -> never; false -> always end. +test_tl_gg_na() -> case tl() > na() of true -> always; false -> never end. +test_tl_ge_na() -> case tl() >= na() of true -> always; false -> never end. +test_tl_ll_at() -> case tl() < at() of true -> maybe; false -> maybe_too end. +test_tl_le_at() -> case tl() =< at() of true -> maybe; false -> maybe_too end. +test_tl_gg_at() -> case tl() > at() of true -> maybe; false -> maybe_too end. +test_tl_ge_at() -> case tl() >= at() of true -> maybe; false -> maybe_too end. +test_tl_ll_tl() -> case tl() < tl() of true -> maybe; false -> maybe_too end. +test_tl_le_tl() -> case tl() =< tl() of true -> maybe; false -> maybe_too end. +test_tl_gg_tl() -> case tl() > tl() of true -> maybe; false -> maybe_too end. +test_tl_ge_tl() -> case tl() >= tl() of true -> maybe; false -> maybe_too end. diff --git a/lib/dialyzer/test/small_SUITE_data/src/failing_funs.erl b/lib/dialyzer/test/small_SUITE_data/src/failing_funs.erl new file mode 100644 index 0000000000..1784c4a494 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/failing_funs.erl @@ -0,0 +1,250 @@ +-module(failing_funs). + +-compile(export_all). + +% Crashes with system call. No spec. +foo1() -> halt(). + +% Crashes with system call. With spec. +-spec foo2() -> no_return(). +foo2() -> halt(). + +% Crashes on its own. No spec. +foo3() -> case a of b -> ok end. + +% Crashes on its own. With spec. +-spec foo4() -> no_return(). +foo4() -> case a of b -> ok end. + +% Creates fun that crashes with system call. No spec. +foo5() -> fun() -> halt() end. + +% Creates fun that crashes with system call. With spec. +-spec foo6() -> fun(() -> no_return()). +foo6() -> fun() -> halt() end. + +% Creates fun from named fun that will crash. Neither have spec. +foo7() -> fun foo1/0. + +% Creates fun from named fun that will crash. Has spec. +-spec foo8() -> fun(() -> no_return()). +foo8() -> fun foo1/0. + +% Creates fun from named fun that will crash. Named has spec. +foo9() -> fun foo2/0. + +% Creates fun from named fun that will crash. Both have specs. +-spec foo10() -> fun(() -> no_return()). +foo10() -> fun foo2/0. + +% Creates fun from named fun that will crash. Neither have spec. +foo11() -> fun foo3/0. + +% Creates fun from named fun that will crash. Has spec. +-spec foo12() -> fun(() -> no_return()). +foo12() -> fun foo3/0. + +% Creates fun from named fun that will crash. Named has spec. +foo13() -> fun foo4/0. + +% Creates fun from named fun that will crash. Both have specs. +-spec foo14() -> fun(() -> no_return()). +foo14() -> fun foo4/0. + +% Creates fun calling a named fun that will crash. Neither have spec. +foo15() -> fun() -> foo1() end. + +% Creates fun calling a named fun that will crash. Has spec. +-spec foo16() -> fun(() -> no_return()). +foo16() -> fun() -> foo1() end. + +% Creates fun calling a named fun that will crash. Named has spec. +foo17() -> fun() -> foo2() end. + +% Creates fun calling a named fun that will crash. Both have specs. +-spec foo18() -> fun(() -> no_return()). +foo18() -> fun() -> foo2() end. + +% Creates fun calling a named fun that will crash. Neither have spec. +foo19() -> fun() -> foo3() end. + +% Creates fun calling a named fun that will crash. Has spec. +-spec foo20() -> fun(() -> no_return()). +foo20() -> fun() -> foo3() end. + +% Creates fun calling a named fun that will crash. Named has spec. +foo21() -> fun() -> foo4() end. + +% Creates fun calling a named fun that will crash. Both have specs. +-spec foo22() -> fun(() -> no_return()). +foo22() -> fun() -> foo4() end. + +% Creates two funs with no local return and will return one or die. No spec. +foo23() -> + Bomb = fun() -> halt() end, + case get(42) of + a -> Bomb(); + b -> fun() -> halt() end + end. + +% Creates two funs with no local return and will return one or die. With spec. +-spec foo24() -> fun(() -> no_return()). +foo24() -> + Bomb = fun() -> halt() end, + case get(42) of + a -> Bomb(); + b -> fun() -> halt() end + end. + +% Creates two funs with no local return and will return one or die. No spec. +foo25() -> + Bomb = fun() -> foo1() end, + case get(42) of + a -> Bomb(); + b -> fun() -> foo1() end + end. + +% Creates two funs with no local return and will return one or die. With spec. +-spec foo26() -> fun(() -> no_return()). +foo26() -> + Bomb = fun foo1/0, + case get(42) of + a -> Bomb(); + b -> fun foo1/0 + end. + +% Creates two funs with no local return and will return one or die. No spec. +foo27() -> + Bomb = fun foo1/0, + case get(42) of + a -> Bomb(); + b -> fun foo1/0 + end. + +% Creates two funs with no local return and will return one or die. With spec. +-spec foo28() -> fun(() -> no_return()). +foo28() -> + Bomb = fun() -> foo1() end, + case get(42) of + a -> Bomb(); + b -> fun() -> foo1() end + end. + +% Creates two funs with no local return and will return one or die. No spec. +foo29() -> + Bomb = fun() -> foo2() end, + case get(42) of + a -> Bomb(); + b -> fun() -> foo2() end + end. + +% Creates two funs with no local return and will return one or die. With spec. +-spec foo30() -> fun(() -> no_return()). +foo30() -> + Bomb = fun foo2/0, + case get(42) of + a -> Bomb(); + b -> fun foo2/0 + end. + +% Creates two funs with no local return and will return one or die. No spec. +foo31() -> + Bomb = fun foo2/0, + case get(42) of + a -> Bomb(); + b -> fun foo2/0 + end. + +% Creates two funs with no local return and will return one or die. With spec. +-spec foo32() -> fun(() -> no_return()). +foo32() -> + Bomb = fun() -> foo2() end, + case get(42) of + a -> Bomb(); + b -> fun() -> foo2() end + end. + +% Creates two funs with no local return and will return one or die. No spec. +foo33() -> + Bomb = fun() -> foo3() end, + case get(42) of + a -> Bomb(); + b -> fun() -> foo3() end + end. + +% Creates two funs with no local return and will return one or die. With spec. +-spec foo34() -> fun(() -> no_return()). +foo34() -> + Bomb = fun foo3/0, + case get(42) of + a -> Bomb(); + b -> fun foo3/0 + end. + +% Creates two funs with no local return and will return one or die. No spec. +foo35() -> + Bomb = fun foo3/0, + case get(42) of + a -> Bomb(); + b -> fun foo3/0 + end. + +% Creates two funs with no local return and will return one or die. With spec. +-spec foo36() -> fun(() -> no_return()). +foo36() -> + Bomb = fun() -> foo3() end, + case get(42) of + a -> Bomb(); + b -> fun() -> foo3() end + end. + +% Creates two funs with no local return and will return one or die. No spec. +foo37() -> + Bomb = fun() -> foo4() end, + case get(42) of + a -> Bomb(); + b -> fun() -> foo4() end + end. + +% Creates two funs with no local return and will return one or die. With spec. +-spec foo38() -> fun(() -> no_return()). +foo38() -> + Bomb = fun foo4/0, + case get(42) of + a -> Bomb(); + b -> fun foo4/0 + end. + +% Creates two funs with no local return and will return one or die. No spec. +foo39() -> + Bomb = fun foo4/0, + case get(42) of + a -> Bomb(); + b -> fun foo4/0 + end. + +% Creates two funs with no local return and will return one or die. With spec. +-spec foo40() -> fun(() -> no_return()). +foo40() -> + Bomb = fun() -> foo4() end, + case get(42) of + a -> Bomb(); + b -> fun() -> foo4() end + end. + +% Obtains two funs with no local return and will return one or die. No spec. +foo41() -> + Bomb = foo5(), + case get(42) of + a -> Bomb(); + b -> foo5() + end. + +% Obtains two funs with no local return and will return one or die. With spec. +-spec foo42() -> fun(() -> no_return()). +foo42() -> + Bomb = foo5(), + case get(42) of + a -> Bomb(); + b -> foo5() + end. diff --git a/lib/dialyzer/test/small_SUITE_data/src/file_open_encoding.erl b/lib/dialyzer/test/small_SUITE_data/src/file_open_encoding.erl index 4f1268eba8..086df3464b 100644 --- a/lib/dialyzer/test/small_SUITE_data/src/file_open_encoding.erl +++ b/lib/dialyzer/test/small_SUITE_data/src/file_open_encoding.erl @@ -6,9 +6,7 @@ -export([parse/1]). --type proplist() :: [{atom(), any()}]. - --spec parse(string()) -> proplist(). +-spec parse(string()) -> proplists:proplist(). parse(FileName) -> {ok, IoDevice} = file:open(FileName, [read, binary, {encoding, utf8}]), do_parse(IoDevice, []). diff --git a/lib/dialyzer/test/small_SUITE_data/src/list_to_bitstring.erl b/lib/dialyzer/test/small_SUITE_data/src/list_to_bitstring.erl new file mode 100644 index 0000000000..2da708cb15 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/list_to_bitstring.erl @@ -0,0 +1,21 @@ +%%===================================================================== +%% From: Ken Robinson +%% Date: 28/04/2011, 17:26 +%% +%% Program that produced borus "Function has no local return" warnings +%% due to erlang:list_to_bitstring/1 having erroneous hard coded type +%% information, namely accepting iolist() instead of bitstrlist(). +%% Fixed 29/04/2011. +%%===================================================================== + +-module(list_to_bitstring). + +-export([l2bs/0, l2bs_ok/0]). + +%% This function was producing a warning +l2bs() -> + erlang:list_to_bitstring([<<42>>, <<42:13>>]). + +%% while this one was ok. +l2bs_ok() -> + erlang:list_to_bitstring([<<42>>, <<42,42>>]). diff --git a/lib/dialyzer/test/small_SUITE_data/src/no_return_bug.erl b/lib/dialyzer/test/small_SUITE_data/src/no_return_bug.erl new file mode 100644 index 0000000000..5c24902590 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/no_return_bug.erl @@ -0,0 +1,42 @@ +%% Dialyzer couldn't infer that monitor_diskspace would go in an infinite loop +%% instead of crashing due to the existence of list comprehensions that have a +%% normal success typing. These were added to the monitor_diskspace's SCC and +%% dialyzer_typesig didn't try to assign unit() to monitor_diskspace, as it +%% required all the members of the SCC to return none(). +%% +%% Testcase was submitted in erlang-questions mailing list by Prashanth Mundkur +%% (http://erlang.org/pipermail/erlang-questions/2011-May/058063.html) + +-module(no_return_bug). +-export([diskspace/1, monitor_diskspace/2, refresh_tags/1, monitor_launch/0]). + +-type diskinfo() :: {non_neg_integer(), non_neg_integer()}. + +-spec diskspace(nonempty_string()) -> {'ok', diskinfo()} | {'error', term()}. +diskspace(Path) -> + case Path of + "a" -> {ok, {0,0}}; + _ -> {error, error} + end. + +-spec monitor_diskspace(nonempty_string(), + [{diskinfo(), nonempty_string()}]) -> + no_return(). +monitor_diskspace(Root, Vols) -> + Df = fun(VolName) -> + diskspace(filename:join([Root, VolName])) + end, + NewVols = [{Space, VolName} + || {VolName, {ok, Space}} + <- [{VolName, Df(VolName)} + || {_OldSpace, VolName} <- Vols]], + monitor_diskspace(Root, NewVols). + +-spec refresh_tags(nonempty_string()) -> no_return(). +refresh_tags(Root) -> + {ok, _} = diskspace(Root), + refresh_tags(Root). + +monitor_launch() -> + spawn_link(fun() -> refresh_tags("abc") end), + spawn_link(fun() -> monitor_diskspace("root", [{{0,0}, "a"}]) end). diff --git a/lib/dialyzer/test/small_SUITE_data/src/nowarnunused.erl b/lib/dialyzer/test/small_SUITE_data/src/nowarnunused.erl new file mode 100644 index 0000000000..63daeee9e3 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/nowarnunused.erl @@ -0,0 +1,7 @@ +-module(nowarnunused). + +-compile({nowarn_unused_function, return_error/2}). + +-spec return_error(integer(), any()) -> no_return(). +return_error(Line, Message) -> + throw({error, {Line, ?MODULE, Message}}). diff --git a/lib/dialyzer/test/small_SUITE_data/src/rebar_no_return.erl b/lib/dialyzer/test/small_SUITE_data/src/rebar_no_return.erl new file mode 100644 index 0000000000..d3b504ae04 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/rebar_no_return.erl @@ -0,0 +1,19 @@ +-module(rebar_no_return). + +-export([t/0]). + +-spec t() -> no_return(). +t() -> + F = log_and_halt("baz"), + F("foo", 123). + +-spec log_and_halt(string()) -> fun((string(),integer()) -> no_return()). +log_and_halt(Msg) -> + fun(_, _) -> + abort(Msg) + end. + +-spec abort(string()) -> no_return(). +abort(Msg) -> + io:format("~s~n", [Msg]), + halt(1). diff --git a/lib/diameter/doc/src/diameter_dict.xml b/lib/diameter/doc/src/diameter_dict.xml index a87f59bad5..e7c530f1b8 100644 --- a/lib/diameter/doc/src/diameter_dict.xml +++ b/lib/diameter/doc/src/diameter_dict.xml @@ -105,7 +105,7 @@ quantity is insignificant.</p> <p> The tags, their arguments and the contents of each corresponding section are as follows. -Each section can occur only once unless otherwise specified. +Each section can occur at most once unless otherwise specified. The order in which sections are specified is unimportant.</p> <taglist> @@ -115,6 +115,7 @@ The order in which sections are specified is unimportant.</p> <p> Defines the integer Number as the Diameter Application Id of the application in question. +Required if the dictionary defines <c>@messages</c>. The section has empty content.</p> <p> @@ -370,7 +371,11 @@ Integer values can be prefixed with 0x to be interpreted as hexidecimal.</p> <p> -Can occur 0 or more times (with different values of Name).</p> +Can occur 0 or more times (with different values of Name). +The AVP in question can be defined in an inherited dictionary in order +to introduce additional values. +An AVP so extended must be referenced by in a <c>@messages</c> or +<c>@grouped</c> section.</p> <p> Example:</p> diff --git a/lib/diameter/src/compiler/diameter_codegen.erl b/lib/diameter/src/compiler/diameter_codegen.erl index 213ba0d22c..30caebc544 100644 --- a/lib/diameter/src/compiler/diameter_codegen.erl +++ b/lib/diameter/src/compiler/diameter_codegen.erl @@ -250,9 +250,14 @@ f_name(Name) -> %%% ------------------------------------------------------------------------ f_id(Spec) -> - Id = orddict:fetch(id, Spec), {?function, id, 0, - [{?clause, [], [], [?INTEGER(Id)]}]}. + [c_id(orddict:find(id, Spec))]}. + +c_id({ok, Id}) -> + {?clause, [], [], [?INTEGER(Id)]}; + +c_id(error) -> + ?UNEXPECTED(0). %%% ------------------------------------------------------------------------ %%% # vendor_id/0 @@ -454,9 +459,10 @@ avp(Spec) -> Native = get_value(avp_types, Spec), Custom = get_value(custom_types, Spec), Imported = get_value(import_avps, Spec), - avp([{N,T} || {N,_,T,_,_} <- Native], Imported, Custom). + Enums = get_value(enums, Spec), + avp([{N,T} || {N,_,T,_,_} <- Native], Imported, Custom, Enums). -avp(Native, Imported, Custom) -> +avp(Native, Imported, Custom, Enums) -> Dict = orddict:from_list(Native), report(native, Dict), @@ -470,8 +476,8 @@ avp(Native, Imported, Custom) -> false == lists:member(N, CustomNames) end, Native)) - ++ lists:flatmap(fun c_imported_avp/1, Imported) - ++ lists:flatmap(fun(C) -> c_custom_avp(C, Dict) end, Custom). + ++ lists:flatmap(fun(I) -> cs_imported_avp(I, Enums) end, Imported) + ++ lists:flatmap(fun(C) -> cs_custom_avp(C, Dict) end, Custom). c_base_avp({AvpName, T}) -> {?clause, [?VAR('T'), ?VAR('Data'), ?ATOM(AvpName)], @@ -487,23 +493,35 @@ base_avp(AvpName, 'Grouped') -> base_avp(_, Type) -> ?APPLY(diameter_types, Type, [?VAR('T'), ?VAR('Data')]). -c_imported_avp({Mod, Avps}) -> - lists:map(fun(A) -> imported_avp(Mod, A) end, Avps). +cs_imported_avp({Mod, Avps}, Enums) -> + lists:map(fun(A) -> imported_avp(Mod, A, Enums) end, Avps). -imported_avp(_Mod, {AvpName, _, 'Grouped' = T, _, _}) -> +imported_avp(_Mod, {AvpName, _, 'Grouped' = T, _, _}, _) -> c_base_avp({AvpName, T}); -imported_avp(Mod, {AvpName, _, _, _, _}) -> +imported_avp(Mod, {AvpName, _, 'Enumerated' = T, _, _}, Enums) -> + case lists:keymember(AvpName, 1, Enums) of + true -> + c_base_avp({AvpName, T}); + false -> + c_imported_avp(Mod, AvpName) + end; + +imported_avp(Mod, {AvpName, _, _, _, _}, _) -> + c_imported_avp(Mod, AvpName). + +c_imported_avp(Mod, AvpName) -> {?clause, [?VAR('T'), ?VAR('Data'), ?ATOM(AvpName)], [], [?APPLY(Mod, avp, [?VAR('T'), ?VAR('Data'), ?ATOM(AvpName)])]}. -c_custom_avp({Mod, Avps}, Dict) -> - lists:map(fun(N) -> custom_avp(Mod, N, orddict:fetch(N, Dict)) end, Avps). +cs_custom_avp({Mod, Avps}, Dict) -> + lists:map(fun(N) -> c_custom_avp(Mod, N, orddict:fetch(N, Dict)) end, + Avps). -custom_avp(Mod, AvpName, Type) -> +c_custom_avp(Mod, AvpName, Type) -> {?clause, [?VAR('T'), ?VAR('Data'), ?ATOM(AvpName)], [], [?APPLY(Mod, AvpName, [?VAR('T'), ?ATOM(Type), ?VAR('Data')])]}. @@ -516,9 +534,25 @@ f_enumerated_avp(Spec) -> {?function, enumerated_avp, 3, enumerated_avp(Spec) ++ [?UNEXPECTED(3)]}. enumerated_avp(Spec) -> - lists:flatmap(fun c_enumerated_avp/1, get_value(enums, Spec)). + Enums = get_value(enums, Spec), + lists:flatmap(fun cs_enumerated_avp/1, Enums) + ++ lists:flatmap(fun({M,Es}) -> enumerated_avp(M, Es, Enums) end, + get_value(import_enums, Spec)). + +enumerated_avp(Mod, Es, Enums) -> + lists:flatmap(fun({N,_}) -> + cs_enumerated_avp(lists:keymember(N, 1, Enums), + Mod, + N) + end, + Es). -c_enumerated_avp({AvpName, Values}) -> +cs_enumerated_avp(true, Mod, Name) -> + [c_imported_avp(Mod, Name)]; +cs_enumerated_avp(false, _, _) -> + []. + +cs_enumerated_avp({AvpName, Values}) -> lists:flatmap(fun(V) -> c_enumerated_avp(AvpName, V) end, Values). c_enumerated_avp(AvpName, {I,_}) -> @@ -537,10 +571,14 @@ f_msg_header(Spec) -> {?function, msg_header, 1, msg_header(Spec) ++ [?UNEXPECTED(1)]}. msg_header(Spec) -> + msg_header(get_value(messages, Spec), Spec). + +msg_header([], _) -> + []; +msg_header(Msgs, Spec) -> ApplId = orddict:fetch(id, Spec), - lists:map(fun({M,C,F,_,_}) -> c_msg_header(M, C, F, ApplId) end, - get_value(messages, Spec)). + lists:map(fun({M,C,F,_,_}) -> c_msg_header(M, C, F, ApplId) end, Msgs). %% Note that any application id in the message header spec is ignored. @@ -616,10 +654,12 @@ f_empty_value(Spec) -> {?function, empty_value, 1, empty_value(Spec)}. empty_value(Spec) -> + Imported = lists:flatmap(fun avps/1, get_value(import_enums, Spec)), Groups = get_value(grouped, Spec) ++ lists:flatmap(fun avps/1, get_value(import_groups, Spec)), - Enums = get_value(enums, Spec) - ++ lists:flatmap(fun avps/1, get_value(import_enums, Spec)), + Enums = [T || {N,_} = T <- get_value(enums, Spec), + not lists:keymember(N, 1, Imported)] + ++ Imported, lists:map(fun c_empty_value/1, Groups ++ Enums) ++ [{?clause, [?VAR('Name')], [], [?CALL(empty, [?VAR('Name')])]}]. diff --git a/lib/diameter/src/compiler/diameter_spec_util.erl b/lib/diameter/src/compiler/diameter_spec_util.erl index 322d53a199..b60886b678 100644 --- a/lib/diameter/src/compiler/diameter_spec_util.erl +++ b/lib/diameter/src/compiler/diameter_spec_util.erl @@ -39,11 +39,11 @@ parse(Path, Options) -> {ok, B} = file:read_file(Path), Chunks = chunk(B), Spec = make_spec(Chunks), - true = enums_defined(Spec), %% sanity checks - true = groups_defined(Spec), %% + true = groups_defined(Spec), %% sanity checks true = customs_defined(Spec), %% Full = import_enums(import_groups(import_avps(insert_codes(Spec), Options))), + true = enums_defined(Full), %% sanity checks true = v_flags_set(Spec), Full. @@ -243,35 +243,48 @@ get_value(Key, Spec) -> %% with an appropriate type. enums_defined(Spec) -> - is_defined(Spec, 'Enumerated', enums). + Avps = get_value(avp_types, Spec), + Import = get_value(import_enums, Spec), + lists:all(fun({N,_}) -> + true = enum_defined(N, Avps, Import) + end, + get_value(enums, Spec)). -groups_defined(Spec) -> - is_defined(Spec, 'Grouped', grouped). +enum_defined(Name, Avps, Import) -> + case lists:keyfind(Name, 1, Avps) of + {Name, _, 'Enumerated', _, _} -> + true; + {Name, _, T, _, _} -> + ?ERROR({avp_has_wrong_type, Name, 'Enumerated', T}); + false -> + lists:any(fun({_,Is}) -> lists:keymember(Name, 1, Is) end, Import) + orelse ?ERROR({avp_not_defined, Name, 'Enumerated'}) + end. +%% Note that an AVP is imported only if referenced by a message or +%% grouped AVP, so the final branch will fail if an enum definition is +%% extended without this being the case. -is_defined(Spec, Type, Key) -> +groups_defined(Spec) -> Avps = get_value(avp_types, Spec), - lists:all(fun(T) -> true = is_local(name(Key, T), Type, Avps) end, - get_value(Key, Spec)). + lists:all(fun({N,_,_,_}) -> true = group_defined(N, Avps) end, + get_value(grouped, Spec)). -name(enums, {N,_}) -> N; -name(grouped, {N,_,_,_}) -> N. - -is_local(Name, Type, Avps) -> +group_defined(Name, Avps) -> case lists:keyfind(Name, 1, Avps) of - {Name, _, Type, _, _} -> + {Name, _, 'Grouped', _, _} -> true; {Name, _, T, _, _} -> - ?ERROR({avp_has_wrong_type, Name, Type, T}); + ?ERROR({avp_has_wrong_type, Name, 'Grouped', T}); false -> - ?ERROR({avp_not_defined, Name, Type}) + ?ERROR({avp_not_defined, Name, 'Grouped'}) end. customs_defined(Spec) -> Avps = get_value(avp_types, Spec), - lists:all(fun(A) -> true = is_local(A, Avps) end, + lists:all(fun(A) -> true = custom_defined(A, Avps) end, lists:flatmap(fun last/1, get_value(custom_types, Spec))). -is_local(Name, Avps) -> +custom_defined(Name, Avps) -> case lists:keyfind(Name, 1, Avps) of {Name, _, T, _, _} when T == 'Grouped'; T == 'Enumerated' -> @@ -510,6 +523,9 @@ choose(false, _, X) -> X. %% ------------------------------------------------------------------------ %% import_groups/1 %% import_enums/1 +%% +%% For each inherited module, store the content of imported AVP's of +%% type grouped/enumerated in a new key. import_groups(Spec) -> orddict:store(import_groups, import(grouped, Spec), Spec). diff --git a/lib/diameter/test/Makefile b/lib/diameter/test/Makefile index 823e2f0311..b3648c7bb1 100644 --- a/lib/diameter/test/Makefile +++ b/lib/diameter/test/Makefile @@ -404,5 +404,5 @@ release_tests_spec: tests # $(HRL_FILES) $(ERL_FILES) \ # $(RELSYSDIR) # - chmod -f -R u+w $(RELSYSDIR) + chmod -R u+w $(RELSYSDIR) diff --git a/lib/docbuilder/src/docb_gen.erl b/lib/docbuilder/src/docb_gen.erl index 0d8d640324..75494314f1 100644 --- a/lib/docbuilder/src/docb_gen.erl +++ b/lib/docbuilder/src/docb_gen.erl @@ -18,6 +18,10 @@ -module(docb_gen). -export([module/1, module/2, users_guide/1, users_guide/2]). +-deprecated([{module,1,next_major_release}, + {module,2,next_major_release}, + {users_guide,1,next_major_release}, + {users_guide,2,next_major_release}]). -record(args, {suffix=".xml", layout=docb_edoc_xml_cb, diff --git a/lib/docbuilder/src/docb_transform.erl b/lib/docbuilder/src/docb_transform.erl index 9c7561b07b..736ac92274 100644 --- a/lib/docbuilder/src/docb_transform.erl +++ b/lib/docbuilder/src/docb_transform.erl @@ -18,6 +18,8 @@ -module(docb_transform). -export([file/1, file/2]). +-deprecated([{file,1,next_major_release}, + {file,2,next_major_release}]). %% file(File) -> ok | {error, Reason} %% file(File, Opts) -> ok | {error, Reason} diff --git a/lib/docbuilder/src/docb_xml_check.erl b/lib/docbuilder/src/docb_xml_check.erl index 8ae5cd2eac..5912e22e7b 100644 --- a/lib/docbuilder/src/docb_xml_check.erl +++ b/lib/docbuilder/src/docb_xml_check.erl @@ -18,6 +18,7 @@ -module(docb_xml_check). -export([validate/1]). +-deprecated([{validate,1,next_major_release}]). %% validate(File) -> ok | error | {error, badfile} %% File = string(), file name with or without ".xml" extension diff --git a/lib/docbuilder/vsn.mk b/lib/docbuilder/vsn.mk index 2475966ec2..6df438a537 100644 --- a/lib/docbuilder/vsn.mk +++ b/lib/docbuilder/vsn.mk @@ -1 +1 @@ -DOCB_VSN = 0.9.8.10 +DOCB_VSN = 0.9.8.11 diff --git a/lib/edoc/Makefile b/lib/edoc/Makefile index e512e390e3..1add669398 100644 --- a/lib/edoc/Makefile +++ b/lib/edoc/Makefile @@ -13,8 +13,6 @@ # Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings # AB. All Rights Reserved.'' # -# $Id$ -# include $(ERL_TOP)/make/target.mk include $(ERL_TOP)/make/$(TARGET)/otp.mk diff --git a/lib/edoc/doc/Makefile b/lib/edoc/doc/Makefile index a0f6484382..c5f68b25d0 100644 --- a/lib/edoc/doc/Makefile +++ b/lib/edoc/doc/Makefile @@ -13,8 +13,6 @@ # Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings # AB. All Rights Reserved.'' # -# $Id: Makefile,v 1.1.1.1 2004/10/04 13:53:33 richardc Exp $ -# include $(ERL_TOP)/make/target.mk include $(ERL_TOP)/make/$(TARGET)/otp.mk diff --git a/lib/edoc/doc/overview.edoc b/lib/edoc/doc/overview.edoc index bd603b7a13..fa699c6f08 100644 --- a/lib/edoc/doc/overview.edoc +++ b/lib/edoc/doc/overview.edoc @@ -1084,10 +1084,11 @@ Details: the Erlang programming language.</li> <li>`boolean()' is the subset of `atom()' consisting of the atoms `true' and `false'.</li> - <li>`char()' is a subset of - `integer()' representing character codes.</li> + <li>`char()' is the subset of `integer()' representing + Unicode character codes: hex 000000-10FFFF.</li> <li>`tuple()' is the set of all tuples `{...}'.</li> - <li>`list(T)' is just an alias for `[T]'.</li> + <li>`list(T)' is just an alias for `[T]'; list() is an alias + for `list(any())', i.e., `[any()]'.</li> <li>`nil()' is an alias for the empty list `[]'.</li> <li>`cons(H,T)' is the list constructor. This is usually not used directly. It is possible to recursively define `list(T) diff --git a/lib/edoc/doc/src/Makefile b/lib/edoc/doc/src/Makefile index 5ee0096f0f..b933094464 100644 --- a/lib/edoc/doc/src/Makefile +++ b/lib/edoc/doc/src/Makefile @@ -13,8 +13,6 @@ # Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings # AB. All Rights Reserved.'' # -# $Id$ -# include $(ERL_TOP)/make/target.mk include $(ERL_TOP)/make/$(TARGET)/otp.mk diff --git a/lib/edoc/include/Makefile b/lib/edoc/include/Makefile index 0533c27567..5b2ad38c9d 100644 --- a/lib/edoc/include/Makefile +++ b/lib/edoc/include/Makefile @@ -13,8 +13,6 @@ # Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings # AB. All Rights Reserved.'' # -# $Id$ -# include $(ERL_TOP)/make/target.mk include $(ERL_TOP)/make/$(TARGET)/otp.mk diff --git a/lib/edoc/priv/edoc_generate.src b/lib/edoc/priv/edoc_generate.src index e87fdbc902..7ec89207b0 100644 --- a/lib/edoc/priv/edoc_generate.src +++ b/lib/edoc/priv/edoc_generate.src @@ -14,9 +14,6 @@ # Portions created by Ericsson are Copyright 1999-2000, Ericsson # Utvecklings AB. All Rights Reserved.'' # -# $Id$ -# -# #EDOC_DIR=/clearcase/otp/internal_tools/edoc EDOC_DIR=/home/otp/sgml/edoc-%EDOC_VSN% diff --git a/lib/edoc/src/Makefile b/lib/edoc/src/Makefile index 9c5a9d30d1..fcb0b61292 100644 --- a/lib/edoc/src/Makefile +++ b/lib/edoc/src/Makefile @@ -23,7 +23,7 @@ RELSYSDIR = $(RELEASE_PATH)/lib/edoc-$(VSN) EBIN = ../ebin XMERL = ../../xmerl -ERL_COMPILE_FLAGS += -I../include -I$(XMERL)/include +warn_unused_vars +nowarn_shadow_vars +warn_unused_import +warn_deprecated_guard +ERL_COMPILE_FLAGS += -pa $(XMERL) -I../include -I$(XMERL)/include +warn_unused_vars +nowarn_shadow_vars +warn_unused_import +warn_deprecated_guard SOURCES= \ edoc.erl edoc_data.erl edoc_doclet.erl edoc_extract.erl \ diff --git a/lib/edoc/src/edoc.erl b/lib/edoc/src/edoc.erl index 360f2dbc9e..a279f7dcb3 100644 --- a/lib/edoc/src/edoc.erl +++ b/lib/edoc/src/edoc.erl @@ -14,8 +14,6 @@ %% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 %% USA %% -%% $Id$ -%% %% @copyright 2001-2007 Richard Carlsson %% @author Richard Carlsson <[email protected]> %% @version {@version} @@ -60,8 +58,6 @@ -compile({no_auto_import,[error/1]}). --import(edoc_report, [report/2, report/3, error/1, error/3]). - -include("edoc.hrl"). @@ -179,8 +175,8 @@ application(App, Options) when is_atom(App) -> Dir when is_list(Dir) -> application(App, Dir, Options); _ -> - report("cannot find application directory for '~s'.", - [App]), + edoc_report:report("cannot find application directory for '~s'.", + [App]), exit(error) end. @@ -663,8 +659,8 @@ read_source(Name, Opts0) -> check_forms(Forms, Name), Forms; {error, R} -> - error({"error reading file '~s'.", - [edoc_lib:filename(Name)]}), + edoc_report:error({"error reading file '~s'.", + [edoc_lib:filename(Name)]}), exit({error, R}) end. @@ -688,11 +684,10 @@ check_forms(Fs, Name) -> error_marker -> case erl_syntax:error_marker_info(F) of {L, M, D} -> - error(L, Name, {format_error, M, D}); - + edoc_report:error(L, Name, {format_error, M, D}); Other -> - report(Name, "unknown error in " - "source code: ~w.", [Other]) + edoc_report:report(Name, "unknown error in " + "source code: ~w.", [Other]) end, exit(error); _ -> diff --git a/lib/edoc/src/edoc_data.erl b/lib/edoc/src/edoc_data.erl index 27f43dca5a..e3b5a0d51b 100644 --- a/lib/edoc/src/edoc_data.erl +++ b/lib/edoc/src/edoc_data.erl @@ -14,8 +14,6 @@ %% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 %% USA %% -%% $Id$ -%% %% @private %% @copyright 2003 Richard Carlsson %% @author Richard Carlsson <[email protected]> diff --git a/lib/edoc/src/edoc_doclet.erl b/lib/edoc/src/edoc_doclet.erl index 30eef3e63a..c66be9d7c7 100644 --- a/lib/edoc/src/edoc_doclet.erl +++ b/lib/edoc/src/edoc_doclet.erl @@ -14,8 +14,6 @@ %% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 %% USA %% -%% $Id$ -%% %% @copyright 2003-2006 Richard Carlsson %% @author Richard Carlsson <[email protected]> %% @see edoc @@ -52,7 +50,7 @@ -define(IMAGE, "erlang.png"). -define(NL, "\n"). --include("xmerl.hrl"). +-include_lib("xmerl/include/xmerl.hrl"). %% Sources is the list of inputs in the order they were found. Packages %% and Modules are sorted lists of atoms without duplicates. (They diff --git a/lib/edoc/src/edoc_extract.erl b/lib/edoc/src/edoc_extract.erl index 5e28762c53..1209d86fe5 100644 --- a/lib/edoc/src/edoc_extract.erl +++ b/lib/edoc/src/edoc_extract.erl @@ -14,8 +14,6 @@ %% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 %% USA %% -%% $Id: $ -%% %% @copyright 2001-2003 Richard Carlsson %% @author Richard Carlsson <[email protected]> %% @see edoc @@ -238,8 +236,8 @@ file(File, Context, Env, Opts) -> case file:read_file(File) of {ok, Bin} -> {ok, text(binary_to_list(Bin), Context, Env, Opts, File)}; - {error, _R} = Error -> - Error + {error, _} = Error -> + Error end. @@ -298,8 +296,8 @@ get_module_info(Forms, File) -> {Name, Vars} = case lists:keyfind(module, 1, L) of {module, N} when is_atom(N) -> {N, none}; - {module, {N, _Vs} = NVs} when is_atom(N) -> - NVs; + {module, {N, _}=Mod} when is_atom(N) -> + Mod; _ -> report(File, "module name missing.", []), exit(error) diff --git a/lib/edoc/src/edoc_layout.erl b/lib/edoc/src/edoc_layout.erl index 3ec87b7060..1c0841815f 100644 --- a/lib/edoc/src/edoc_layout.erl +++ b/lib/edoc/src/edoc_layout.erl @@ -14,8 +14,6 @@ %% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 %% USA %% -%% $Id: $ -%% %% @author Richard Carlsson <[email protected]> %% @copyright 2001-2006 Richard Carlsson %% @see edoc @@ -33,7 +31,7 @@ -import(edoc_report, [report/2]). --include("xmerl.hrl"). +-include_lib("xmerl/include/xmerl.hrl"). -define(HTML_EXPORT, xmerl_html). -define(DEFAULT_XML_EXPORT, ?HTML_EXPORT). @@ -959,12 +957,16 @@ local_label(R) -> xhtml(Title, CSS, Body) -> [{html, [?NL, - {head, [?NL, - {title, Title}, - ?NL] ++ CSS}, - ?NL, - {body, [{bgcolor, "white"}], Body}, - ?NL] + {head, [?NL, + {meta, [{'http-equiv',"Content-Type"}, + {content, "text/html; charset=ISO-8859-1"}], + []}, + ?NL, + {title, Title}, + ?NL] ++ CSS}, + ?NL, + {body, [{bgcolor, "white"}], Body}, + ?NL] }, ?NL]. diff --git a/lib/edoc/src/edoc_lib.erl b/lib/edoc/src/edoc_lib.erl index 585e30a2d2..6c698e83ef 100644 --- a/lib/edoc/src/edoc_lib.erl +++ b/lib/edoc/src/edoc_lib.erl @@ -14,8 +14,6 @@ %% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 %% USA %% -%% $Id$ -%% %% @copyright 2001-2003 Richard Carlsson %% @author Richard Carlsson <[email protected]> %% @see edoc @@ -40,7 +38,7 @@ -import(edoc_report, [report/2, warning/2]). -include("edoc.hrl"). --include("xmerl.hrl"). +-include_lib("xmerl/include/xmerl.hrl"). -define(FILE_BASE, "/"). @@ -494,7 +492,7 @@ uri_get_file(File0) -> uri_get_http(URI) -> %% Try using option full_result=false case catch {ok, httpc:request(get, {URI,[]}, [], - [{full_result, false}])} of + [{full_result, false}])} of {'EXIT', _} -> uri_get_http_r10(URI); Result -> diff --git a/lib/edoc/src/edoc_parser.yrl b/lib/edoc/src/edoc_parser.yrl index 6943f1bdb8..3ce4cde4fb 100644 --- a/lib/edoc/src/edoc_parser.yrl +++ b/lib/edoc/src/edoc_parser.yrl @@ -23,9 +23,6 @@ %% USA %% %% Author contact: [email protected] -%% -%% $Id $ -%% %% ===================================================================== Nonterminals @@ -362,10 +359,10 @@ parse_spec(S, L) -> {ok, Spec} -> Spec; {error, E} -> - throw_error(E, L) + throw_error({parse_spec, E}, L) end; {error, E, _} -> - throw_error(E, L) + throw_error({parse_spec, E}, L) end. %% --------------------------------------------------------------------- diff --git a/lib/edoc/src/edoc_report.erl b/lib/edoc/src/edoc_report.erl index ee54c60c90..f082513bee 100644 --- a/lib/edoc/src/edoc_report.erl +++ b/lib/edoc/src/edoc_report.erl @@ -14,8 +14,6 @@ %% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 %% USA %% -%% $Id$ -%% %% @private %% @copyright 2001-2003 Richard Carlsson %% @author Richard Carlsson <[email protected]> diff --git a/lib/edoc/src/edoc_run.erl b/lib/edoc/src/edoc_run.erl index 96e5ea4631..1355db840f 100644 --- a/lib/edoc/src/edoc_run.erl +++ b/lib/edoc/src/edoc_run.erl @@ -14,8 +14,6 @@ %% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 %% USA %% -%% $Id$ -%% %% @copyright 2003 Richard Carlsson %% @author Richard Carlsson <[email protected]> %% @see edoc diff --git a/lib/edoc/src/edoc_scanner.erl b/lib/edoc/src/edoc_scanner.erl index 9d2e6f3aed..8e895ad1ad 100644 --- a/lib/edoc/src/edoc_scanner.erl +++ b/lib/edoc/src/edoc_scanner.erl @@ -13,8 +13,6 @@ %% AB. Portions created by Ericsson are Copyright 1999, Ericsson %% Utvecklings AB. All Rights Reserved.'' %% -%% $Id: $ -%% %% @private %% @copyright Richard Carlsson 2001-2003. Portions created by Ericsson %% are Copyright 1999, Ericsson Utvecklings AB. All Rights Reserved. diff --git a/lib/edoc/src/edoc_specs.erl b/lib/edoc/src/edoc_specs.erl index 519ade726f..5acf8ac0d5 100644 --- a/lib/edoc/src/edoc_specs.erl +++ b/lib/edoc/src/edoc_specs.erl @@ -27,7 +27,6 @@ -include("edoc.hrl"). -include("edoc_types.hrl"). --type proplist() :: [proplists:property()]. -type syntaxTree() :: erl_syntax:syntaxTree(). -define(TOP_TYPE, term). @@ -87,8 +86,9 @@ dummy_spec(Form) -> #tag{name = spec, line = element(2, hd(TypeSpecs)), origin = code, data = S}. --spec docs(Forms::[syntaxTree()], CommentFun) -> dict() when - CommentFun :: fun(([syntaxTree()], Line :: term()) -> #tag{}). +-spec docs(Forms::[syntaxTree()], + CommentFun :: fun( ([syntaxTree()], Line :: term()) -> #tag{} )) + -> dict(). %% @doc Find comments after -type/-opaque declarations. %% Postcomments "inside" the type are skipped. @@ -98,7 +98,7 @@ docs(Forms, CommentFun) -> -type entry() :: #entry{}. -type module_info() :: #module{}. -type entries() :: [entry()]. --spec add_data(Entries::entries(), Options::proplist(), +-spec add_data(Entries::entries(), Options::proplists:proplist(), File::file:filename(), Module::module_info()) -> entries(). %% @doc Create tags a la EDoc for Erlang specifications and types. @@ -305,8 +305,6 @@ d2e({ann_type,_,[V, T0]}) -> %% layout module. T = d2e(T0), ?add_t_ann(T, element(3, V)); -d2e({type,_,no_return,[]}) -> - #t_type{name = #t_name{name = none}}; d2e({remote_type,_,[{atom,_,M},{atom,_,F},Ts0]}) -> Ts = d2e(Ts0), typevar_anno(#t_type{name = #t_name{module = M, name = F}, args = Ts}, Ts); diff --git a/lib/edoc/src/edoc_tags.erl b/lib/edoc/src/edoc_tags.erl index 8ee8f87b5f..80989428ce 100644 --- a/lib/edoc/src/edoc_tags.erl +++ b/lib/edoc/src/edoc_tags.erl @@ -14,8 +14,6 @@ %% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 %% USA %% -%% $Id$ -%% %% @private %% @copyright 2001-2003 Richard Carlsson %% @author Richard Carlsson <[email protected]> diff --git a/lib/edoc/src/edoc_types.erl b/lib/edoc/src/edoc_types.erl index 1ded63dffe..a54544868c 100644 --- a/lib/edoc/src/edoc_types.erl +++ b/lib/edoc/src/edoc_types.erl @@ -14,8 +14,6 @@ %% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 %% USA %% -%% $Id$ -%% %% @private %% @copyright 2001-2003 Richard Carlsson %% @author Richard Carlsson <[email protected]> @@ -34,13 +32,13 @@ %% @headerfile "edoc_types.hrl" -include("edoc_types.hrl"). --include("xmerl.hrl"). +-include_lib("xmerl/include/xmerl.hrl"). is_predefined(any, 0) -> true; is_predefined(atom, 0) -> true; is_predefined(binary, 0) -> true; -is_predefined(bool, 0) -> true; +is_predefined(bool, 0) -> true; % kept for backwards compatibility is_predefined(char, 0) -> true; is_predefined(cons, 2) -> true; is_predefined(deep_string, 0) -> true; @@ -51,6 +49,7 @@ is_predefined(list, 0) -> true; is_predefined(list, 1) -> true; is_predefined(nil, 0) -> true; is_predefined(none, 0) -> true; +is_predefined(no_return, 0) -> true; is_predefined(number, 0) -> true; is_predefined(pid, 0) -> true; is_predefined(port, 0) -> true; diff --git a/lib/edoc/src/edoc_wiki.erl b/lib/edoc/src/edoc_wiki.erl index 9a31bc9a82..2f2d14853c 100644 --- a/lib/edoc/src/edoc_wiki.erl +++ b/lib/edoc/src/edoc_wiki.erl @@ -14,8 +14,6 @@ %% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 %% USA %% -%% $Id$ -%% %% @private %% @copyright 2001-2003 Richard Carlsson %% @author Richard Carlsson <[email protected]> @@ -70,7 +68,7 @@ -export([parse_xml/2, expand_text/2]). -include("edoc.hrl"). --include("xmerl.hrl"). +-include_lib("xmerl/include/xmerl.hrl"). -define(BASE_HEADING, 3). @@ -82,8 +80,8 @@ parse_xml(Data, Line) -> parse_xml_1(Text, Line) -> Text1 = "<doc>" ++ Text ++ "</doc>", - Options = [{line, Line}, {encoding, "iso-8859-1"}], - case catch {ok, xmerl_scan:string(Text1, Options)} of + Opts = [{line, Line}, {encoding, 'iso-8859-1'}], + case catch {ok, xmerl_scan:string(Text1, Opts)} of {ok, {E, _}} -> E#xmlElement.content; {'EXIT', {fatal, {Reason, L, _C}}} -> @@ -360,10 +358,7 @@ par_text(Cs, As, Bs, E, Es) -> [] -> Bs; _ -> [#xmlElement{name = p, content = Es1} | Bs] end, - Bs1 = case Ss of - [] -> Bs0; - _ -> [#xmlText{value = Ss} | Bs0] - end, + Bs1 = [#xmlText{value = Ss} | Bs0], case Cs2 of [] -> par(Es, [], Bs1); diff --git a/lib/edoc/src/otpsgml_layout.erl b/lib/edoc/src/otpsgml_layout.erl index 45f74b299e..d425dc0ed8 100644 --- a/lib/edoc/src/otpsgml_layout.erl +++ b/lib/edoc/src/otpsgml_layout.erl @@ -14,8 +14,6 @@ %% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 %% USA %% -%% $Id$ -%% %% @author Richard Carlsson <[email protected]> %% @author Kenneth Lundin <[email protected]> %% @copyright 2001-2004 Richard Carlsson @@ -34,7 +32,7 @@ -import(edoc_report, [report/2]). --include("xmerl.hrl"). +-include_lib("xmerl/include/xmerl.hrl"). -define(SGML_EXPORT, xmerl_otpsgml). -define(DEFAULT_XML_EXPORT, ?SGML_EXPORT). diff --git a/lib/edoc/test/edoc_SUITE.erl b/lib/edoc/test/edoc_SUITE.erl index 0d57591e3e..5b95c35756 100644 --- a/lib/edoc/test/edoc_SUITE.erl +++ b/lib/edoc/test/edoc_SUITE.erl @@ -13,8 +13,6 @@ %% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings %% AB. All Rights Reserved.'' %% -%% $Id$ -%% -module(edoc_SUITE). -include_lib("test_server/include/test_server.hrl"). diff --git a/lib/erl_docgen/priv/bin/xref_mod_app.escript b/lib/erl_docgen/priv/bin/xref_mod_app.escript index 13671ef2f8..c2bd62f9e0 100755 --- a/lib/erl_docgen/priv/bin/xref_mod_app.escript +++ b/lib/erl_docgen/priv/bin/xref_mod_app.escript @@ -73,7 +73,12 @@ usage() -> modapp(TopDir) -> AppDirs = filelib:wildcard(filename:join([TopDir,"lib","*"])), AM = [appmods(D) || D <- AppDirs], - lists:keysort(1, [{M,A} || {A,Ms} <- AM, M <- Ms]). + ERTS = [preloaded(TopDir) || lists:keyfind("erts", 1, AM) =:= false], + lists:keysort(1, [{M,A} || {A,Ms} <- ERTS++AM, M <- Ms]). + +preloaded(TopDir) -> + {"preloaded",Mods} = appmods(filename:join([TopDir,"erts","preloaded"])), + {"erts",Mods}. %% It's OK if too much data is generated as long as all applications %% and all modules are mentioned. diff --git a/lib/erl_docgen/priv/xsl/db_html.xsl b/lib/erl_docgen/priv/xsl/db_html.xsl index 982572aeef..a9052f29e5 100644 --- a/lib/erl_docgen/priv/xsl/db_html.xsl +++ b/lib/erl_docgen/priv/xsl/db_html.xsl @@ -433,6 +433,8 @@ <!-- Search "local types" as well --> <xsl:variable name="local_types" select="ancestor::desc/preceding-sibling::type + [string-length(@name) > 0] + | ancestor::type_desc/preceding-sibling::type [string-length(@name) > 0]"/> <xsl:variable name="has_anno_in_local_type"> <xsl:for-each select="$local_types"> diff --git a/lib/erl_docgen/priv/xsl/db_man.xsl b/lib/erl_docgen/priv/xsl/db_man.xsl index 25b62f68c5..8db4714249 100644 --- a/lib/erl_docgen/priv/xsl/db_man.xsl +++ b/lib/erl_docgen/priv/xsl/db_man.xsl @@ -363,6 +363,8 @@ <!-- Search "local types" as well --> <xsl:variable name="local_types" select="ancestor::desc/preceding-sibling::type + [string-length(@name) > 0] + | ancestor::type_desc/preceding-sibling::type [string-length(@name) > 0]"/> <xsl:variable name="has_anno_in_local_type"> <xsl:for-each select="$local_types"> diff --git a/lib/erl_docgen/priv/xsl/db_pdf.xsl b/lib/erl_docgen/priv/xsl/db_pdf.xsl index 5119e3e36a..a3d601d861 100644 --- a/lib/erl_docgen/priv/xsl/db_pdf.xsl +++ b/lib/erl_docgen/priv/xsl/db_pdf.xsl @@ -410,6 +410,8 @@ <!-- Search "local types" as well --> <xsl:variable name="local_types" select="ancestor::desc/preceding-sibling::type + [string-length(@name) > 0] + | ancestor::type_desc/preceding-sibling::type [string-length(@name) > 0]"/> <xsl:variable name="has_anno_in_local_type"> <xsl:for-each select="$local_types"> diff --git a/lib/erl_interface/src/connect/ei_resolve.c b/lib/erl_interface/src/connect/ei_resolve.c index 50c5a4161d..ba8f8fbce3 100644 --- a/lib/erl_interface/src/connect/ei_resolve.c +++ b/lib/erl_interface/src/connect/ei_resolve.c @@ -185,7 +185,12 @@ static int verify_dns_configuration(void) * align: increment buf until it is dword-aligned, reduce len by same amount. * advance: increment buf by n bytes, reduce len by same amount . */ -#define align_buf(buf,len) for (;(((unsigned)buf)&0x3); (buf)++, len--) +#if defined SIZEOF_VOID_P +#define ALIGNBYTES (SIZEOF_VOID_P - 1) +#else +#define ALIGNBYTES (sizeof(void*) - 1) +#endif +#define align_buf(buf,len) for (;(((unsigned)buf) & ALIGNBYTES); (buf)++, len--) #define advance_buf(buf,len,n) ((buf)+=(n),(len)-=(n)) /* "and now the tricky part..." */ diff --git a/lib/erl_interface/src/encode/encode_atom.c b/lib/erl_interface/src/encode/encode_atom.c index 69f2d1451c..b1a4479034 100644 --- a/lib/erl_interface/src/encode/encode_atom.c +++ b/lib/erl_interface/src/encode/encode_atom.c @@ -17,13 +17,17 @@ * %CopyrightEnd% */ #include <string.h> +#include <limits.h> #include "eidef.h" #include "eiext.h" #include "putget.h" int ei_encode_atom(char *buf, int *index, const char *p) { - return ei_encode_atom_len(buf, index, p, strlen(p)); + size_t len = strlen(p); + + if (len >= INT_MAX) return -1; + return ei_encode_atom_len(buf, index, p, len); } int ei_encode_atom_len(char *buf, int *index, const char *p, int len) diff --git a/lib/erl_interface/src/encode/encode_string.c b/lib/erl_interface/src/encode/encode_string.c index 1d342cb605..593bbf2b6d 100644 --- a/lib/erl_interface/src/encode/encode_string.c +++ b/lib/erl_interface/src/encode/encode_string.c @@ -17,6 +17,7 @@ * %CopyrightEnd% */ #include <string.h> +#include <limits.h> #include "eidef.h" #include "eiext.h" #include "putget.h" @@ -24,7 +25,10 @@ int ei_encode_string(char *buf, int *index, const char *p) { - return ei_encode_string_len(buf, index, p, strlen(p)); + size_t len = strlen(p); + + if (len >= INT_MAX) return -1; + return ei_encode_string_len(buf, index, p, len); } int ei_encode_string_len(char *buf, int *index, const char *p, int len) diff --git a/lib/et/src/et_wx_viewer.erl b/lib/et/src/et_wx_viewer.erl index 7d4286ed9d..386f8fc86b 100644 --- a/lib/et/src/et_wx_viewer.erl +++ b/lib/et/src/et_wx_viewer.erl @@ -257,10 +257,10 @@ parse_opt([H | T], S, CollectorOpt) -> Actors = [create_actor(Name) || Name <- ActorNames2], parse_opt(T, S#state{actors = Actors}, CollectorOpt); {include, ActorNames} when is_list(ActorNames) -> - Actors = [opt_create_actor(Name, include, S#state.actors) || Name <- ActorNames], + Actors = [opt_create_actor(Name, include, S) || Name <- ActorNames], parse_opt(T, S#state{actors = Actors}, CollectorOpt); {exclude, ActorNames} when is_list(ActorNames) -> - Actors = [opt_create_actor(Name, exclude, S#state.actors) || Name <- ActorNames], + Actors = [opt_create_actor(Name, exclude, S) || Name <- ActorNames], parse_opt(T, S#state{actors = Actors}, CollectorOpt); {first_event, _FirstKey} -> %% NYI diff --git a/lib/eunit/doc/overview.edoc b/lib/eunit/doc/overview.edoc index be05a13fba..2583f0be25 100644 --- a/lib/eunit/doc/overview.edoc +++ b/lib/eunit/doc/overview.edoc @@ -913,7 +913,7 @@ To make the descriptions simpler, we first list some definitions: <td>`CleanupX'</td><td>`(X::any(), R::any()) -> any()'</td> </tr> <tr> -<td>`Instantiator'</td><td>`((R::any()) -> Tests | {with, [AbstractTestFun::((any()) -> any())]}'</td> +<td>`Instantiator'</td><td>`((R::any()) -> Tests) | {with, [AbstractTestFun::((any()) -> any())]}'</td> </tr> <tr> <td>`Where'</td><td>`local | spawn | {spawn, Node::atom()}'</td> diff --git a/lib/eunit/include/eunit.hrl b/lib/eunit/include/eunit.hrl index 82ba982f03..493ba60a2d 100644 --- a/lib/eunit/include/eunit.hrl +++ b/lib/eunit/include/eunit.hrl @@ -39,6 +39,7 @@ -ifndef(EUNIT_HRL). -define(EUNIT_HRL, true). + %% allow defining TEST to override NOTEST -ifdef(TEST). -undef(NOTEST). @@ -164,7 +165,7 @@ %% This is mostly a convenience which gives more detailed reports. %% Note: Guard is a guarded pattern, and can not be used for value. -ifdef(NOASSERT). --define(assertMatch(Guard,Expr),ok). +-define(assertMatch(Guard, Expr), ok). -else. -define(assertMatch(Guard, Expr), ((fun () -> @@ -174,17 +175,37 @@ [{module, ?MODULE}, {line, ?LINE}, {expression, (??Expr)}, - {expected, (??Guard)}, + {pattern, (??Guard)}, {value, __V}]}) end end)())). -endif. -define(_assertMatch(Guard, Expr), ?_test(?assertMatch(Guard, Expr))). +%% This is the inverse case of assertMatch, for convenience. +-ifdef(NOASSERT). +-define(assertNotMatch(Guard, Expr), ok). +-else. +-define(assertNotMatch(Guard, Expr), + ((fun () -> + __V = (Expr), + case __V of + Guard -> .erlang:error({assertNotMatch_failed, + [{module, ?MODULE}, + {line, ?LINE}, + {expression, (??Expr)}, + {pattern, (??Guard)}, + {value, __V}]}); + _ -> ok + end + end)())). +-endif. +-define(_assertNotMatch(Guard, Expr), ?_test(?assertNotMatch(Guard, Expr))). + %% This is a convenience macro which gives more detailed reports when %% the expected LHS value is not a pattern, but a computed value -ifdef(NOASSERT). --define(assertEqual(Expect,Expr),ok). +-define(assertEqual(Expect, Expr), ok). -else. -define(assertEqual(Expect, Expr), ((fun (__X) -> @@ -201,9 +222,29 @@ -endif. -define(_assertEqual(Expect, Expr), ?_test(?assertEqual(Expect, Expr))). +%% This is the inverse case of assertEqual, for convenience. +-ifdef(NOASSERT). +-define(assertNotEqual(Unexpected, Expr), ok). +-else. +-define(assertNotEqual(Unexpected, Expr), + ((fun (__X) -> + case (Expr) of + __X -> .erlang:error({assertNotEqual_failed, + [{module, ?MODULE}, + {line, ?LINE}, + {expression, (??Expr)}, + {value, __X}]}); + _ -> ok + end + end)(Unexpected))). +-endif. +-define(_assertNotEqual(Unexpected, Expr), + ?_test(?assertNotEqual(Unexpected, Expr))). + %% Note: Class and Term are patterns, and can not be used for value. +%% Term can be a guarded pattern, but Class cannot. -ifdef(NOASSERT). --define(assertException(Class, Term, Expr),ok). +-define(assertException(Class, Term, Expr), ok). -else. -define(assertException(Class, Term, Expr), ((fun () -> @@ -212,7 +253,7 @@ [{module, ?MODULE}, {line, ?LINE}, {expression, (??Expr)}, - {expected, + {pattern, "{ "++(??Class)++" , "++(??Term) ++" , [...] }"}, {unexpected_success, __V}]}) @@ -223,7 +264,7 @@ [{module, ?MODULE}, {line, ?LINE}, {expression, (??Expr)}, - {expected, + {pattern, "{ "++(??Class)++" , "++(??Term) ++" , [...] }"}, {unexpected_exception, @@ -243,6 +284,43 @@ -define(_assertExit(Term, Expr), ?_assertException(exit, Term, Expr)). -define(_assertThrow(Term, Expr), ?_assertException(throw, Term, Expr)). +%% This is the inverse case of assertException, for convenience. +%% Note: Class and Term are patterns, and can not be used for value. +%% Both Class and Term can be guarded patterns. +-ifdef(NOASSERT). +-define(assertNotException(Class, Term, Expr), ok). +-else. +-define(assertNotException(Class, Term, Expr), + ((fun () -> + try (Expr) of + _ -> ok + catch + __C:__T -> + case __C of + Class -> + case __T of + Term -> + .erlang:error({assertNotException_failed, + [{module, ?MODULE}, + {line, ?LINE}, + {expression, (??Expr)}, + {pattern, + "{ "++(??Class)++" , " + ++(??Term)++" , [...] }"}, + {unexpected_exception, + {__C, __T, + .erlang:get_stacktrace() + }}]}); + _ -> ok + end; + _ -> ok + end + end + end)())). +-endif. +-define(_assertNotException(Class, Term, Expr), + ?_test(?assertNotException(Class, Term, Expr))). + %% Macros for running operating system commands. (Note that these %% require EUnit to be present at runtime, or at least eunit_lib.) @@ -267,7 +345,7 @@ %% these are only used for testing; they always return 'ok' on success, %% and have no effect if debugging/testing is turned off -ifdef(NOASSERT). --define(assertCmdStatus(N, Cmd),ok). +-define(assertCmdStatus(N, Cmd), ok). -else. -define(assertCmdStatus(N, Cmd), ((fun () -> @@ -285,7 +363,7 @@ -define(assertCmd(Cmd), ?assertCmdStatus(0, Cmd)). -ifdef(NOASSERT). --define(assertCmdOutput(T, Cmd),ok). +-define(assertCmdOutput(T, Cmd), ok). -else. -define(assertCmdOutput(T, Cmd), ((fun () -> @@ -313,11 +391,12 @@ -define(debugHere, ok). -define(debugFmt(S, As), ok). -define(debugVal(E), (E)). --define(debugTime(S,E), (E)). +-define(debugTime(S, E), (E)). -else. -define(debugMsg(S), (begin - .io:fwrite(user, <<"~s:~w: ~s\n">>, [?FILE, ?LINE, S]), + .io:fwrite(user, <<"~s:~w:~w: ~s\n">>, + [?FILE, ?LINE, self(), S]), ok end)). -define(debugHere, (?debugMsg("<-"))). @@ -327,7 +406,7 @@ ?debugFmt(<<"~s = ~P">>, [(??E), __V, 15]), __V end)(E))). --define(debugTime(S,E), +-define(debugTime(S, E), ((fun () -> {__T0, _} = statistics(wall_clock), __V = (E), @@ -337,4 +416,5 @@ end)())). -endif. + -endif. % EUNIT_HRL diff --git a/lib/eunit/src/eunit.app.src b/lib/eunit/src/eunit.app.src index 4fd76588c3..5e16dfa2ce 100644 --- a/lib/eunit/src/eunit.app.src +++ b/lib/eunit/src/eunit.app.src @@ -5,17 +5,17 @@ {vsn, "%VSN%"}, {modules, [eunit, eunit_autoexport, - eunit_striptests, - eunit_server, + eunit_data, + eunit_lib, + eunit_listener, eunit_proc, eunit_serial, + eunit_server, + eunit_striptests, + eunit_surefire, eunit_test, eunit_tests, - eunit_lib, - eunit_listener, - eunit_data, - eunit_tty, - eunit_surefire]}, + eunit_tty]}, {registered,[]}, - {applications, [stdlib]}, + {applications, [kernel,stdlib]}, {env, []}]}. diff --git a/lib/eunit/src/eunit.erl b/lib/eunit/src/eunit.erl index da35c5c2ec..15fc3bdf32 100644 --- a/lib/eunit/src/eunit.erl +++ b/lib/eunit/src/eunit.erl @@ -16,7 +16,7 @@ %% $Id: eunit.erl 339 2009-04-05 14:10:47Z rcarlsson $ %% %% @copyright 2004-2009 Micka�l R�mond, Richard Carlsson -%% @author Mickaël Rémond <[email protected]> +%% @author Micka�l R�mond <[email protected]> %% [http://www.process-one.net/] %% @author Richard Carlsson <[email protected]> %% [http://user.it.uu.se/~richardc/] diff --git a/lib/eunit/src/eunit_data.erl b/lib/eunit/src/eunit_data.erl index 0543b6c543..288dd74ddf 100644 --- a/lib/eunit/src/eunit_data.erl +++ b/lib/eunit/src/eunit_data.erl @@ -146,8 +146,10 @@ iter_next(I = #iter{next = [T | Ts]}) -> iter_prev(#iter{prev = []}) -> none; -iter_prev(#iter{prev = [T | Ts], next = Next, pos = Pos} = I) -> - {T, I#iter{prev = Ts, next = [T | Next], pos = Pos - 1}}. +iter_prev(#iter{prev = [T | Ts]} = I) -> + {T, I#iter{prev = Ts, + next = [T | I#iter.next], + pos = I#iter.pos - 1}}. %% --------------------------------------------------------------------- @@ -363,7 +365,8 @@ parse({file, F} = T) when is_list(F) -> parse({dir, D}=T) when is_list(D) -> case eunit_lib:is_string(D) of true -> - {data, {"directory \"" ++ D ++ "\"", get_directory_modules(D)}}; + {data, {"directory \"" ++ D ++ "\"", + get_directory_module_tests(D)}}; false -> bad_test(T) end; @@ -385,10 +388,10 @@ parse({S, T1} = T) when is_list(S) -> end; parse({S, T1}) when is_binary(S) -> group(#group{tests = T1, desc = S}); -parse(T) when tuple_size(T) > 2, is_list(element(1, T)) -> +parse(T) when is_tuple(T), size(T) > 2, is_list(element(1, T)) -> [S | Es] = tuple_to_list(T), parse({S, list_to_tuple(Es)}); -parse(T) when tuple_size(T) > 2, is_binary(element(1, T)) -> +parse(T) when is_tuple(T), size(T) > 2, is_binary(element(1, T)) -> [S | Es] = tuple_to_list(T), parse({S, list_to_tuple(Es)}); parse(M) when is_atom(M) -> @@ -596,7 +599,7 @@ testfuns(Es, M, TestSuffix, GeneratorSuffix) -> %% --------------------------------------------------------------------- -%% Getting a test set from a file +%% Getting a test set from a file (text file or object file) %% @throws {file_read_error, {Reason::atom(), Message::string(), %% fileName()}} @@ -625,17 +628,23 @@ get_file_tests(F) -> is_module_filename(F) -> filename:extension(F) =:= code:objfile_extension(). +objfile_test({M, File}) -> + {setup, + fun () -> + %% TODO: better error/stacktrace for this internal fun + code:purge(M), + {module,M} = code:load_abs(filename:rootname(File)), + ok + end, + {module, M}}; objfile_test(File) -> + objfile_test({objfile_module(File), File}). + +objfile_module(File) -> try - {module, M} = lists:keyfind(module, 1, beam_lib:info(File)), - {setup, - fun () -> - %% TODO: better error/stacktrace for this internal fun - code:purge(M), - {module,M} = code:load_abs(filename:rootname(File)), - ok - end, - {module, M}} + {value, {module, M}} = lists:keysearch(module, 1, + beam_lib:info(File)), + M catch _:_ -> throw({file_read_error, @@ -644,15 +653,34 @@ objfile_test(File) -> %% --------------------------------------------------------------------- -%% Getting a list of module names from object files in a directory - -%% @throws {file_read_error, {Reason::atom(), Message::string(), -%% fileName()}} +%% Getting a set of module tests from the object files in a directory + +%% @throws {file_read_error, +%% {Reason::atom(), Message::string(), fileName()}} + +get_directory_module_tests(D) -> + Ms = get_directory_modules(D), + %% for all 'm' in the set, remove 'm_tests' if present + F = fun ({M,_}, S) -> + Name = atom_to_list(M), + case lists:suffix(?DEFAULT_TESTMODULE_SUFFIX, Name) of + false -> + Name1 = Name ++ ?DEFAULT_TESTMODULE_SUFFIX, + M1 = list_to_atom(Name1), + dict:erase(M1, S); + true -> + S + end + end, + [objfile_test(Obj) + || Obj <- dict:to_list(lists:foldl(F, dict:from_list(Ms), Ms))]. %% TODO: handle packages (recursive search for files) - get_directory_modules(D) -> - [objfile_test(filename:join(D, F)) + [begin + F1 = filename:join(D, F), + {objfile_module(F1), F1} + end || F <- eunit_lib:list_dir(D), is_module_filename(F)]. diff --git a/lib/eunit/src/eunit_server.erl b/lib/eunit/src/eunit_server.erl index bf1bb9bcef..2cdfef2668 100644 --- a/lib/eunit/src/eunit_server.erl +++ b/lib/eunit/src/eunit_server.erl @@ -59,8 +59,9 @@ watch(Server, Module, Opts) when is_atom(Module) -> watch_path(Server, Path, Opts) -> command(Server, {watch, {path, filename:flatten(Path)}, Opts}). +%% note that the user must use $ at the end to match whole paths only watch_regexp(Server, Regex, Opts) -> - case regexp:parse(Regex) of + case re:compile(Regex,[anchored]) of {ok, R} -> command(Server, {watch, {regexp, R}, Opts}); {error, _}=Error -> @@ -278,8 +279,8 @@ is_watched(Path, St) -> match_any(sets:to_list(St#state.regexps), Path). match_any([R | Rs], Str) -> - case regexp:first_match(Str, R) of - {match, _, _} -> true; + case re:run(Str, R, [{capture,none}]) of + match -> true; _ -> match_any(Rs, Str) end; match_any([], _Str) -> false. diff --git a/lib/eunit/src/eunit_surefire.erl b/lib/eunit/src/eunit_surefire.erl index dfb08c90b2..6e0a447105 100644 --- a/lib/eunit/src/eunit_surefire.erl +++ b/lib/eunit/src/eunit_surefire.erl @@ -15,7 +15,7 @@ %% %% $Id: $ %% -%% @author Mickaël Rémond <[email protected]> +%% @author Micka�l R�mond <[email protected]> %% @copyright 2009 Micka�l R�mond, Paul Guyot %% @see eunit %% @doc Surefire reports for EUnit (Format used by Maven and Atlassian @@ -64,6 +64,7 @@ }). -record(testsuite, { + id = 0 :: integer(), name = <<>> :: binary(), time = 0 :: integer(), output = <<>> :: binary(), @@ -76,7 +77,7 @@ -record(state, {verbose = false, indent = 0, xmldir = ".", - testsuite = #testsuite{} + testsuites = [] :: [#testsuite{}] }). start() -> @@ -89,55 +90,60 @@ init(Options) -> XMLDir = proplists:get_value(dir, Options, ?XMLDIR), St = #state{verbose = proplists:get_bool(verbose, Options), xmldir = XMLDir, - testsuite = #testsuite{}}, + testsuites = []}, receive {start, _Reference} -> St end. terminate({ok, _Data}, St) -> - TestSuite = St#state.testsuite, + TestSuites = St#state.testsuites, XmlDir = St#state.xmldir, - write_report(TestSuite, XmlDir), + write_reports(TestSuites, XmlDir), ok; terminate({error, _Reason}, _St) -> %% Don't report any errors here, since eunit_tty takes care of that. %% Just terminate. ok. -handle_begin(group, Data, St) -> +handle_begin(Kind, Data, St) when Kind == group; Kind == test -> + %% Run this code both for groups and tests; test is a bit + %% surprising: This is a workaround for the fact that we don't get + %% a group (handle_begin(group, ...) for testsuites (modules) + %% which only have one test case. In that case we get a test case + %% with an id comprised of just one integer - the group id. NewId = proplists:get_value(id, Data), case NewId of [] -> St; - [_GroupId] -> + [GroupId] -> Desc = proplists:get_value(desc, Data), - TestSuite = St#state.testsuite, - NewTestSuite = TestSuite#testsuite{name = Desc}, - St#state{testsuite=NewTestSuite}; + TestSuite = #testsuite{id = GroupId, name = Desc}, + St#state{testsuites=store_suite(TestSuite, St#state.testsuites)}; %% Surefire format is not hierarchic: Ignore subgroups: _ -> St - end; -handle_begin(test, _Data, St) -> - St. + end. handle_end(group, Data, St) -> %% Retrieve existing test suite: case proplists:get_value(id, Data) of [] -> St; - [_GroupId|_] -> - TestSuite = St#state.testsuite, + [GroupId|_] -> + TestSuites = St#state.testsuites, + TestSuite = lookup_suite_by_group_id(GroupId, TestSuites), %% Update TestSuite data: Time = proplists:get_value(time, Data), Output = proplists:get_value(output, Data), NewTestSuite = TestSuite#testsuite{ time = Time, output = Output }, - St#state{testsuite=NewTestSuite} + St#state{testsuites=store_suite(NewTestSuite, TestSuites)} end; handle_end(test, Data, St) -> %% Retrieve existing test suite: - TestSuite = St#state.testsuite, + [GroupId|_] = proplists:get_value(id, Data), + TestSuites = St#state.testsuites, + TestSuite = lookup_suite_by_group_id(GroupId, TestSuites), %% Create test case: Name = format_name(proplists:get_value(source, Data), @@ -149,7 +155,7 @@ handle_end(test, Data, St) -> TestCase = #testcase{name = Name, description = Desc, time = Time,output = Output}, NewTestSuite = add_testcase_to_testsuite(Result, TestCase, TestSuite), - St#state{testsuite=NewTestSuite}. + St#state{testsuites=store_suite(NewTestSuite, TestSuites)}. %% Cancel group does not give information on the individual cancelled test case %% We ignore this event @@ -157,7 +163,9 @@ handle_cancel(group, _Data, St) -> St; handle_cancel(test, Data, St) -> %% Retrieve existing test suite: - TestSuite = St#state.testsuite, + [GroupId|_] = proplists:get_value(id, Data), + TestSuites = St#state.testsuites, + TestSuite = lookup_suite_by_group_id(GroupId, TestSuites), %% Create test case: Name = format_name(proplists:get_value(source, Data), @@ -171,7 +179,7 @@ handle_cancel(test, Data, St) -> NewTestSuite = TestSuite#testsuite{ skipped = TestSuite#testsuite.skipped+1, testcases=[TestCase|TestSuite#testsuite.testcases] }, - St#state{testsuite=NewTestSuite}. + St#state{testsuites=store_suite(NewTestSuite, TestSuites)}. format_name({Module, Function, Arity}, Line) -> lists:flatten([atom_to_list(Module), ":", atom_to_list(Function), "/", @@ -183,6 +191,12 @@ format_desc(Desc) when is_binary(Desc) -> format_desc(Desc) when is_list(Desc) -> Desc. +lookup_suite_by_group_id(GroupId, TestSuites) -> + #testsuite{} = lists:keyfind(GroupId, #testsuite.id, TestSuites). + +store_suite(#testsuite{id=GroupId} = TestSuite, TestSuites) -> + lists:keystore(GroupId, #testsuite.id, TestSuites, TestSuite). + %% Add testcase to testsuite depending on the result of the test. add_testcase_to_testsuite(ok, TestCaseTmp, TestSuite) -> TestCase = TestCaseTmp#testcase{ result = ok }, @@ -214,6 +228,10 @@ add_testcase_to_testsuite({error, Exception}, TestCaseTmp, TestSuite) -> %% Write a report to the XML directory. %% This function opens the report file, calls write_report_to/2 and closes the file. %% ---------------------------------------------------------------------------- +write_reports(TestSuites, XmlDir) -> + lists:foreach(fun(TestSuite) -> write_report(TestSuite, XmlDir) end, + TestSuites). + write_report(#testsuite{name = Name} = TestSuite, XmlDir) -> Filename = filename:join(XmlDir, lists:flatten(["TEST-", escape_suitename(Name)], ".xml")), case file:open(Filename, [write, raw]) of diff --git a/lib/eunit/src/eunit_test.erl b/lib/eunit/src/eunit_test.erl index d322c4b420..9ac1d1e7d9 100644 --- a/lib/eunit/src/eunit_test.erl +++ b/lib/eunit/src/eunit_test.erl @@ -131,12 +131,27 @@ macro_test_() -> [{module,_}, {line,_}, {expression,_}, - {expected,"[ _ ]"}, + {pattern,"[ _ ]"}, {value,[]}]}, _}} = run_testfun(F) end), ?_test(begin + {?LINE, F} = ?_assertNotMatch(ok, error), + {ok, ok} = run_testfun(F) + end), + ?_test(begin + {?LINE, F} = ?_assertNotMatch([_], [42]), + {error,{error,{assertNotMatch_failed, + [{module,_}, + {line,_}, + {expression,_}, + {pattern,"[ _ ]"}, + {value,[42]}]}, + _}} + = run_testfun(F) + end), + ?_test(begin {?LINE, F} = ?_assertEqual(ok, ok), {ok, ok} = run_testfun(F) end), @@ -152,6 +167,20 @@ macro_test_() -> = run_testfun(F) end), ?_test(begin + {?LINE, F} = ?_assertNotEqual(1, 0), + {ok, ok} = run_testfun(F) + end), + ?_test(begin + {?LINE, F} = ?_assertNotEqual(2, 1+1), + {error,{error,{assertNotEqual_failed, + [{module,_}, + {line,_}, + {expression,_}, + {value,2}]}, + _}} + = run_testfun(F) + end), + ?_test(begin {?LINE, F} = ?_assertException(error, badarith, erlang:error(badarith)), {ok, ok} = run_testfun(F) @@ -162,7 +191,7 @@ macro_test_() -> [{module,_}, {line,_}, {expression,_}, - {expected,_}, + {pattern,_}, {unexpected_success,ok}]}, _}} = run_testfun(F) @@ -174,15 +203,48 @@ macro_test_() -> [{module,_}, {line,_}, {expression,_}, - {expected,_}, + {pattern,_}, + {unexpected_exception, + {error,badarith,_}}]}, + _}} + = run_testfun(F) + end), + ?_test(begin + {?LINE, F} = ?_assertError(badarith, + erlang:error(badarith)), + {ok, ok} = run_testfun(F) + end), + ?_test(begin + {?LINE, F} = ?_assertExit(normal, exit(normal)), + {ok, ok} = run_testfun(F) + end), + ?_test(begin + {?LINE, F} = ?_assertThrow(foo, throw(foo)), + {ok, ok} = run_testfun(F) + end), + ?_test(begin + {?LINE, F} = ?_assertNotException(error, badarith, 42), + {ok, ok} = run_testfun(F) + end), + ?_test(begin + {?LINE, F} = ?_assertNotException(error, badarith, + erlang:error(badarg)), + {ok, ok} = run_testfun(F) + end), + ?_test(begin + {?LINE, F} = ?_assertNotException(error, badarith, + erlang:error(badarith)), + {error,{error,{assertNotException_failed, + [{module,_}, + {line,_}, + {expression,_}, + {pattern,_}, {unexpected_exception, {error,badarith,_}}]}, _}} = run_testfun(F) end) ]}. - -under_eunit_test() -> ?assert(?UNDER_EUNIT). -endif. diff --git a/lib/eunit/src/eunit_tests.erl b/lib/eunit/src/eunit_tests.erl index 37c0b4d6ae..a63d102d98 100644 --- a/lib/eunit/src/eunit_tests.erl +++ b/lib/eunit/src/eunit_tests.erl @@ -26,17 +26,17 @@ -include("eunit.hrl"). -ifdef(TEST). -%% Cause all the other modules to be tested as well as this one. -full_test_() -> - %%{application, eunit}. % this currently causes a loop - %% We use the below until loop detection is implemented - [eunit_autoexport, - eunit_striptests, - eunit_server, - eunit_proc, - eunit_serial, - eunit_test, - eunit_lib, - eunit_data, - eunit_tty]. +id(X) -> X. % for suppressing compiler warnings -endif. + +under_eunit_test() -> ?assert(?UNDER_EUNIT). + +let_test() -> ?assertEqual(42, ?LET(X, 17, X+25)). + +if_test_() -> + [?_assertEqual(17, ?IF(id(1) > 0, 17, 42)), + ?_assertEqual(42, ?IF(id(1) < 0, 17, 42))]. + +matches_test_() -> + [?_assert(?MATCHES("hel"++_, "hello")), + ?_assertNot(?MATCHES("hal"++_, "hello"))]. diff --git a/lib/eunit/vsn.mk b/lib/eunit/vsn.mk index d7edd7977b..d933085bbc 100644 --- a/lib/eunit/vsn.mk +++ b/lib/eunit/vsn.mk @@ -1 +1 @@ -EUNIT_VSN = 2.1.7 +EUNIT_VSN = 2.2.0 diff --git a/lib/gs/contribs/bonk/sounder.erl b/lib/gs/contribs/bonk/sounder.erl index 11ab03d167..899f20d4e0 100644 --- a/lib/gs/contribs/bonk/sounder.erl +++ b/lib/gs/contribs/bonk/sounder.erl @@ -72,13 +72,13 @@ stop() -> sounder ! {stop}, ok end. -new(File) when list(File) -> new(list_to_atom(File)); -new(File) when atom(File) -> +new(File) when is_list(File) -> new(list_to_atom(File)); +new(File) when is_atom(File) -> catch begin check(), sounder ! {new,File,self()}, wait_for_ack(sounder) end. -play(No) when integer(No) -> +play(No) when is_integer(No) -> catch begin check(), sounder ! {play, No, self()}, wait_for_ack(sounder) end. @@ -94,14 +94,14 @@ go() -> loop(Port) -> receive - {new, File, From} when atom(File) -> + {new, File, From} when is_atom(File) -> Port ! {self(),{command,lists:append([0],atom_to_list(File))}}, From ! {sounder,wait_for_ack(Port)}, loop(Port); {play,silent,From} -> From ! {sounder,false}, loop(Port); - {play,No,From} when integer(No) -> + {play,No,From} when is_integer(No) -> Port ! {self(),{command,[No]}}, From ! {sounder,wait_for_ack(Port)}, loop(Port); @@ -118,13 +118,13 @@ loop(Port) -> nosound() -> receive - {new,File,From} when atom(File) -> + {new,File,From} when is_atom(File) -> From ! {sounder,{ok,silent}}, nosound(); {play,silent,From} -> From ! {sounder,true}, nosound(); - {play,No,From} when integer(No) -> + {play,No,From} when is_integer(No) -> From ! {sounder,{error,no_audio_cap}}, nosound(); {stop} -> @@ -135,7 +135,7 @@ nosound() -> wait_for_ack(sounder) -> receive {sounder,Res} -> Res end; -wait_for_ack(Port) when port(Port) -> +wait_for_ack(Port) when is_port(Port) -> receive {Port,{data,"ok"}} -> ok; @@ -149,7 +149,7 @@ wait_for_ack(Port) when port(Port) -> check() -> case whereis(sounder) of - Pid when pid(Pid) -> + Pid when is_pid(Pid) -> ok; undefined -> throw({error,sounder_not_started}) diff --git a/lib/gs/contribs/cols/cols.erl b/lib/gs/contribs/cols/cols.erl index 67b46d0dfb..439eb717f7 100644 --- a/lib/gs/contribs/cols/cols.erl +++ b/lib/gs/contribs/cols/cols.erl @@ -278,7 +278,7 @@ fall_column([], _X, _Y, ColumnAcc, ChecksAcc) -> fall_column([black|Colors], X, Y, ColumnAcc, ChecksAcc) -> case find_box(Colors) of false -> {ColumnAcc, ChecksAcc}; - NewColors when list(NewColors) -> + NewColors when is_list(NewColors) -> fall_one_step(NewColors, X, Y, ColumnAcc, ChecksAcc) end; fall_column([Color|Colors], X, Y, ColumnAcc, ChecksAcc) -> @@ -330,7 +330,7 @@ new_column_list([], _, _) -> []. %%---------------------------------------------------------------------- %% Returns: a reversed list of colors. %%---------------------------------------------------------------------- -columntuple_to_list(ColumnTuple) when tuple(ColumnTuple) -> +columntuple_to_list(ColumnTuple) when is_tuple(ColumnTuple) -> columntuple_to_list(tuple_to_list(ColumnTuple),[]). columntuple_to_list([],Acc) -> Acc; diff --git a/lib/gs/contribs/mandel/mandel.erl b/lib/gs/contribs/mandel/mandel.erl index d4d2452463..579f8e487b 100644 --- a/lib/gs/contribs/mandel/mandel.erl +++ b/lib/gs/contribs/mandel/mandel.erl @@ -119,7 +119,7 @@ start_client(Opts,Nodes) -> try_random(random,Low,High) -> random:uniform()*(High-Low)+Low; -try_random(Float,_Low,_High) when number(Float) -> Float. +try_random(Float,_Low,_High) when is_number(Float) -> Float. %%----------------------------------------------------------------- diff --git a/lib/gs/contribs/othello/othello_board.erl b/lib/gs/contribs/othello/othello_board.erl index 0206ba2ded..6ccb79b7e4 100644 --- a/lib/gs/contribs/othello/othello_board.erl +++ b/lib/gs/contribs/othello/othello_board.erl @@ -147,7 +147,7 @@ but_pressed("Help",_ButtId,_User,GamePid,_Shell,_Wids,_Op) -> but_pressed("Newgame",_ButtId,_User,GamePid,_Shell,Wids,Options) -> new_game(GamePid,Wids,Options); but_pressed([],ButtId,User,GamePid,_Shell,_Wids,_Op) - when pid(GamePid),User == player -> + when is_pid(GamePid),User == player -> [C,R] = atom_to_list(ButtId), GamePid ! {self(),position,othello_adt:pos(C-96,translate(R-48))}, GamePid; @@ -243,7 +243,7 @@ game_msg(Msg,User,GamePid,Shell,Wids,Options) -> end. -new_game(GamePid,Wids,Options) when pid(GamePid) -> +new_game(GamePid,Wids,Options) when is_pid(GamePid) -> exit(GamePid,kill), new_game(Wids,Options); new_game(_,Wids,Options) -> diff --git a/lib/gs/examples/calc2.erl b/lib/gs/examples/calc2.erl index d28780de01..9969a6c40f 100644 --- a/lib/gs/examples/calc2.erl +++ b/lib/gs/examples/calc2.erl @@ -54,7 +54,7 @@ calc() -> calc_loop(Lbl,M,V,Op) -> receive - {gs,_,click,D,_} when integer(D) -> + {gs,_,click,D,_} when is_integer(D) -> digit_press(Lbl,M,V*10+D,Op); {gs,_,click,'C',_} -> c(Lbl,M,V,Op); diff --git a/lib/hipe/cerl/erl_bif_types.erl b/lib/hipe/cerl/erl_bif_types.erl index 0b47c7b6e1..827fa79ec5 100644 --- a/lib/hipe/cerl/erl_bif_types.erl +++ b/lib/hipe/cerl/erl_bif_types.erl @@ -366,7 +366,7 @@ type(erlang, '>', 2, Xs = [Lhs, Rhs]) -> is_integer(LhsMax), is_integer(RhsMin), RhsMin >= LhsMax -> F; true -> t_boolean() end; - false -> t_boolean() + false -> compare('>', Lhs, Rhs) end, strict(Xs, Ans); type(erlang, '>=', 2, Xs = [Lhs, Rhs]) -> @@ -384,7 +384,7 @@ type(erlang, '>=', 2, Xs = [Lhs, Rhs]) -> is_integer(LhsMax), is_integer(RhsMin), RhsMin > LhsMax -> F; true -> t_boolean() end; - false -> t_boolean() + false -> compare('>=', Lhs, Rhs) end, strict(Xs, Ans); type(erlang, '<', 2, Xs = [Lhs, Rhs]) -> @@ -402,7 +402,7 @@ type(erlang, '<', 2, Xs = [Lhs, Rhs]) -> is_integer(LhsMin), is_integer(RhsMax), RhsMax =< LhsMin -> F; true -> t_boolean() end; - false -> t_boolean() + false -> compare('<', Lhs, Rhs) end, strict(Xs, Ans); type(erlang, '=<', 2, Xs = [Lhs, Rhs]) -> @@ -420,7 +420,7 @@ type(erlang, '=<', 2, Xs = [Lhs, Rhs]) -> is_integer(LhsMin), is_integer(RhsMax), RhsMax < LhsMin -> F; true -> t_boolean() end; - false -> t_boolean() + false -> compare('=<', Lhs, Rhs) end, strict(Xs, Ans); type(erlang, '+', 1, Xs) -> @@ -672,6 +672,9 @@ type(erlang, call_on_load_function, 1, Xs) -> type(erlang, cancel_timer, 1, Xs) -> strict(arg_types(erlang, cancel_timer, 1), Xs, fun (_) -> t_sup(t_integer(), t_atom('false')) end); +type(erlang, check_old_code, 1, Xs) -> + strict(arg_types(erlang, check_old_code, 1), Xs, + fun (_) -> t_boolean() end); type(erlang, check_process_code, 2, Xs) -> strict(arg_types(erlang, check_process_code, 2), Xs, fun (_) -> t_boolean() end); @@ -702,7 +705,7 @@ type(erlang, demonitor, 1, Xs) -> type(erlang, demonitor, 2, Xs) -> strict(arg_types(erlang, demonitor, 2), Xs, fun (_) -> t_boolean() end); type(erlang, disconnect_node, 1, Xs) -> - strict(arg_types(erlang, disconnect_node, 1), Xs, fun (_) -> t_boolean() end); + strict(arg_types(erlang, disconnect_node, 1), Xs, fun (_) -> t_sup([t_boolean(), t_atom('ignored')]) end); type(erlang, display, 1, _) -> t_atom('true'); type(erlang, display_string, 1, Xs) -> strict(arg_types(erlang, display_string, 1), Xs, fun(_) -> t_atom('true') end); @@ -736,6 +739,7 @@ type(erlang, element, 2, Xs) -> type(erlang, erase, 0, _) -> t_any(); type(erlang, erase, 1, _) -> t_any(); type(erlang, external_size, 1, _) -> t_integer(); +type(erlang, external_size, 2, _) -> t_integer(); type(erlang, finish_after_on_load, 2, Xs) -> %% Internal BIF used by on_load. strict(arg_types(erlang, finish_after_on_load, 2), Xs, @@ -1124,7 +1128,7 @@ type(erlang, nodes, 0, _) -> t_list(t_node()); type(erlang, nodes, 1, Xs) -> strict(arg_types(erlang, nodes, 1), Xs, fun (_) -> t_list(t_node()) end); type(erlang, now, 0, _) -> - t_time(); + t_timestamp(); type(erlang, open_port, 2, Xs) -> strict(arg_types(erlang, open_port, 2), Xs, fun (_) -> t_port() end); type(erlang, phash, 2, Xs) -> @@ -1199,6 +1203,7 @@ type(erlang, process_flag, 2, Xs) -> case t_atom_vals(Flag) of ['error_handler'] -> t_atom(); ['min_heap_size'] -> t_non_neg_integer(); + ['scheduler'] -> t_non_neg_integer(); ['monitor_nodes'] -> t_boolean(); ['priority'] -> t_process_priority_level(); ['save_calls'] -> t_non_neg_integer(); @@ -1585,8 +1590,7 @@ type(erlang, system_info, 1, Xs) -> ['multi_scheduling_blockers'] -> t_list(t_pid()); ['os_type'] -> - t_tuple([t_sup([t_atom('ose'), % XXX: undocumented - t_atom('unix'), + t_tuple([t_sup([t_atom('unix'), t_atom('vxworks'), t_atom('win32')]), t_atom()]); @@ -1900,7 +1904,7 @@ type(prim_file, internal_native2name, 1, Xs) -> fun (_) -> t_prim_file_name() end); type(prim_file, internal_normalize_utf8, 1, Xs) -> strict(arg_types(prim_file, internal_normalize_utf8, 1), Xs, - fun (_) -> t_binary() end); + fun (_) -> t_unicode_string() end); %%-- gen_tcp ------------------------------------------------------------------ %% NOTE: All type information for this module added to avoid loss of precision type(gen_tcp, accept, 1, Xs) -> @@ -2693,7 +2697,7 @@ type(os, getpid, 0, _) -> t_string(); type(os, putenv, 2, Xs) -> strict(arg_types(os, putenv, 2), Xs, fun (_) -> t_atom('true') end); type(os, timestamp, 0, _) -> - t_time(); + t_timestamp(); %%-- re ----------------------------------------------------------------------- type(re, compile, 1, Xs) -> strict(arg_types(re, compile, 1), Xs, @@ -3176,6 +3180,50 @@ arith(Op, X1, X2) -> end. %%============================================================================= +%% Comparison of terms +%%============================================================================= + +compare(Op, Lhs, Rhs) -> + case t_is_none(t_inf(Lhs, Rhs)) of + false -> t_boolean(); + true -> + case Op of + '<' -> always_smaller(Lhs, Rhs); + '>' -> always_smaller(Rhs, Lhs); + '=<' -> always_smaller(Lhs, Rhs); + '>=' -> always_smaller(Rhs, Lhs) + end + end. + +always_smaller(Type1, Type2) -> + {Min1, Max1} = type_ranks(Type1), + {Min2, Max2} = type_ranks(Type2), + if Max1 < Min2 -> t_atom('true'); + Min1 > Max2 -> t_atom('false'); + true -> t_boolean() + end. + +type_ranks(Type) -> + type_ranks(Type, 1, 0, 0, type_order()). + +type_ranks(_Type, _I, Min, Max, []) -> {Min, Max}; +type_ranks(Type, I, Min, Max, [TypeClass|Rest]) -> + {NewMin, NewMax} = + case t_is_none(t_inf(Type, TypeClass)) of + true -> {Min, Max}; + false -> case Min of + 0 -> {I, I}; + _ -> {Min, I} + end + end, + type_ranks(Type, I+1, NewMin, NewMax, Rest). + +type_order() -> + [t_number(), t_atom(), t_reference(), t_fun(), t_port(), t_pid(), t_tuple(), + t_list(), t_binary()]. + + +%%============================================================================= -spec arg_types(atom(), atom(), arity()) -> [erl_types:erl_type()] | 'unknown'. @@ -3396,6 +3444,8 @@ arg_types(erlang, call_on_load_function, 1) -> [t_atom()]; arg_types(erlang, cancel_timer, 1) -> [t_reference()]; +arg_types(erlang, check_old_code, 1) -> + [t_atom()]; arg_types(erlang, check_process_code, 2) -> [t_pid(), t_atom()]; arg_types(erlang, concat_binary, 1) -> @@ -3442,6 +3492,8 @@ arg_types(erlang, exit, 2) -> [t_sup(t_pid(), t_port()), t_any()]; arg_types(erlang, external_size, 1) -> [t_any()]; % takes any term as input +arg_types(erlang, external_size, 2) -> + [t_any(), t_list()]; % takes any term as input and a list of options arg_types(erlang, finish_after_on_load, 2) -> [t_atom(), t_boolean()]; arg_types(erlang, float, 1) -> @@ -3696,6 +3748,7 @@ arg_types(erlang, process_display, 2) -> arg_types(erlang, process_flag, 2) -> [t_sup([t_atom('trap_exit'), t_atom('error_handler'), t_atom('min_heap_size'), t_atom('priority'), t_atom('save_calls'), + t_atom('scheduler'), % undocumented t_atom('monitor_nodes'), % undocumented t_tuple([t_atom('monitor_nodes'), t_list()])]), % undocumented t_sup([t_boolean(), t_atom(), t_non_neg_integer()])]; @@ -3734,7 +3787,7 @@ arg_types(erlang, send, 3) -> arg_types(erlang, send_after, 3) -> [t_non_neg_integer(), t_sup(t_pid(), t_atom()), t_any()]; arg_types(erlang, seq_trace, 2) -> - [t_atom(), t_sup([t_boolean(), t_tuple([t_fixnum(), t_fixnum()]), t_nil()])]; + [t_atom(), t_sup([t_boolean(), t_tuple([t_fixnum(), t_fixnum()]), t_fixnum(), t_nil()])]; arg_types(erlang, seq_trace_info, 1) -> [t_seq_trace_info()]; arg_types(erlang, seq_trace_print, 1) -> @@ -3983,7 +4036,7 @@ arg_types(ets, match_object, 3) -> arg_types(ets, match_spec_compile, 1) -> [t_matchspecs()]; arg_types(ets, match_spec_run_r, 3) -> - [t_matchspecs(), t_any(), t_list()]; + [t_list(t_tuple()),t_matchspecs(), t_list()]; arg_types(ets, member, 2) -> [t_tab(), t_any()]; arg_types(ets, new, 2) -> @@ -4015,8 +4068,12 @@ arg_types(ets, select_reverse, 3) -> arg_types(ets, slot, 2) -> [t_tab(), t_non_neg_fixnum()]; % 2nd arg can be 0 arg_types(ets, setopts, 2) -> - Opt = t_sup(t_tuple([t_atom('heir'), t_pid(), t_any()]), - t_tuple([t_atom('heir'), t_atom('none')])), + Opt = t_sup([t_tuple([t_atom('heir'), t_pid(), t_any()]), + t_tuple([t_atom('heir'), t_atom('none')]), + t_tuple([t_atom('protection'), + t_sup([t_atom('protected'), + t_atom('private'), + t_atom('public')])])]), [t_tab(), t_sup(Opt, t_list(Opt))]; arg_types(ets, update_counter, 3) -> Int = t_integer(), @@ -4458,6 +4515,9 @@ t_date() -> t_time() -> t_tuple([t_non_neg_fixnum(), t_non_neg_fixnum(), t_non_neg_fixnum()]). +t_timestamp() -> + t_tuple([t_non_neg_fixnum(), t_non_neg_fixnum(), t_non_neg_fixnum()]). + t_packet() -> t_sup([t_binary(), t_iolist(), t_httppacket()]). @@ -4805,6 +4865,9 @@ t_ets_info_items() -> t_atom('owner'), t_atom('protection'), t_atom('size'), + t_atom('compressed'), + t_atom('heir'), + t_atom('stats'), t_atom('type')]). %% ===================================================================== diff --git a/lib/hipe/main/hipe.hrl.src b/lib/hipe/main/hipe.hrl.src index a1fbeda9cf..ec55c707ef 100644 --- a/lib/hipe/main/hipe.hrl.src +++ b/lib/hipe/main/hipe.hrl.src @@ -50,9 +50,8 @@ %% Flags: %% DEBUG - Turns on debugging. (Can be defined to a integer %% value to determine the level of debugging) -%% VERBOSE - More info is printed... %% HIPE_LOGGING - Turn on logging of messages with erl_logger. -%% DO_ASSERT - Turn on Assertions. +%% DO_ASSERT - Turn on assertions. %% TIMING - Turn on timing. %% HIPE_INSTRUMENT_COMPILER - Turn on instrumentation of the compiler. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -107,13 +106,9 @@ %% %% Define the exit macro %% --ifdef(VERBOSE). --define(EXIT(Reason), erlang:error({?MODULE,?LINE,Reason})). --else. -define(EXIT(Reason), ?msg("EXITED with reason ~w @~w:~w\n", [Reason,?MODULE,?LINE]), erlang:error({?MODULE,?LINE,Reason})). --endif. %% %% Assertions. diff --git a/lib/ic/doc/src/notes.xml b/lib/ic/doc/src/notes.xml index 5f6c31069c..de519d5f84 100644 --- a/lib/ic/doc/src/notes.xml +++ b/lib/ic/doc/src/notes.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>1998</year><year>2010</year> + <year>1998</year><year>2011</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -31,6 +31,22 @@ </header> <section> + <title>IC 4.2.27</title> + + <section> + <title>Improvements and New Features</title> + <list type="bulleted"> + <item> + <p> + Reduced compile overhead (Thanks to Haitao Li).</p> + <p> + Own Id: OTP-9460 </p> + </item> + </list> + </section> + </section> + + <section> <title>IC 4.2.26</title> <section> diff --git a/lib/ic/src/ic_pp.erl b/lib/ic/src/ic_pp.erl index db06118d32..8b53473caa 100644 --- a/lib/ic/src/ic_pp.erl +++ b/lib/ic/src/ic_pp.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% Copyright Ericsson AB 1997-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -92,6 +92,14 @@ %% %%====================================================================================== +%% Multiple Include Optimization +%% +%% Algorithm described at: +%% http://gcc.gnu.org/onlinedocs/cppinternals/Guard-Macros.html +-record(mio, {valid = true, %% multiple include valid + cmacro, %% controlling macro of the current conditional directive + depth = 0, %% conditional directive depth + included = []}). @@ -130,7 +138,7 @@ run(FileList, FileName, IncDir, Flags) -> %%---------------------------------------------------------- %% Run the second phase, i.e expand macros %%---------------------------------------------------------- - {Out, Err, War, _Defs, IfCou} = expand(File, FileName, IncDir, Flags), + {Out, Err, War, _Defs, _Mio, IfCou} = expand(File, FileName, IncDir, Flags), %%---------------------------------------------------------- %% Check if all #if #ifdef #ifndef have a matching #endif @@ -155,9 +163,9 @@ run(FileList, FileName, IncDir, Flags) -> %% The entry for all included files %% %% -%% Output {Out, Defs, Err, War} +%% Output {Out, Err, War, Defs, MultipleIncludeValid} %%====================================================================================== -run_include(FileName, FileList, _Out, Defs, Err, War, IncLine, IncFile, IncDir) -> +run_include(FileName, FileList, _Out, Defs, Err, War, IncLine, IncFile, IncDir, Mio) -> %%---------------------------------------------------------- %% Run the first phase, i.e tokenise the file @@ -169,18 +177,21 @@ run_include(FileName, FileList, _Out, Defs, Err, War, IncLine, IncFile, IncDir) %%---------------------------------------------------------- %% Run the second phase, i.e expand macros %%---------------------------------------------------------- - - %% Try first pass without file info start/end - {OutT, ErrT, WarT, DefsT, IfCouT} = - expand(File, Defs, Err, War, [FileName|IncFile], IncDir), - - {Out2, Err2, War2, Defs2, IfCou2} = - case only_nls(OutT) of - true -> %% The file is defined before - {["\n"], ErrT, WarT, DefsT, IfCouT}; - false -> %% The file is not defined before, try second pass - expand([FileInfoStart|File]++FileInfoEnd, Defs, Err, War, [FileName|IncFile], IncDir) - end, + {Out2, Err2, War2, Defs2, Mio2, IfCou2} = + expand([FileInfoStart|File]++FileInfoEnd, Defs, Err, War, + [FileName|IncFile], IncDir, + #mio{included=Mio#mio.included}), + + MergeIncluded = sets:to_list(sets:from_list(Mio#mio.included ++ Mio2#mio.included)), + + Mio3 = + case {Mio2#mio.valid, Mio2#mio.cmacro} of + {V, Macro} when V == false; + Macro == undefined -> + update_mio(Mio#mio{included=MergeIncluded}); + {true, _} -> + update_mio({include, FileName}, Mio#mio{included=MergeIncluded}) + end, %%---------------------------------------------------------- %% Check if all #if #ifdef #ifndef have a matching #endif @@ -192,26 +203,7 @@ run_include(FileName, FileList, _Out, Defs, Err, War, IncLine, IncFile, IncDir) [] end, - {Out2, Defs2, Err2++IfError, War2}. - - - -%% Return true if there is no data -%% other than new lines -only_nls([]) -> - true; -only_nls(["\n"|Rem]) -> - only_nls(Rem); -only_nls(["\r","\n"|Rem]) -> - only_nls(Rem); -only_nls([_|_Rem]) -> - false. - - - - - - + {Out2, Defs2, Err2++IfError, War2, Mio3}. @@ -647,87 +639,86 @@ expand(List, FileName, IncDir, Flags) -> %% Get all definitions from preprocessor commnads %% and merge them on top of the file collected. CLDefs = get_cmd_line_defs(Flags), - expand(List, [], [], CLDefs, [FileName], IncDir, check_all, [], [], 1, FileName). - -expand(List, Defs, Err, War, [FileName|IncFile], IncDir) -> - expand(List, [], [], Defs, [FileName|IncFile], IncDir, check_all, Err, War, 1, FileName). + expand(List, [], [], CLDefs, [FileName], IncDir, #mio{}, check_all, [], [], 1, FileName). +expand(List, Defs, Err, War, [FileName|IncFile], IncDir, Mio) -> + expand(List, [], [], Defs, [FileName|IncFile], IncDir, Mio, check_all, Err, War, 1, FileName). %%======================================================= %% Main loop for the expansion %%======================================================= -expand([], Out, _SelfRef, Defs, _IncFile, _IncDir, IfCou, Err, War, _L, _FN) -> +expand([], Out, _SelfRef, Defs, _IncFile, _IncDir, Mio, IfCou, Err, War, _L, _FN) -> % io:format("~n ===============~n"), % io:format(" definitions ~p~n",[lists:reverse(Defs)]), % io:format(" found warnings ~p~n",[lists:reverse(War)]), % io:format(" found errors ~p~n",[lists:reverse(Err)]), % io:format(" ===============~n~n~n"), - {Out, Err, War, Defs, IfCou}; + {Out, Err, War, Defs, Mio, IfCou}; -expand([{file_info, Str} | Rem], Out, SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L, FN) -> - expand(Rem, Str++Out, SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L, FN); +expand([{file_info, Str} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) -> + expand(Rem, Str++Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN); %%--------------------------------------- %% Searching for endif, %% i.e skip all source lines until matching %% end if is encountered %%--------------------------------------- -expand([{command,Command} | Rem], Out, SelfRef, Defs, IncFile, IncDir, {endif, Endif, IfLine}, Err, War, L, FN) +expand([{command,Command} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, {endif, Endif, IfLine}, Err, War, L, FN) when Command == "ifdef" -> {_Removed, Rem2, _Nl} = read_to_nl(Rem), IfCou2 = {endif, Endif+1, IfLine}, - expand(Rem2, Out, SelfRef, Defs, IncFile, IncDir, IfCou2, Err, War, L, FN); + expand(Rem2, Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou2, Err, War, L, FN); -expand([{command,Command} | Rem], Out, SelfRef, Defs, IncFile, IncDir, {endif, Endif, IfLine}, Err, War, L, FN) +expand([{command,Command} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, {endif, Endif, IfLine}, Err, War, L, FN) when Command == "ifndef" -> {_Removed, Rem2, _Nl} = read_to_nl(Rem), IfCou2 = {endif, Endif+1, IfLine}, - expand(Rem2, Out, SelfRef, Defs, IncFile, IncDir, IfCou2, Err, War, L, FN); + expand(Rem2, Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou2, Err, War, L, FN); -expand([{command,Command} | Rem], Out, SelfRef, Defs, IncFile, IncDir, {endif, Endif, IfLine}, Err, War, L, FN) +expand([{command,Command} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, {endif, Endif, IfLine}, Err, War, L, FN) when Command == "if" -> - case pp_command(Command, Rem, Defs, IncDir, Err, War, L, FN) of + case pp_command(Command, Rem, Defs, IncDir, Mio, Err, War, L, FN) of {{'if', true}, Rem2, Err2, War2, Nl} -> IfCou2 = {endif, Endif+1, IfLine}, - expand(Rem2, Out, SelfRef, Defs, IncFile, IncDir, IfCou2, Err2, War2, L+Nl, FN); + expand(Rem2, Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou2, Err2, War2, L+Nl, FN); %% {{'if', false}, Rem2, Err2, War2, Nl} -> Not implemented yet {{'if', error}, Rem2, Err2, War2, Nl} -> IfCou2 = {endif, Endif, IfLine}, - expand(Rem2, Out, SelfRef, Defs, IncFile, IncDir, IfCou2, Err2, War2, L+Nl, FN) + expand(Rem2, Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou2, Err2, War2, L+Nl, FN) end; -expand([{command,Command} | Rem], Out, SelfRef, Defs, IncFile, IncDir, {endif, Endif, IfLine}, Err, War, L, FN) +expand([{command,Command} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, {endif, Endif, IfLine}, Err, War, L, FN) when Command == "endif" -> {_Removed, Rem2, Nl} = read_to_nl(Rem), case Endif of 1 -> - Out2 = [lists:duplicate(Nl,$\n)|Out], - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, check_all, Err, War, L+Nl, FN); + Out2 = lists:duplicate(Nl,$\n) ++ Out, + expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, Mio, check_all, Err, War, L+Nl, FN); _ -> IfCou2 = {endif, Endif-1, IfLine}, - expand(Rem2, Out, SelfRef, Defs, IncFile, IncDir, IfCou2, Err, War, L+Nl, FN) + expand(Rem2, Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou2, Err, War, L+Nl, FN) end; -expand([{command,_Command} | Rem], Out, SelfRef, Defs, IncFile, IncDir, {endif, Endif, IfLine}, Err, War, L, FN) -> +expand([{command,_Command} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, {endif, Endif, IfLine}, Err, War, L, FN) -> {_Removed, Rem2, _Nl} = read_to_nl(Rem), IfCou2 = {endif, Endif, IfLine}, - expand(Rem2, Out, SelfRef, Defs, IncFile, IncDir, IfCou2, Err, War, L, FN); + expand(Rem2, Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou2, Err, War, L, FN); %% Solves a bug when spaces in front of hashmark ! -expand([space | Rem], Out, SelfRef, Defs, IncFile, IncDir, {endif, Endif, IfLine}, Err, War, L, FN) -> - expand(Rem, Out, SelfRef, Defs, IncFile, IncDir, {endif, Endif, IfLine}, Err, War, L, FN); +expand([space | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, {endif, Endif, IfLine}, Err, War, L, FN) -> + expand(Rem, Out, SelfRef, Defs, IncFile, IncDir, Mio, {endif, Endif, IfLine}, Err, War, L, FN); -expand([{nl,_Nl} | Rem], Out, SelfRef, Defs, IncFile, IncDir, {endif, Endif, IfLine}, Err, War, L, FN) -> - expand(Rem, Out, SelfRef, Defs, IncFile, IncDir, {endif, Endif, IfLine}, Err, War, L, FN); +expand([{nl,_Nl} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, {endif, Endif, IfLine}, Err, War, L, FN) -> + expand(Rem, Out, SelfRef, Defs, IncFile, IncDir, Mio, {endif, Endif, IfLine}, Err, War, L, FN); -expand([_X | Rem], Out, SelfRef, Defs, IncFile, IncDir, {endif, Endif, IfLine}, Err, War, L, FN) -> +expand([_X | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, {endif, Endif, IfLine}, Err, War, L, FN) -> {_Removed, Rem2, Nl} = read_to_nl(Rem), - Out2 = [lists:duplicate(Nl,$\n)|Out], - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, {endif, Endif, IfLine}, Err, War, L, FN); + Out2 = lists:duplicate(Nl,$\n) ++ Out, + expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, Mio, {endif, Endif, IfLine}, Err, War, L, FN); @@ -736,121 +727,132 @@ expand([_X | Rem], Out, SelfRef, Defs, IncFile, IncDir, {endif, Endif, IfLine}, %%--------------------------------------- %% Check all tokens %%--------------------------------------- -expand([{nl, _N} | Rem], Out, SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L, FN) -> - expand(Rem, [$\n | Out], SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L+1, FN); +expand([{nl, _N} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) -> + expand(Rem, [$\n | Out], SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L+1, FN); -expand([space | Rem], Out, SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L, FN) -> - expand(Rem, [?space | Out], SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L, FN); +expand([space | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) -> + expand(Rem, [?space | Out], SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN); -expand([space_exp | Rem], Out, SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L, FN) -> - expand(Rem, [?space | Out], SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L, FN); +expand([space_exp | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) -> + expand(Rem, [?space | Out], SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN); -expand([{command,Command} | Rem], Out, SelfRef, Defs, IncFile, IncDir, check_all, Err, War, L, FN) -> - case pp_command(Command, Rem, Defs, IncDir, Err, War, L, FN) of +expand([{command,Command} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, check_all, Err, War, L, FN) -> + case pp_command(Command, Rem, Defs, IncDir, Mio, Err, War, L, FN) of {define, Rem2, Defs2, Err2, War2, Nl} -> - Out2 = [lists:duplicate(Nl,$\n)|Out], - expand(Rem2, Out2, SelfRef, Defs2, IncFile, IncDir, check_all, Err2, War2, L+Nl, FN); + Out2 = lists:duplicate(Nl,$\n) ++ Out, + expand(Rem2, Out2, SelfRef, Defs2, IncFile, IncDir, update_mio(Mio), check_all, Err2, War2, L+Nl, FN); {undef, Rem2, Defs2, Err2, War2, Nl} -> - Out2 = [lists:duplicate(Nl,$\n)|Out], - expand(Rem2, Out2, SelfRef, Defs2, IncFile, IncDir, check_all, Err2, War2, L+Nl, FN); + Out2 = lists:duplicate(Nl,$\n) ++ Out, + expand(Rem2, Out2, SelfRef, Defs2, IncFile, IncDir, update_mio(Mio), check_all, Err2, War2, L+Nl, FN); {{include, ok}, FileName, FileCont, Rem2, Nl, Err2, War2} -> - {Out3, Defs3, Err3, War3} = - run_include(FileName, FileCont, Out, Defs, Err2, War2, L+Nl, IncFile, IncDir), + {Out3, Defs3, Err3, War3, Mio2} = + run_include(FileName, FileCont, Out, Defs, Err2, War2, L+Nl, IncFile, IncDir, Mio), Nls = [], Out4 = Out3++Nls++Out, - expand(Rem2, Out4, SelfRef, Defs3, IncFile, IncDir, check_all, Err3, War3, L+Nl, FN); + expand(Rem2, Out4, SelfRef, Defs3, IncFile, IncDir, Mio2, check_all, Err3, War3, L+Nl, FN); {{include, error}, Rem2, Nl, Err2, War2} -> - Out2 = [lists:duplicate(Nl,$\n)|Out], - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, check_all, Err2, War2, L+Nl, FN); + Out2 = lists:duplicate(Nl,$\n) ++ Out, + expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, update_mio(Mio), check_all, Err2, War2, L+Nl, FN); + + {{include, skip}, Rem2} -> + Out2 = [$\n|Out], + expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, update_mio(Mio), check_all, Err, War, L+1, FN); {{ifdef, true}, Rem2, Err2, War2, Nl} -> - Out2 = [lists:duplicate(Nl,$\n)|Out], + Out2 = lists:duplicate(Nl,$\n) ++ Out, IfCou2 = {endif, 1, L}, - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, IfCou2, Err2, War2, L+Nl, FN); + expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, Mio, IfCou2, Err2, War2, L+Nl, FN); {{ifdef, false}, Rem2, Err2, War2, Nl} -> - Out2 = [lists:duplicate(Nl,$\n)|Out], - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, check_all, Err2, War2, L+Nl, FN); + Out2 = lists:duplicate(Nl,$\n) ++ Out, + Mio2 = update_mio(ifdef, Mio), + expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, Mio2, check_all, Err2, War2, L+Nl, FN); {{ifndef, true}, Rem2, Err2, War2, Nl} -> - Out2 = [lists:duplicate(Nl,$\n)|Out], + Out2 = lists:duplicate(Nl,$\n) ++ Out, IfCou2 = {endif, 1, L}, - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, IfCou2, Err2, War2, L+Nl, FN); - {{ifndef, false}, Rem2, Err2, War2, Nl} -> - Out2 = [lists:duplicate(Nl,$\n)|Out], - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, check_all, Err2, War2, L+Nl, FN); + expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, Mio, IfCou2, Err2, War2, L+Nl, FN); + {{ifndef, false}, Macro, Rem2, Err2, War2, Nl} -> + Out2 = lists:duplicate(Nl,$\n) ++ Out, + Mio2 = update_mio({ifndef, Macro}, Mio), + expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, Mio2, check_all, Err2, War2, L+Nl, FN); {endif, Rem2, Err2, War2, Nl} -> - Out2 = [lists:duplicate(Nl,$\n)|Out], - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, check_all, Err2, War2, L+Nl, FN); + Out2 = lists:duplicate(Nl,$\n) ++ Out, + Mio2 = update_mio(endif, Mio), + expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, Mio2, check_all, Err2, War2, L+Nl, FN); {{'if', true}, Rem2, Err2, War2, Nl} -> - Out2 = [lists:duplicate(Nl,$\n)|Out], + Out2 = lists:duplicate(Nl,$\n) ++ Out, IfCou2 = {endif, 1, L}, - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, IfCou2, Err2, War2, L+Nl, FN); + expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, Mio, IfCou2, Err2, War2, L+Nl, FN); %% {{'if', false}, Removed, Rem2, Nl} -> Not implemented at present {{'if', error}, Rem2, Err2, War2, Nl} -> - Out2 = [lists:duplicate(Nl,$\n)|Out], - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, check_all, Err2, War2, L+Nl, FN); + Out2 = lists:duplicate(Nl,$\n) ++ Out, + Mio2 = update_mio('if', Mio), + expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, Mio2, check_all, Err2, War2, L+Nl, FN); {'else', {_Removed, Rem2, Nl}} -> - Out2 = [lists:duplicate(Nl,$\n)|Out], + Out2 = lists:duplicate(Nl,$\n) ++ Out, Err2 = {FN, L, "`else' command is not implemented at present"}, - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, check_all, [Err2|Err], War, L+Nl, FN); + Mio2 = update_mio('else', Mio), + expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, Mio2, check_all, [Err2|Err], War, L+Nl, FN); {'elif', {_Removed, Rem2, Nl}} -> - Out2 = [lists:duplicate(Nl,$\n)|Out], + Out2 = lists:duplicate(Nl,$\n) ++ Out, Err2 = {FN, L, "`elif' command is not implemented at present"}, - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, check_all, [Err2|Err], War, L+Nl, FN); + Mio2 = update_mio('elif', Mio), + expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, Mio2, check_all, [Err2|Err], War, L+Nl, FN); {warning, {WarningText, Rem2, Nl}} -> [FileName|_More] = IncFile, War2 = {FileName, L, "warning: #warning "++detokenise(WarningText)}, - Out2 = [lists:duplicate(Nl,$\n)|Out], - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, check_all, Err, [War2|War], L+Nl, FN); + Out2 = lists:duplicate(Nl,$\n) ++ Out, + expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, update_mio(Mio), check_all, Err, [War2|War], L+Nl, FN); {error, {ErrorText, Rem2, Nl}} -> [FileName|_More] = IncFile, Err2 = {FileName, L, detokenise(ErrorText)}, - Out2 = [lists:duplicate(Nl,$\n)|Out], - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, check_all, [Err2|Err], War, L+Nl, FN); + Out2 = lists:duplicate(Nl,$\n) ++ Out, + expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, update_mio(Mio), check_all, [Err2|Err], War, L+Nl, FN); {{line, ok}, {_Removed, Rem2, Nl}, L2, FN2, LineText} -> Out2 = lists:duplicate(Nl,$\n)++LineText++Out, [_X|IF] = IncFile, IncFile2 = [FN2|IF], - expand(Rem2, Out2, SelfRef, Defs, IncFile2, IncDir, check_all, Err, War, L2, FN2); + expand(Rem2, Out2, SelfRef, Defs, IncFile2, IncDir, update_mio(Mio), check_all, Err, War, L2, FN2); {{line, error}, {_Removed, Rem2, Nl}, Err2} -> - Out2 = [lists:duplicate(Nl,$\n)|Out], - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, check_all, [Err2|Err], War, L+Nl, FN); + Out2 = lists:duplicate(Nl,$\n) ++ Out, + expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, update_mio(Mio), check_all, [Err2|Err], War, L+Nl, FN); hash_mark -> - expand(Rem, Out, SelfRef, Defs, IncFile, IncDir, check_all, Err, War, L, FN); + expand(Rem, Out, SelfRef, Defs, IncFile, IncDir, Mio, check_all, Err, War, L, FN); {pragma, Rem2, Nl, Text} -> Out2 = lists:duplicate(Nl,$\n)++Text++Out, - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, check_all, Err, War, L+Nl, FN); + expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, update_mio(Mio), check_all, Err, War, L+Nl, FN); {ident, Rem2, Nl, Text} -> Out2 = lists:duplicate(Nl,$\n)++Text++Out, - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, check_all, Err, War, L+Nl, FN); + expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, update_mio(Mio), check_all, Err, War, L+Nl, FN); {not_recognised, {Removed, Rem2, Nl}} -> Text = lists:reverse([$#|Command]), RemovedS = lists:reverse([?space|detokenise(Removed)]), Out2 = [$\n|RemovedS]++Text++Out, + Mio2 = update_mio(Mio), case Command of [X|_T] when ?is_upper(X) -> - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, check_all, Err, War, L+Nl, FN); + expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, Mio2, check_all, Err, War, L+Nl, FN); [X|_T] when ?is_lower(X) -> - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, check_all, Err, War, L+Nl, FN); + expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, Mio2, check_all, Err, War, L+Nl, FN); [X|_T] when ?is_underline(X) -> - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, check_all, Err, War, L+Nl, FN); + expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, Mio2, check_all, Err, War, L+Nl, FN); _ -> Err2 = {FN, L, "invalid preprocessing directive name"}, - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, check_all, [Err2|Err], War, L+Nl, FN) + expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, Mio2, check_all, [Err2|Err], War, L+Nl, FN) end; Else -> @@ -859,19 +861,19 @@ expand([{command,Command} | Rem], Out, SelfRef, Defs, IncFile, IncDir, check_all end; -expand([{var, "__LINE__"}|Rem], Out, SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L, FN) -> +expand([{var, "__LINE__"}|Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) -> LL = io_lib:format("~p",[L]), - expand(Rem, [LL | Out], SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L, FN); + expand(Rem, [LL | Out], SelfRef, Defs, IncFile, IncDir, update_mio(Mio), IfCou, Err, War, L, FN); -expand([{var, "__FILE__"}|Rem], Out, SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L, FN) -> - expand(Rem, [$",FN,$" | Out], SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L, FN); +expand([{var, "__FILE__"}|Rem], Out, SelfRef, Defs, IncFile, Mio, IncDir, IfCou, Err, War, L, FN) -> + expand(Rem, [$",FN,$" | Out], SelfRef, Defs, IncFile, IncDir, update_mio(Mio), IfCou, Err, War, L, FN); -expand([{var, "__DATE__"}|Rem], Out, SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L, FN) -> +expand([{var, "__DATE__"}|Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) -> {{Y,M,D},{_H,_Mi,_S}} = calendar:universal_time(), Date = io_lib:format("\"~s ~p ~p\"",[month(M),D,Y]), - expand(Rem, [Date | Out], SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L, FN); + expand(Rem, [Date | Out], SelfRef, Defs, IncFile, IncDir, update_mio(Mio), IfCou, Err, War, L, FN); -expand([{var, "__TIME__"}|Rem], Out, SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L, FN) -> +expand([{var, "__TIME__"}|Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) -> {{_Y,_M,_D},{H,Mi,S}} = calendar:universal_time(), HS = if H < 10 -> "0"++integer_to_list(H); true -> integer_to_list(H) @@ -883,40 +885,40 @@ expand([{var, "__TIME__"}|Rem], Out, SelfRef, Defs, IncFile, IncDir, IfCou, Err, true -> integer_to_list(S) end, Time = io_lib:format("\"~s:~s:~s\"",[HS,MiS,SS]), - expand(Rem, [Time | Out], SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L, FN); + expand(Rem, [Time | Out], SelfRef, Defs, IncFile, IncDir, update_mio(Mio), IfCou, Err, War, L, FN); -expand([{var, "__INCLUDE_LEVEL__"}|Rem], Out, SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L, FN) -> +expand([{var, "__INCLUDE_LEVEL__"}|Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) -> IL = io_lib:format("~p",[length(IncFile)-1]), - expand(Rem, [IL | Out], SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L, FN); + expand(Rem, [IL | Out], SelfRef, Defs, IncFile, IncDir, update_mio(Mio), IfCou, Err, War, L, FN); -expand([{var, "__BASE_FILE__"}|Rem], Out, SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L, FN) -> +expand([{var, "__BASE_FILE__"}|Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) -> [BF|_T] = lists:reverse(IncFile), - expand(Rem, [$",BF,$" | Out], SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L, FN); + expand(Rem, [$",BF,$" | Out], SelfRef, Defs, IncFile, IncDir, update_mio(Mio), IfCou, Err, War, L, FN); -expand([{var, Var} | Rem], Out, SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L, FN) -> +expand([{var, Var} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) -> {Out2, Err2, War2, Rem2, SelfRef2} = source_line(Var, Rem, SelfRef, Defs, Err, War, L, FN), - expand(Rem2, [Out2 | Out], SelfRef2, Defs, IncFile, IncDir, IfCou, Err2, War2, L, FN); + expand(Rem2, [Out2 | Out], SelfRef2, Defs, IncFile, IncDir, update_mio(Mio), IfCou, Err2, War2, L, FN); -expand([{char, Char} | Rem], Out, SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L, FN) -> - expand(Rem, [Char | Out], SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L, FN); +expand([{char, Char} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) -> + expand(Rem, [Char | Out], SelfRef, Defs, IncFile, IncDir, update_mio(Mio), IfCou, Err, War, L, FN); -expand([{number, Number} | Rem], Out, SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L, FN) -> - expand(Rem, [Number | Out], SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L, FN); +expand([{number, Number} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) -> + expand(Rem, [Number | Out], SelfRef, Defs, IncFile, IncDir, update_mio(Mio), IfCou, Err, War, L, FN); -expand([{expanded, Str} | Rem], Out, SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L, FN) -> - expand(Rem, [Str | Out], SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L, FN); +expand([{expanded, Str} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) -> + expand(Rem, [Str | Out], SelfRef, Defs, IncFile, IncDir, update_mio(Mio), IfCou, Err, War, L, FN); -expand([{self_ref, Str} | Rem], Out, SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L, FN) -> +expand([{self_ref, Str} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) -> SelfRef2 = lists:delete(Str,SelfRef), - expand(Rem, Out, SelfRef2, Defs, IncFile, IncDir, IfCou, Err, War, L, FN); + expand(Rem, Out, SelfRef2, Defs, IncFile, IncDir, update_mio(Mio), IfCou, Err, War, L, FN); -expand([{string, Str} | Rem], Out, SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L, FN) -> - expand(Rem, [$", Str, $" | Out], SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L, FN); +expand([{string, Str} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) -> + expand(Rem, [$", Str, $" | Out], SelfRef, Defs, IncFile, IncDir, update_mio(Mio), IfCou, Err, War, L, FN); -expand([{string_part, Str} | Rem], Out, SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L, FN) -> +expand([{string_part, Str} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) -> {Str2, Rem2, Nl} = expand_string_part([$"|Str], Rem), - expand(Rem2, [Str2| Out], SelfRef, Defs, IncFile, IncDir, IfCou, Err, War, L+Nl, FN). + expand(Rem2, [Str2| Out], SelfRef, Defs, IncFile, IncDir, update_mio(Mio), IfCou, Err, War, L+Nl, FN). @@ -954,13 +956,14 @@ expand_string_part([{string_part, Str_part} | Rem], Str, Nl) -> get_cmd_line_defs(Flags) -> Adjusted = parse_cmd_line(Flags,[]), - {_Out, _Err, _War, Defs, _IfCou} = + {_Out, _Err, _War, Defs, _IfCou, _Mio} = expand(tokenise(Adjusted,""), [], [], [], [], [], + #mio{}, check_all, [], [], @@ -1030,10 +1033,10 @@ collect_undefine([C|Rest],Found) -> %%====================================================================================== %%====================================================================================== -pp_command(Command, [space|File], Defs, IncDir, Err, War, L, FN) -> - pp_command(Command, File, Defs, IncDir, Err, War, L, FN); +pp_command(Command, [space|File], Defs, IncDir, Mio, Err, War, L, FN) -> + pp_command(Command, File, Defs, IncDir, Mio, Err, War, L, FN); -pp_command(Command, File, Defs, IncDir, Err, War, L, FN) -> +pp_command(Command, File, Defs, IncDir, Mio, Err, War, L, FN) -> case Command of %%---------------------------------------- @@ -1081,14 +1084,16 @@ pp_command(Command, File, Defs, IncDir, Err, War, L, FN) -> %% #include %%---------------------------------------- "include" -> - case include(File, IncDir) of - {error, Rem, Nl, Err2} -> - {{include, error}, Rem, Nl, [{FN, L, Err2}|Err], War}; - {error, Rem, Nl, Err2, NameNl} -> - {{include, error}, Rem, Nl, [{FN, L+ NameNl, Err2}|Err], War}; - {ok, FileName, FileCont, Rem, Nl} -> - {{include, ok}, FileName, FileCont, Rem, Nl, Err, War} - end; + case include(File, IncDir, Mio) of + {error, Rem, Nl, Err2} -> + {{include, error}, Rem, Nl, [{FN, L, Err2}|Err], War}; + {error, Rem, Nl, Err2, NameNl} -> + {{include, error}, Rem, Nl, [{FN, L+ NameNl, Err2}|Err], War}; + {ok, FileNamePath, FileCont, Rem, Nl} -> + {{include, ok}, FileNamePath, FileCont, Rem, Nl, Err, War}; + {skip, Rem} -> + {{include, skip}, Rem} + end; %%---------------------------------------- %% #ifdef @@ -1127,14 +1132,14 @@ pp_command(Command, File, Defs, IncDir, Err, War, L, FN) -> yes -> {{ifndef, true}, Rem, Err2, War2, Nl}; no -> - {{ifndef, false}, Rem, Err2, War2, Nl} + {{ifndef, false}, Name, Rem, Err2, War2, Nl} end; {ok, Rem, Name, No_of_para, _Parameters, _Macro, Err2, War2, Nl} -> case is_defined_before(Name, No_of_para, Defs) of yes -> {{ifndef, true}, Rem, Err2, War2, Nl}; no -> - {{ifndef, false}, Rem, Err2, War2, Nl} + {{ifndef, false}, Name, Rem, Err2, War2, Nl} end end; @@ -1408,29 +1413,32 @@ undef(_Rem) -> %%=============================================================== %%=============================================================== -include(File, IncDir) -> +include(File, IncDir, Mio) -> case include2(File) of - {ok, FileName, Rem, Nl, FileType} -> - %% The error handling is lite strange just to make it compatible to gcc - case {read_inc_file(FileName, IncDir), Nl, FileType} of - {{ok, FileList, FileNamePath}, _, _} -> - {ok, FileNamePath, FileList, Rem, Nl}; - {{error, Text}, _, own_file} -> - NameNl = count_nl(FileName,0), - Error = lists:flatten(io_lib:format("~s: ~s",[FileName,Text])), - {error, Rem, Nl, Error, NameNl}; - {{error, Text}, 1, sys_file} -> - NameNl = count_nl(FileName,0), - Error = lists:flatten(io_lib:format("~s: ~s",[FileName,Text])), - {error, Rem, Nl, Error, NameNl}; - {{error, _Text}, _, sys_file} -> - {error, Rem, Nl, "`#include' expects \"FILENAME\" or <FILENAME>"} - end; - - {error, {_Removed, Rem, Nl}} -> - {error, Rem, Nl, "`#include' expects \"FILENAME\" or <FILENAME>"} + {ok, FileName, Rem, Nl, FileType} -> + Result = read_inc_file(FileName, IncDir, Mio), + case {Result, Nl, FileType} of + {{ok, FileNamePath, FileCont}, _, _} -> + {ok, FileNamePath, FileCont, Rem, Nl}; + {skip, _, _} -> + {skip, Rem}; + {{error, Text}, _, own_file} -> + NameNl = count_nl(FileName,0), + Error = lists:flatten(io_lib:format("~s: ~s",[FileName,Text])), + {error, Rem, Nl, Error, NameNl}; + {{error, Text}, 1, sys_file} -> + NameNl = count_nl(FileName,0), + Error = lists:flatten(io_lib:format("~s: ~s",[FileName,Text])), + {error, Rem, Nl, Error, NameNl}; + {{error, _Text}, _, sys_file} -> + {error, Rem, Nl, "`#include' expects \"FILENAME\" or <FILENAME>"} + end; + {error, {_Removed, Rem, Nl}} -> + {error, Rem, Nl, "`#include' expects \#FILENAME\" or <FILENAME>"} end. + + count_nl([],Nl) -> Nl; count_nl([$\n|T],Nl) -> @@ -1909,18 +1917,37 @@ include_dir(Flags,IncDir) -> %% Read a included file. Try current dir first then the IncDir list %%=============================================================== -read_inc_file(FileName, IncDir) -> - case catch file:read_file(FileName) of - {ok, Bin} -> - FileList = binary_to_list(Bin), - {ok, FileList, FileName}; +read_inc_file(FileName, IncDir, Mio) -> + case find_inc_file(FileName, IncDir) of + {ok, AbsFile} -> + %% is included before? + case lists:member(FileName, Mio#mio.included) of + false -> + case catch file:read_file(AbsFile) of + {ok, Bin} -> + FileList = binary_to_list(Bin), + {ok, AbsFile, FileList}; + {error, Text} -> + {error, Text} + end; + true -> + skip + end; + {error, Text} -> + {error, Text} + end. + +find_inc_file(FileName, IncDir) -> + case catch file:read_file_info(FileName) of + {ok, _} -> + {ok, FileName}; {error, _} -> - read_inc_file2(FileName, IncDir) + find_inc_file2(FileName, IncDir) end. -read_inc_file2(_FileName, []) -> +find_inc_file2(_FileName, []) -> {error, "No such file or directory"}; -read_inc_file2(FileName, [D|Rem]) -> +find_inc_file2(FileName, [D|Rem]) -> Dir = case lists:last(D) of $/ -> D; @@ -1928,17 +1955,14 @@ read_inc_file2(FileName, [D|Rem]) -> D++"/" end, - case catch file:read_file(Dir++FileName) of - {ok, Bin} -> - FileList = binary_to_list(Bin), - {ok, FileList, Dir++FileName}; + case catch file:read_file_info(Dir++FileName) of + {ok, _} -> + {ok, Dir++FileName}; {error, _} -> - read_inc_file2(FileName, Rem) + find_inc_file2(FileName, Rem) end. - - %%=============================================================== %% Read parameters of a macro or a variable in a source line %%=============================================================== @@ -2135,5 +2159,73 @@ month(11) -> "Nov"; month(12) -> "Dec". +%% Multiple Include Optimization +%% +%% Algorithm described at: +%% http://gcc.gnu.org/onlinedocs/cppinternals/Guard-Macros.html +update_mio({include, FileName}, #mio{included=Inc}=Mio) -> + Mio#mio{valid=false, included=[FileName|Inc]}; + +%% valid=false & cmacro=undefined indicates it is already decided this file is +%% not subject to MIO +update_mio(_, #mio{valid=false, depth=0, cmacro=undefined}=Mio) -> + Mio; + +%% if valid=true, there is no non-whitespace tokens before this ifndef +update_mio({'ifndef', Macro}, #mio{valid=true, depth=0, cmacro=undefined}=Mio) -> + Mio#mio{valid=false, cmacro=Macro, depth=1}; + +%% detect any tokens before top level #ifndef +update_mio(_, #mio{valid=true, depth=0, cmacro=undefined}=Mio) -> + Mio#mio{valid=false}; + +%% If cmacro is alreay set, this is after the top level #endif +update_mio({'ifndef', _}, #mio{valid=true, depth=0}=Mio) -> + Mio#mio{valid=false, cmacro=undefined}; + +%% non-top level conditional, just update depth +update_mio({'ifndef', _}, #mio{depth=D}=Mio) when D > 0 -> + Mio#mio{depth=D+1}; +update_mio('ifdef', #mio{depth=D}=Mio) -> + Mio#mio{depth=D+1}; +update_mio('if', #mio{depth=D}=Mio) -> + Mio#mio{depth=D+1}; + +%% top level #else #elif invalidates multiple include optimization +update_mio('else', #mio{depth=1}=Mio) -> + Mio#mio{valid=false, cmacro=undefined}; +update_mio('else', Mio) -> + Mio; +update_mio('elif', #mio{depth=1}=Mio) -> + Mio#mio{valid=false, cmacro=undefined}; +update_mio('elif', Mio) -> + Mio; + +%% AT exit to top level, if the controlling macro is not set, this could be the +%% end of a non-ifndef conditional block, or there were tokens before entering +%% the #ifndef block. In either way, this invalidates the MIO +%% +%% It doesn't matter if `valid` is true at the time of exiting, it is set to +%% true. This will be used to detect if more tokens are following the top +%% level #endif. +update_mio('endif', #mio{depth=1, cmacro=undefined}=Mio) -> + Mio#mio{valid=false, depth=0}; +update_mio('endif', #mio{depth=1}=Mio) -> + Mio#mio{valid=true, depth=0}; +update_mio('endif', #mio{depth=D}=Mio) when D > 1 -> + Mio#mio{valid=true, depth=D-1}; + +%%if more tokens are following the top level #endif. +update_mio('endif', #mio{depth=1, cmacro=undefined}=Mio) -> + Mio#mio{valid=false, depth=0}; +update_mio('endif', #mio{depth=D}=Mio) when D > 0 -> + Mio#mio{valid=true, depth=D-1}; +update_mio(_, Mio) -> + Mio#mio{valid=false}. + +%% clear `valid`, this doesn't matter since #endif will restore it if +%% appropriate +update_mio(Mio) -> + Mio#mio{valid=false}. diff --git a/lib/ic/src/ic_pragma.erl b/lib/ic/src/ic_pragma.erl index 45cb64c9c8..7f2216b9dc 100644 --- a/lib/ic/src/ic_pragma.erl +++ b/lib/ic/src/ic_pragma.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2010. All Rights Reserved. +%% Copyright Ericsson AB 1998-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -1600,9 +1600,8 @@ remove_inheriters(S,RS,InheriterList) -> [_OneOnly] -> ReducedInhList; _Other -> - EtsList = ets:tab2list(S), CleanList = - [X || X <- EtsList, element(1,X) == inherits], + ets:match(S, {inherits,'_','_'}), % CodeOptList = % [X || X <- EtsList, element(1,X) == codeopt], NoInheriters =remove_inheriters2(S,ReducedInhList,CleanList), @@ -1648,9 +1647,8 @@ remove_inh([X],[Y],List,EtsList) -> %%% from others in the list %%%---------------------------------------------- remove_inherited(S,InheriterList) -> - EtsList = ets:tab2list(S), CleanList = - [X || X <- EtsList, element(1,X) == inherits], + ets:match(S, {inherits, '_', '_'}), remove_inherited(S,InheriterList,CleanList). @@ -1694,11 +1692,8 @@ remove_inhed([X],[Y],List,EtsList) -> %% are inherited from scope in the list %%%---------------------------------------------- get_inherited(S,Scope,OpScopeList) -> - EtsList = ets:tab2list(S), - [[element(3,X)] || X <- EtsList, - element(1,X) == inherits, - element(2,X) == Scope, - member([element(3,X)],OpScopeList)]. + EtsList1 = ets:match(S, {inherits, Scope, '$1'}), + [X || X <- EtsList1, member(X, OpScopeList)]. @@ -1771,9 +1766,7 @@ inherits2(_X,Y,Z,EtsList) -> %% false otherwise %% is_inherited_by(Interface1,Interface2,PragmaTab) -> - FullList = ets:tab2list(PragmaTab), - InheritsList = - [X || X <- FullList, element(1,X) == inherits], + InheritsList = ets:match(PragmaTab, {inherits, '_', '_'}), inherits(Interface2,Interface1,InheritsList). diff --git a/lib/ic/vsn.mk b/lib/ic/vsn.mk index 6d6c7fa625..6561ccd2a7 100644 --- a/lib/ic/vsn.mk +++ b/lib/ic/vsn.mk @@ -1 +1 @@ -IC_VSN = 4.2.26 +IC_VSN = 4.2.27 diff --git a/lib/inets/Makefile b/lib/inets/Makefile index ec05efa461..f4c2746b0a 100644 --- a/lib/inets/Makefile +++ b/lib/inets/Makefile @@ -36,6 +36,8 @@ SPECIAL_TARGETS = # ---------------------------------------------------- include $(ERL_TOP)/make/otp_subdir.mk +.PHONY: info gclean + info: @echo "OS: $(OS)" @echo "DOCB: $(DOCB)" @@ -44,3 +46,5 @@ info: @echo "APP_VSN: $(APP_VSN)" @echo "" +gclean: + git clean -fXd diff --git a/lib/inets/doc/src/httpc.xml b/lib/inets/doc/src/httpc.xml index f6b6827e93..d1671ac9bd 100644 --- a/lib/inets/doc/src/httpc.xml +++ b/lib/inets/doc/src/httpc.xml @@ -144,7 +144,7 @@ filename() = string() <v>Result = {status_line(), headers(), Body} | {status_code(), Body} | request_id() </v> <v>Body = string() | binary()</v> - <v>Profile = profile()</v> + <v>Profile = profile() | pid() (when started <c>stand_alone</c>)</v> <v>Reason = term() </v> </type> <desc> @@ -194,16 +194,16 @@ filename() = string() <v>Result = {status_line(), headers(), Body} | {status_code(), Body} | request_id() </v> <v>Body = string() | binary()</v> - <v>Profile = profile() </v> + <v>Profile = profile() | pid() (when started <c>stand_alone</c>)</v> <v>Reason = {connect_failed, term()} | {send_failed, term()} | term() </v> </type> <desc> <p>Sends a HTTP-request. The function can be both synchronous - and asynchronous. In the later case the function will return - <c>{ok, RequestId}</c> and later on the information will be delivered - to the <c>receiver</c> depending on that value. </p> + and asynchronous. In the later case the function will return + <c>{ok, RequestId}</c> and later on the information will be delivered + to the <c>receiver</c> depending on that value. </p> <p>Http option (<c>http_option()</c>) details: </p> <taglist> @@ -211,7 +211,7 @@ filename() = string() <item> <p>Timeout time for the request. </p> <p>The clock starts ticking as soon as the request has been - sent. </p> + sent. </p> <p>Time is in milliseconds. </p> <p>Defaults to <c>infinity</c>. </p> </item> @@ -219,7 +219,7 @@ filename() = string() <tag><c><![CDATA[connect_timeout]]></c></tag> <item> <p>Connection timeout time, used during the initial request, - when the client is <em>connecting</em> to the server. </p> + when the client is <em>connecting</em> to the server. </p> <p>Time is in milliseconds. </p> <p>Defaults to the value of the <c>timeout</c> option. </p> </item> @@ -227,60 +227,61 @@ filename() = string() <tag><c><![CDATA[ssl]]></c></tag> <item> <p>This is the default ssl config option, currently defaults to - <c>essl</c>, see below. </p> + <c>essl</c>, see below. </p> <p>Defaults to <c>[]</c>. </p> </item> <tag><c><![CDATA[ossl]]></c></tag> <item> <p>If using the OpenSSL based (old) implementation of SSL, - these SSL-specific options are used. </p> + these SSL-specific options are used. </p> <p>Defaults to <c>[]</c>. </p> </item> <tag><c><![CDATA[essl]]></c></tag> <item> <p>If using the Erlang based (new) implementation of SSL, - these SSL-specific options are used. </p> + these SSL-specific options are used. </p> <p>Defaults to <c>[]</c>. </p> </item> <tag><c><![CDATA[autoredirect]]></c></tag> <item> - <p>Should the client automatically retrieve the information - from the new URI and return that as the result instead - of a 30X-result code. </p> - <p>Note that for some 30X-result codes automatic redirect - is not allowed. In these cases the 30X-result will always - be returned. </p> - <p>Defaults to <c>true</c>. </p> + <p>Should the client automatically retrieve the information + from the new URI and return that as the result instead + of a 30X-result code. </p> + <p>Note that for some 30X-result codes automatic redirect + is not allowed. In these cases the 30X-result will always + be returned. </p> + <p>Defaults to <c>true</c>. </p> </item> <tag><c><![CDATA[proxy_auth]]></c></tag> <item> <p>A proxy-authorization header using the provided user name and - password will be added to the request. </p> + password will be added to the request. </p> </item> <tag><c><![CDATA[version]]></c></tag> <item> <p>Can be used to make the client act as an <c>HTTP/1.0</c> or - <c>HTTP/0.9</c> client. By default this is an <c>HTTP/1.1</c> - client. When using <c>HTTP/1.0</c> persistent connections will - not be used. </p> - <p>Defaults to the string <c>"HTTP/1.1"</c>. </p> + <c>HTTP/0.9</c> client. By default this is an <c>HTTP/1.1</c> + client. When using <c>HTTP/1.0</c> persistent connections will + not be used. </p> + <p>Defaults to the string <c>"HTTP/1.1"</c>. </p> </item> <tag><c><![CDATA[relaxed]]></c></tag> <item> - <p>If set to <c>true</c> workarounds for known server deviations from - the HTTP-standard are enabled. </p> + <p>If set to <c>true</c> workarounds for known server deviations + from the HTTP-standard are enabled. </p> <p>Defaults to <c>false</c>. </p> </item> <tag><c><![CDATA[url_encode]]></c></tag> <item> - <p>Will apply Percent-encoding, also known as URL encoding on the URL.</p> + <p>Will apply Percent-encoding, also known as URL encoding on the + URL.</p> <p>Defaults to <c>false</c>. </p> </item> </taglist> @@ -296,77 +297,77 @@ filename() = string() <tag><c><![CDATA[stream]]></c></tag> <item> <p>Streams the body of a 200 or 206 response to the calling - process or to a file. When streaming to the calling process - using the option <c>self</c> the following stream messages - will be sent to that process: <c>{http, {RequestId, - stream_start, Headers}, {http, {RequestId, stream, - BinBodyPart}, {http, {RequestId, stream_end, Headers}</c>. When - streaming to to the calling processes using the option - <c>{self, once}</c> the first message will have an additional - element e.i. <c>{http, {RequestId, stream_start, Headers, Pid}</c>, - this is the process id that should be used as an argument to - <c>http:stream_next/1</c> to trigger the next message to be sent to - the calling process. </p> + process or to a file. When streaming to the calling process + using the option <c>self</c> the following stream messages + will be sent to that process: <c>{http, {RequestId, + stream_start, Headers}, {http, {RequestId, stream, + BinBodyPart}, {http, {RequestId, stream_end, Headers}</c>. When + streaming to to the calling processes using the option + <c>{self, once}</c> the first message will have an additional + element e.i. <c>{http, {RequestId, stream_start, Headers, Pid}</c>, + this is the process id that should be used as an argument to + <c>http:stream_next/1</c> to trigger the next message to be sent to + the calling process. </p> <p>Note that it is possible that chunked encoding will add - headers so that there are more headers in the <c>stream_end</c> - message than in the <c>stream_start</c>. - When streaming to a file and the request is asynchronous the - message <c>{http, {RequestId, saved_to_file}}</c> will be sent. </p> + headers so that there are more headers in the <c>stream_end</c> + message than in the <c>stream_start</c>. + When streaming to a file and the request is asynchronous the + message <c>{http, {RequestId, saved_to_file}}</c> will be sent. </p> <p>Defaults to <c>none</c>. </p> </item> <tag><c><![CDATA[body_format]]></c></tag> <item> <p>Defines if the body shall be delivered as a string or as a - binary. This option is only valid for the synchronous - request. </p> + binary. This option is only valid for the synchronous + request. </p> <p>Defaults to <c>string</c>. </p> </item> <tag><c><![CDATA[full_result]]></c></tag> <item> <p>Should a "full result" be returned to the caller (that is, - the body, the headers and the entire status-line) or not - (the body and the status code). </p> + the body, the headers and the entire status-line) or not + (the body and the status code). </p> <p>Defaults to <c>true</c>. </p> </item> <tag><c><![CDATA[header_as_is]]></c></tag> <item> <p>Shall the headers provided by the user be made - lower case or be regarded as case sensitive. </p> + lower case or be regarded as case sensitive. </p> <p>Note that the http standard requires them to be - case insenstive. This feature should only be used if there is - no other way to communicate with the server or for testing - purpose. Also note that when this option is used no headers - will be automatically added, all necessary headers have to be - provided by the user. </p> - <p>Defaults to <c>false</c>. </p> + case insenstive. This feature should only be used if there is + no other way to communicate with the server or for testing + purpose. Also note that when this option is used no headers + will be automatically added, all necessary headers have to be + provided by the user. </p> + <p>Defaults to <c>false</c>. </p> </item> <tag><c><![CDATA[socket_opts]]></c></tag> <item> <p>Socket options to be used for this and subsequent - request(s). </p> - <p>Overrides any value set by the - <seealso marker="#set_options">set_options</seealso> - function. </p> + request(s). </p> + <p>Overrides any value set by the + <seealso marker="#set_options">set_options</seealso> + function. </p> <p>Note that the validity of the options are <em>not</em> - checked in any way. </p> + checked in any way. </p> <p>Note that this may change the socket behaviour - (see <seealso marker="kernel:inet#setopts/2">inet:setopts/2</seealso>) - for an already existing one, and therefore an already connected - request handler. </p> + (see <seealso marker="kernel:inet#setopts/2">inet:setopts/2</seealso>) + for an already existing one, and therefore an already connected + request handler. </p> <p>By default the socket options set by the - <seealso marker="#set_options">set_options/1,2</seealso> - function are used when establishing a connection. </p> + <seealso marker="#set_options">set_options/1,2</seealso> + function are used when establishing a connection. </p> </item> <tag><c><![CDATA[receiver]]></c></tag> <item> <p>Defines how the client will deliver the result of an - asynchroneous request (<c>sync</c> has the value - <c>false</c>). </p> + asynchroneous request (<c>sync</c> has the value + <c>false</c>). </p> <taglist> <tag><c><![CDATA[pid()]]></c></tag> @@ -380,7 +381,7 @@ filename() = string() <tag><c><![CDATA[function/1]]></c></tag> <item> <p>Information will be delivered to the receiver via calls - to the provided fun: </p> + to the provided fun: </p> <pre> Receiver(ReplyInfo) </pre> @@ -389,7 +390,7 @@ Receiver(ReplyInfo) <tag><c><![CDATA[{Module, Funcion, Args}]]></c></tag> <item> <p>Information will be delivered to the receiver via calls - to the callback function: </p> + to the callback function: </p> <pre> apply(Module, Function, [ReplyInfo | Args]) </pre> @@ -410,7 +411,7 @@ apply(Module, Function, [ReplyInfo | Args]) </pre> <p>Defaults to the <c>pid()</c> of the process calling the request - function (<c>self()</c>). </p> + function (<c>self()</c>). </p> </item> </taglist> @@ -425,7 +426,7 @@ apply(Module, Function, [ReplyInfo | Args]) <type> <v>RequestId = request_id() - A unique identifier as returned by request/4</v> - <v>Profile = profile()</v> + <v>Profile = profile() | pid() (when started <c>stand_alone</c>)</v> </type> <desc> <p>Cancels an asynchronous HTTP-request. </p> @@ -514,11 +515,10 @@ apply(Module, Function, [ReplyInfo | Args]) This option is used to switch on (or off) different levels of erlang trace on the client. It is a debug feature.</d> - <v>Profile = profile()</v> + <v>Profile = profile() | pid() (when started <c>stand_alone</c>)</v> </type> <desc> - <p>Sets options to be used for subsequent - requests.</p> + <p>Sets options to be used for subsequent requests.</p> <note> <p>If possible the client will keep its connections alive and use persistent connections @@ -548,7 +548,7 @@ apply(Module, Function, [ReplyInfo | Args]) </type> <desc> <p>Triggers the next message to be streamed, e.i. - same behavior as active once for sockets.</p> + same behavior as active once for sockets. </p> <marker id="verify_cookies"></marker> <marker id="store_cookies"></marker> @@ -562,14 +562,14 @@ apply(Module, Function, [ReplyInfo | Args]) <type> <v>SetCookieHeaders = headers() - where field = "set-cookie"</v> <v>Url = url()</v> - <v>Profile = profile()</v> + <v>Profile = profile() | pid() (when started <c>stand_alone</c>)</v> </type> <desc> <p>Saves the cookies defined in SetCookieHeaders - in the client profile's cookie database. You need to - call this function if you have set the option <c>cookies</c> to <c>verify</c>. - If no profile is specified the default profile will be used. - </p> + in the client profile's cookie database. You need to + call this function if you have set the option <c>cookies</c> + to <c>verify</c>. + If no profile is specified the default profile will be used. </p> <marker id="cookie_header"></marker> </desc> @@ -582,13 +582,12 @@ apply(Module, Function, [ReplyInfo | Args]) making a request to Url using the profile <c>Profile</c>.</fsummary> <type> <v>Url = url()</v> - <v>Profile = profile()</v> + <v>Profile = profile() | pid() (when started <c>stand_alone</c>)</v> </type> <desc> <p>Returns the cookie header that would be sent - when making a request to <c>Url</c> using the profile <c>Profile</c>. - If no profile is specified the default profile will be used. - </p> + when making a request to <c>Url</c> using the profile <c>Profile</c>. + If no profile is specified the default profile will be used. </p> <marker id="reset_cookies"></marker> </desc> @@ -600,12 +599,12 @@ apply(Module, Function, [ReplyInfo | Args]) <name>reset_cookies(Profile) -> void()</name> <fsummary>Reset the cookie database.</fsummary> <type> - <v>Profile = profile()</v> + <v>Profile = profile() | pid() (when started <c>stand_alone</c>)</v> </type> <desc> - <p>Resets (clears) the cookie database for the specified <c>Profile</c>. - If no profile is specified the default profile will be used. - </p> + <p>Resets (clears) the cookie database for the specified + <c>Profile</c>. If no profile is specified the default profile + will be used. </p> </desc> </func> @@ -615,17 +614,16 @@ apply(Module, Function, [ReplyInfo | Args]) <name>which_cookies(Profile) -> cookies()</name> <fsummary>Dumps out the entire cookie database.</fsummary> <type> - <v>Profile = profile()</v> - <v>cookies() = [cooie_stores()]</v> - <v>cookie_stores() = {cookies, icookies()} | {session_cookies, icookies()}</v> - <v>icookies() = [icookie()]</v> + <v>Profile = profile() | pid() (when started <c>stand_alone</c>)</v> + <v>cookies() = [cookie_stores()]</v> + <v>cookie_stores() = {cookies, cookies()} | {session_cookies, cookies()}</v> + <v>cookies() = [cookie()]</v> <v>cookie() = term()</v> </type> <desc> <p>This function produces a list of the entire cookie database. - It is intended for debugging/testing purposes. - If no profile is specified the default profile will be used. - </p> + It is intended for debugging/testing purposes. + If no profile is specified the default profile will be used. </p> </desc> </func> </funcs> diff --git a/lib/inets/doc/src/notes.xml b/lib/inets/doc/src/notes.xml index 0926df8581..34f26bf45b 100644 --- a/lib/inets/doc/src/notes.xml +++ b/lib/inets/doc/src/notes.xml @@ -32,6 +32,63 @@ <file>notes.xml</file> </header> + <section><title>Inets 5.7</title> + + <section><title>Improvements and New Features</title> +<!-- + <p>-</p> +--> + + <list> + <item> + <p>[httpc|httpd] Added support for IPv6 with ssl. </p> + <p>Own Id: OTP-5566</p> + </item> + + </list> + + </section> + + <section><title>Fixed Bugs and Malfunctions</title> +<!-- + <p>-</p> +--> + + <list> + <item> + <p>[httpc] Remove unnecessary usage of iolist_to_binary when + processing body (for PUT and POST). </p> + <p>Filipe David Manana</p> + <p>Own Id: OTP-9317</p> + </item> + + <item> + <p>[ftp] FTP client doesn't work with IPv6 host.</p> + <p>Attila Rajmund Nohl</p> + <p>Own Id: OTP-9342 Aux Id: seq11853</p> + </item> + + <item> + <p>[httpd] Peer/sockname resolv doesn't work with IPv6 addrs + in HTTP. </p> + <p>Attila Rajmund Nohl.</p> + <p>Own Id: OTP-9343</p> + </item> + + <item> + <p>[httpc] Clients started stand-alone not properly handled. + Also it was not documented how to use them, that is that + once started, they are represented by a <c>pid()</c> and not by + their <c>profile()</c>. </p> + <p>Own Id: OTP-9365</p> + </item> + + </list> + </section> + + </section> <!-- 5.7 --> + + <section><title>Inets 5.6</title> <section><title>Improvements and New Features</title> diff --git a/lib/inets/src/ftp/ftp.erl b/lib/inets/src/ftp/ftp.erl index fe6cb0c191..ac72963347 100644 --- a/lib/inets/src/ftp/ftp.erl +++ b/lib/inets/src/ftp/ftp.erl @@ -1038,10 +1038,12 @@ handle_call({_, {open, ip_comm, Opts}}, From, State) -> Port = key_search(port, Opts, ?FTP_PORT), Timeout = key_search(timeout, Opts, ?CONNECTION_TIMEOUT), Progress = key_search(progress, Opts, ignore), + IpFamily = key_search(ipfamily, Opts, inet), State2 = State#state{client = From, mode = Mode, - progress = progress(Progress)}, + progress = progress(Progress), + ipfamily = IpFamily}, ?fcrd("handle_call(open) -> setup ctrl connection with", [{host, Host}, {port, Port}, {timeout, Timeout}]), diff --git a/lib/inets/src/http_client/httpc.erl b/lib/inets/src/http_client/httpc.erl index 6ffa5e8ba5..fe8e93af1f 100644 --- a/lib/inets/src/http_client/httpc.erl +++ b/lib/inets/src/http_client/httpc.erl @@ -64,17 +64,16 @@ default_profile() -> profile_name(?DEFAULT_PROFILE) -> httpc_manager; +profile_name(Profile) when is_pid(Profile) -> + Profile; profile_name(Profile) -> - profile_name("httpc_manager_", Profile). + Prefix = lists:flatten(io_lib:format("~w_", [?MODULE])), + profile_name(Prefix, Profile). profile_name(Prefix, Profile) when is_atom(Profile) -> list_to_atom(Prefix ++ atom_to_list(Profile)); -profile_name(Prefix, Profile) when is_pid(Profile) -> - ProfileStr0 = - string:strip(string:strip(erlang:pid_to_list(Profile), left, $<), right, $>), - F = fun($.) -> $_; (X) -> X end, - ProfileStr = [F(C) || C <- ProfileStr0], - list_to_atom(Prefix ++ "pid_" ++ ProfileStr). +profile_name(_Prefix, Profile) when is_pid(Profile) -> + Profile. %%-------------------------------------------------------------------------- @@ -115,9 +114,11 @@ request(Url, Profile) -> %% {keyfile, path()} | {password, string()} | {cacertfile, path()} | %% {ciphers, string()} %% Options - [Option] -%% Option - {sync, Boolean} | {body_format, BodyFormat} | -%% {full_result, Boolean} | {stream, To} | -%% {headers_as_is, Boolean} +%% Option - {sync, Boolean} | +%% {body_format, BodyFormat} | +%% {full_result, Boolean} | +%% {stream, To} | +%% {headers_as_is, Boolean} %% StatusLine = {HTTPVersion, StatusCode, ReasonPhrase}</v> %% HTTPVersion = string() %% StatusCode = integer() @@ -518,17 +519,15 @@ mk_chunkify_fun(ProcessBody) -> eof -> {ok, <<"0\r\n\r\n">>, eof_body}; {ok, Data, NewAcc} -> - {ok, mk_chunk_bin(Data), NewAcc} + Chunk = [ + integer_to_list(iolist_size(Data), 16), + "\r\n", + Data, + "\r\n"], + {ok, Chunk, NewAcc} end end. -mk_chunk_bin(Data) -> - Bin = iolist_to_binary(Data), - iolist_to_binary([hex_size(Bin), "\r\n", Bin, "\r\n"]). - -hex_size(Bin) -> - hd(io_lib:format("~.16B", [size(Bin)])). - handle_answer(RequestId, false, _) -> {ok, RequestId}; @@ -552,9 +551,7 @@ return_answer(Options, {{"HTTP/0.9",_,_}, _, BinBody}) -> {ok, Body}; return_answer(Options, {StatusLine, Headers, BinBody}) -> - Body = maybe_format_body(BinBody, Options), - case proplists:get_value(full_result, Options, true) of true -> {ok, {StatusLine, Headers, Body}}; diff --git a/lib/inets/src/http_client/httpc_handler.erl b/lib/inets/src/http_client/httpc_handler.erl index 1f0e012e7e..9ac9ee6f7b 100644 --- a/lib/inets/src/http_client/httpc_handler.erl +++ b/lib/inets/src/http_client/httpc_handler.erl @@ -515,7 +515,7 @@ handle_info({Proto, _Socket, Data}, {stop, normal, NewState} end, - ?hcri("data processed", []), + ?hcri("data processed", [{final_result, FinalResult}]), FinalResult; @@ -629,8 +629,9 @@ handle_info(timeout_queue, #state{timers = Timers} = State) -> Timers#timers{queue_timer = undefined}}}; %% Setting up the connection to the server somehow failed. -handle_info({init_error, _, ClientErrMsg}, +handle_info({init_error, Tag, ClientErrMsg}, State = #state{request = Request}) -> + ?hcrv("init error", [{tag, Tag}, {client_error, ClientErrMsg}]), NewState = answer_request(Request, ClientErrMsg, State), {stop, normal, NewState}; @@ -707,9 +708,9 @@ terminate(normal, %% And, just in case, close our side (**really** overkill) http_transport:close(SocketType, Socket); -terminate(Reason, #state{session = #session{id = Id, - socket = Socket, - socket_type = SocketType}, +terminate(Reason, #state{session = #session{id = Id, + socket = Socket, + socket_type = SocketType}, request = undefined, profile_name = ProfileName, timers = Timers, @@ -1403,7 +1404,7 @@ try_to_enable_pipeline_or_keep_alive( answer_request(#request{id = RequestId, from = From} = Request, Msg, #state{timers = Timers, profile_name = ProfileName} = State) -> - ?hcrt("answer request", [{request, Request}]), + ?hcrt("answer request", [{request, Request}, {msg, Msg}]), httpc_response:send(From, Msg), RequestTimers = Timers#timers.request_timers, TimerRef = diff --git a/lib/inets/src/http_client/httpc_manager.erl b/lib/inets/src/http_client/httpc_manager.erl index 7f66b477eb..9015bf1ce2 100644 --- a/lib/inets/src/http_client/httpc_manager.erl +++ b/lib/inets/src/http_client/httpc_manager.erl @@ -52,7 +52,7 @@ cancel = [], % [{RequestId, HandlerPid, ClientPid}] handler_db, % ets() - Entry: #handler_info{} cookie_db, % cookie_db() - session_db, % ets() - Entry: #tcp_session{} + session_db, % ets() - Entry: #session{} profile_name, % atom() options = #options{} }). @@ -178,7 +178,7 @@ request_done(RequestId, ProfileName) -> %%-------------------------------------------------------------------- %% Function: insert_session(Session, ProfileName) -> _ -%% Session - #tcp_session{} +%% Session - #session{} %% ProfileName - atom() %% %% Description: Inserts session information into the httpc manager @@ -669,7 +669,7 @@ select_session(Method, HostPort, Scheme, SessionType, (SessionType =:= keep_alive) of true -> %% Look for handlers connecting to this host (HostPort) - %% tcp_session with record name field (tcp_session) and + %% session with record name field (session) and %% socket fields ignored. The fields id (part of: HostPort), %% client_close, scheme and type specified. %% The fields id (part of: HandlerPid) and queue_length diff --git a/lib/inets/src/http_lib/http_transport.erl b/lib/inets/src/http_lib/http_transport.erl index 01b51d531a..9b8190ebed 100644 --- a/lib/inets/src/http_lib/http_transport.erl +++ b/lib/inets/src/http_lib/http_transport.erl @@ -33,8 +33,8 @@ peername/2, sockname/2, resolve/0 ]). - -export([negotiate/3]). +-export([ipv4_name/1, ipv6_name/1]). -include_lib("inets/src/inets_app/inets_internal.hrl"). -include("http_internal.hrl"). @@ -142,8 +142,8 @@ connect({ossl, SslConfig}, {Host, Port}, _, Timeout) -> ERROR end; -connect({essl, SslConfig}, {Host, Port}, _, Timeout) -> - Opts = [binary, {active, false}, {ssl_imp, new}] ++ SslConfig, +connect({essl, SslConfig}, {Host, Port}, Opts0, Timeout) -> + Opts = [binary, {active, false}, {ssl_imp, new} | Opts0] ++ SslConfig, ?hlrt("connect using essl", [{host, Host}, {port, Port}, @@ -176,8 +176,8 @@ connect({essl, SslConfig}, {Host, Port}, _, Timeout) -> listen(SocketType, Port) -> listen(SocketType, undefined, Port). -listen(ip_comm = SocketType, Addr, Port) -> - listen(SocketType, Addr, Port, undefined); +listen(ip_comm = _SocketType, Addr, Port) -> + listen_ip_comm(Addr, Port, undefined); %% Wrapper for backaward compatibillity listen({ssl, SSLConfig}, Addr, Port) -> @@ -187,35 +187,33 @@ listen({ssl, SSLConfig}, Addr, Port) -> {ssl_config, SSLConfig}]), listen({?HTTP_DEFAULT_SSL_KIND, SSLConfig}, Addr, Port); -listen({ossl, SSLConfig} = Ssl, Addr, Port) -> +listen({ossl, SSLConfig}, Addr, Port) -> ?hlrt("listen (ossl)", [{addr, Addr}, {port, Port}, {ssl_config, SSLConfig}]), - Opt = sock_opt(Ssl, Addr, SSLConfig), - ?hlrt("listen options", [{opt, Opt}]), - ssl:listen(Port, [{ssl_imp, old} | Opt]); + listen_ssl(Addr, Port, [{ssl_imp, old} | SSLConfig]); -listen({essl, SSLConfig} = Ssl, Addr, Port) -> +listen({essl, SSLConfig}, Addr, Port) -> ?hlrt("listen (essl)", [{addr, Addr}, {port, Port}, {ssl_config, SSLConfig}]), - Opt = sock_opt(Ssl, Addr, SSLConfig), - ?hlrt("listen options", [{opt, Opt}]), - Opt2 = [{ssl_imp, new}, {reuseaddr, true} | Opt], - ssl:listen(Port, Opt2). + listen_ssl(Addr, Port, [{ssl_imp, new}, {reuseaddr, true} | SSLConfig]). + listen(ip_comm, Addr, Port, Fd) -> - case (catch listen_ip_comm(Addr, Port, Fd)) of + listen_ip_comm(Addr, Port, Fd). + +listen_ip_comm(Addr, Port, Fd) -> + case (catch do_listen_ip_comm(Addr, Port, Fd)) of {'EXIT', Reason} -> {error, {exit, Reason}}; Else -> Else end. - -listen_ip_comm(Addr, Port, Fd) -> +do_listen_ip_comm(Addr, Port, Fd) -> {NewPort, Opts, IpFamily} = get_socket_info(Addr, Port, Fd), case IpFamily of inet6fb4 -> @@ -248,6 +246,41 @@ listen_ip_comm(Addr, Port, Fd) -> gen_tcp:listen(NewPort, Opts2) end. + +listen_ssl(Addr, Port, Opts0) -> + IpFamily = ipfamily_default(Addr, Port), + BaseOpts = [{backlog, 128}, {reuseaddr, true} | Opts0], + Opts = sock_opts(Addr, BaseOpts), + case IpFamily of + inet6fb4 -> + Opts2 = [inet6 | Opts], + ?hlrt("try ipv6 listen", [{opts, Opts2}]), + case (catch ssl:listen(Port, Opts2)) of + {error, Reason} when ((Reason =:= nxdomain) orelse + (Reason =:= eafnosupport)) -> + Opts3 = [inet | Opts], + ?hlrt("ipv6 listen failed - try ipv4 instead", + [{reason, Reason}, {opts, Opts3}]), + ssl:listen(Port, Opts3); + + {'EXIT', Reason} -> + Opts3 = [inet | Opts], + ?hlrt("ipv6 listen exit - try ipv4 instead", + [{reason, Reason}, {opts, Opts3}]), + ssl:listen(Port, Opts3); + + Other -> + ?hlrt("ipv6 listen done", [{other, Other}]), + Other + end; + + _ -> + Opts2 = [IpFamily | Opts], + ?hlrt("listen", [{opts, Opts2}]), + ssl:listen(Port, Opts2) + end. + + ipfamily_default(Addr, Port) -> httpd_conf:lookup(Addr, Port, ipfamily, inet6fb4). @@ -257,9 +290,9 @@ get_socket_info(Addr, Port, Fd0) -> %% The presence of a file descriptor takes precedence case get_fd(Port, Fd0, IpFamilyDefault) of {Fd, IpFamily} -> - {0, sock_opt(ip_comm, Addr, [{fd, Fd} | BaseOpts]), IpFamily}; + {0, sock_opts(Addr, [{fd, Fd} | BaseOpts]), IpFamily}; undefined -> - {Port, sock_opt(ip_comm, Addr, BaseOpts), IpFamilyDefault} + {Port, sock_opts(Addr, BaseOpts), IpFamilyDefault} end. get_fd(Port, undefined = _Fd, IpFamilyDefault) -> @@ -499,44 +532,28 @@ close({essl, _}, Socket) -> %% connection, usning either gen_tcp or ssl. %%------------------------------------------------------------------------- peername(ip_comm, Socket) -> - case inet:peername(Socket) of - {ok,{{A, B, C, D}, Port}} -> - PeerName = integer_to_list(A)++"."++integer_to_list(B)++"."++ - integer_to_list(C)++"."++integer_to_list(D), - {Port, PeerName}; - {ok,{{A, B, C, D, E, F, G, H}, Port}} -> - PeerName = http_util:integer_to_hexlist(A) ++ ":"++ - http_util:integer_to_hexlist(B) ++ ":" ++ - http_util:integer_to_hexlist(C) ++ ":" ++ - http_util:integer_to_hexlist(D) ++ ":" ++ - http_util:integer_to_hexlist(E) ++ ":" ++ - http_util:integer_to_hexlist(F) ++ ":" ++ - http_util:integer_to_hexlist(G) ++":"++ - http_util:integer_to_hexlist(H), - {Port, PeerName}; - {error, _} -> - {-1, "unknown"} - end; + do_peername(inet:peername(Socket)); %% Wrapper for backaward compatibillity peername({ssl, SSLConfig}, Socket) -> peername({?HTTP_DEFAULT_SSL_KIND, SSLConfig}, Socket); peername({ossl, _}, Socket) -> - peername_ssl(Socket); + do_peername(ssl:peername(Socket)); peername({essl, _}, Socket) -> - peername_ssl(Socket). - -peername_ssl(Socket) -> - case ssl:peername(Socket) of - {ok,{{A, B, C, D}, Port}} -> - PeerName = integer_to_list(A)++"."++integer_to_list(B)++"."++ - integer_to_list(C)++"."++integer_to_list(D), - {Port, PeerName}; - {error, _} -> - {-1, "unknown"} - end. + do_peername(ssl:peername(Socket)). + +do_peername({ok, {Addr, Port}}) + when is_tuple(Addr) andalso (size(Addr) =:= 4) -> + PeerName = ipv4_name(Addr), + {Port, PeerName}; +do_peername({ok, {Addr, Port}}) + when is_tuple(Addr) andalso (size(Addr) =:= 8) -> + PeerName = ipv6_name(Addr), + {Port, PeerName}; +do_peername({error, _}) -> + {-1, "unknown"}. %%------------------------------------------------------------------------- @@ -550,44 +567,28 @@ peername_ssl(Socket) -> %% other end of connection, using either gen_tcp or ssl. %%------------------------------------------------------------------------- sockname(ip_comm, Socket) -> - case inet:sockname(Socket) of - {ok,{{A, B, C, D}, Port}} -> - SockName = integer_to_list(A)++"."++integer_to_list(B)++"."++ - integer_to_list(C)++"."++integer_to_list(D), - {Port, SockName}; - {ok,{{A, B, C, D, E, F, G, H}, Port}} -> - SockName = http_util:integer_to_hexlist(A) ++ ":"++ - http_util:integer_to_hexlist(B) ++ ":" ++ - http_util:integer_to_hexlist(C) ++ ":" ++ - http_util:integer_to_hexlist(D) ++ ":" ++ - http_util:integer_to_hexlist(E) ++ ":" ++ - http_util:integer_to_hexlist(F) ++ ":" ++ - http_util:integer_to_hexlist(G) ++":"++ - http_util:integer_to_hexlist(H), - {Port, SockName}; - {error, _} -> - {-1, "unknown"} - end; + do_sockname(inet:sockname(Socket)); %% Wrapper for backaward compatibillity sockname({ssl, SSLConfig}, Socket) -> sockname({?HTTP_DEFAULT_SSL_KIND, SSLConfig}, Socket); sockname({ossl, _}, Socket) -> - sockname_ssl(Socket); + do_sockname(ssl:sockname(Socket)); sockname({essl, _}, Socket) -> - sockname_ssl(Socket). - -sockname_ssl(Socket) -> - case ssl:sockname(Socket) of - {ok,{{A, B, C, D}, Port}} -> - SockName = integer_to_list(A)++"."++integer_to_list(B)++"."++ - integer_to_list(C)++"."++integer_to_list(D), - {Port, SockName}; - {error, _} -> - {-1, "unknown"} - end. + do_sockname(ssl:sockname(Socket)). + +do_sockname({ok, {Addr, Port}}) + when is_tuple(Addr) andalso (size(Addr) =:= 4) -> + SockName = ipv4_name(Addr), + {Port, SockName}; +do_sockname({ok, {Addr, Port}}) + when is_tuple(Addr) andalso (size(Addr) =:= 8) -> + SockName = ipv6_name(Addr), + {Port, SockName}; +do_sockname({error, _}) -> + {-1, "unknown"}. %%------------------------------------------------------------------------- @@ -601,29 +602,49 @@ resolve() -> Name. +%%------------------------------------------------------------------------- +%% ipv4_name(Ipv4Addr) -> string() +%% ipv6_name(Ipv6Addr) -> string() +%% Ipv4Addr = ip4_address() +%% Ipv6Addr = ip6_address() +%% +%% Description: Returns the local hostname. +%%------------------------------------------------------------------------- +ipv4_name({A, B, C, D}) -> + integer_to_list(A) ++ "." ++ + integer_to_list(B) ++ "." ++ + integer_to_list(C) ++ "." ++ + integer_to_list(D). + +ipv6_name({A, B, C, D, E, F, G, H}) -> + http_util:integer_to_hexlist(A) ++ ":"++ + http_util:integer_to_hexlist(B) ++ ":" ++ + http_util:integer_to_hexlist(C) ++ ":" ++ + http_util:integer_to_hexlist(D) ++ ":" ++ + http_util:integer_to_hexlist(E) ++ ":" ++ + http_util:integer_to_hexlist(F) ++ ":" ++ + http_util:integer_to_hexlist(G) ++ ":" ++ + http_util:integer_to_hexlist(H). + + %%%======================================================================== %%% Internal functions %%%======================================================================== +%% -- sock_opts -- %% Address any comes from directive: BindAddress "*" -sock_opt(ip_comm, any = Addr, Opts) -> - sock_opt2([{ip, Addr} | Opts]); -sock_opt(ip_comm, undefined, Opts) -> - sock_opt2(Opts); -sock_opt(_, any = _Addr, Opts) -> - sock_opt2(Opts); -sock_opt(_, undefined = _Addr, Opts) -> - sock_opt2(Opts); -sock_opt(_, {_,_,_,_} = Addr, Opts) -> - sock_opt2([{ip, Addr} | Opts]); -sock_opt(ip_comm, Addr, Opts) -> - sock_opt2([{ip, Addr} | Opts]); -sock_opt(_, Addr, Opts) -> - sock_opt2([{ip, Addr} | Opts]). - -sock_opt2(Opts) -> +sock_opts(undefined, Opts) -> + sock_opts(Opts); +sock_opts(any = Addr, Opts) -> + sock_opts([{ip, Addr} | Opts]); +sock_opts(Addr, Opts) -> + sock_opts([{ip, Addr} | Opts]). + +sock_opts(Opts) -> [{packet, 0}, {active, false} | Opts]. + +%% -- negotiate -- negotiate(ip_comm,_,_) -> ?hlrt("negotiate(ip_comm)", []), ok; diff --git a/lib/inets/src/http_server/httpd_file.erl b/lib/inets/src/http_server/httpd_file.erl index ccc1f7874a..e8a8ab6411 100644 --- a/lib/inets/src/http_server/httpd_file.erl +++ b/lib/inets/src/http_server/httpd_file.erl @@ -33,7 +33,7 @@ handle_error(enotdir, Op, ModData, Path) -> handle_error(404, Op, ModData, Path, ": A component of the file name is not a directory"); handle_error(emfile, Op, _ModData, Path) -> - handle_error(500, Op, none, Path, ": To many open files"); + handle_error(500, Op, none, Path, ": Too many open files"); handle_error({enfile,_}, Op, _ModData, Path) -> handle_error(500, Op, none, Path, ": File table overflow"); handle_error(_Reason, Op, ModData, Path) -> diff --git a/lib/inets/src/inets_app/inets.appup.src b/lib/inets/src/inets_app/inets.appup.src index 47f3fbba58..8b0fcb185d 100644 --- a/lib/inets/src/inets_app/inets.appup.src +++ b/lib/inets/src/inets_app/inets.appup.src @@ -18,6 +18,15 @@ {"%VSN%", [ + {"5.6", + [ + {load_module, httpc, soft_purge, soft_purge, [httpc_manager]}, + {load_module, http_transport, soft_purge, soft_purge, [http_transport]}, + {update, httpc_handler, soft, soft_purge, soft_purge, []}, + {update, httpc_manager, soft, soft_purge, soft_purge, [httpc_handler]}, + {update, ftp, soft, soft_purge, soft_purge, []} + ] + }, {"5.5.2", [ {restart_application, inets} @@ -40,6 +49,15 @@ } ], [ + {"5.6", + [ + {load_module, httpc, soft_purge, soft_purge, [httpc_manager]}, + {load_module, http_transport, soft_purge, soft_purge, [http_transport]}, + {update, httpc_handler, soft, soft_purge, soft_purge, []}, + {update, httpc_manager, soft, soft_purge, soft_purge, [httpc_handler]}, + {update, ftp, soft, soft_purge, soft_purge, []} + ] + }, {"5.5.2", [ {restart_application, inets} diff --git a/lib/inets/test/ftp_suite_lib.erl b/lib/inets/test/ftp_suite_lib.erl index d0d07a8358..3ebd02229e 100644 --- a/lib/inets/test/ftp_suite_lib.erl +++ b/lib/inets/test/ftp_suite_lib.erl @@ -1129,10 +1129,16 @@ ticket_6035(Config) -> LogFile = filename:join([PrivDir,"ticket_6035.log"]), try begin + p("ticket_6035 -> select ftpd host"), Host = dirty_select_ftpd_host(Config), + p("ticket_6035 -> ftpd host selected (~p) => now spawn ftp owner", [Host]), Pid = spawn(?MODULE, open_wait_6035, [Host, self()]), + p("ticket_6035 -> waiter spawned: ~p => now open error logfile (~p)", + [Pid, LogFile]), error_logger:logfile({open, LogFile}), - ok = kill_ftp_proc_6035(Pid,LogFile), + p("ticket_6035 -> error logfile open => now kill waiter process"), + true = kill_ftp_proc_6035(Pid, LogFile), + p("ticket_6035 -> waiter process killed => now close error logfile"), error_logger:logfile(close), p("ticket_6035 -> done", []), ok @@ -1146,7 +1152,7 @@ kill_ftp_proc_6035(Pid, LogFile) -> p("kill_ftp_proc_6035 -> entry"), receive open -> - p("kill_ftp_proc_6035 -> received open: send shutdown"), + p("kill_ftp_proc_6035 -> received open => now issue shutdown"), exit(Pid, shutdown), kill_ftp_proc_6035(Pid, LogFile); {open_failed, Reason} -> @@ -1159,11 +1165,11 @@ kill_ftp_proc_6035(Pid, LogFile) -> is_error_report_6035(LogFile) end. -open_wait_6035(FtpServer, From) -> - p("open_wait_6035 -> try connect to ~s", [FtpServer]), +open_wait_6035({Tag, FtpServer}, From) -> + p("open_wait_6035 -> try connect to [~p] ~s for ~p", [Tag, FtpServer, From]), case ftp:open(FtpServer, [{timeout, timer:seconds(15)}]) of {ok, Pid} -> - p("open_wait_6035 -> connected, now login"), + p("open_wait_6035 -> connected (~p), now login", [Pid]), LoginResult = ftp:user(Pid,"anonymous","kldjf"), p("open_wait_6035 -> login result: ~p", [LoginResult]), From ! open, @@ -1191,22 +1197,27 @@ is_error_report_6035(LogFile) -> Res = case file:read_file(LogFile) of {ok, Bin} -> - p("is_error_report_6035 -> logfile read"), - read_log_6035(binary_to_list(Bin)); + Txt = binary_to_list(Bin), + p("is_error_report_6035 -> logfile read: ~n~p", [Txt]), + read_log_6035(Txt); _ -> - ok + false end, p("is_error_report_6035 -> logfile read result: " "~n ~p", [Res]), - file:delete(LogFile), + %% file:delete(LogFile), Res. read_log_6035("=ERROR REPORT===="++_Rest) -> - error_report; -read_log_6035([_H|T]) -> + p("read_log_6035 -> ERROR REPORT detected"), + true; +read_log_6035([H|T]) -> + p("read_log_6035 -> OTHER: " + "~p", [H]), read_log_6035(T); read_log_6035([]) -> - ok. + p("read_log_6035 -> done"), + false. %%-------------------------------------------------------------------- diff --git a/lib/inets/test/httpc_SUITE.erl b/lib/inets/test/httpc_SUITE.erl index 1998bd3950..6edd5371af 100644 --- a/lib/inets/test/httpc_SUITE.erl +++ b/lib/inets/test/httpc_SUITE.erl @@ -64,16 +64,6 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [ - proxy_options, - proxy_head, - proxy_get, - proxy_trace, - proxy_post, - proxy_put, - proxy_delete, - proxy_auth, - proxy_headers, - proxy_emulate_lower_versions, http_options, http_head, http_get, @@ -88,15 +78,6 @@ all() -> http_headers, http_headers_dummy, http_bad_response, - ssl_head, - ossl_head, - essl_head, - ssl_get, - ossl_get, - essl_get, - ssl_trace, - ossl_trace, - essl_trace, http_redirect, http_redirect_loop, http_internal_server_error, @@ -106,21 +87,44 @@ all() -> http_emulate_lower_versions, http_relaxed, page_does_not_exist, - proxy_page_does_not_exist, - proxy_https_not_supported, - http_stream, - http_stream_once, - proxy_stream, parse_url, options, - ipv6, headers_as_is, + {group, proxy}, + {group, ssl}, + {group, stream}, + {group, ipv6}, {group, tickets}, initial_server_connect ]. groups() -> - [{tickets, [], [hexed_query_otp_6191, + [ + {proxy, [], [proxy_options, + proxy_head, + proxy_get, + proxy_trace, + proxy_post, + proxy_put, + proxy_delete, + proxy_auth, + proxy_headers, + proxy_emulate_lower_versions, + proxy_page_does_not_exist, + proxy_https_not_supported]}, + {ssl, [], [ssl_head, + ossl_head, + essl_head, + ssl_get, + ossl_get, + essl_get, + ssl_trace, + ossl_trace, + essl_trace]}, + {stream, [], [http_stream, + http_stream_once, + proxy_stream]}, + {tickets, [], [hexed_query_otp_6191, empty_body_otp_6243, empty_response_header_otp_6830, transfer_encoding_otp_6807, @@ -139,7 +143,10 @@ groups() -> {otp_8154, [], [otp_8154_1]}, {otp_8106, [], [otp_8106_pid, otp_8106_fun, - otp_8106_mfa]}]. + otp_8106_mfa]}, + {ipv6, [], [ipv6_ipcomm, ipv6_essl]} + ]. + init_per_group(_GroupName, Config) -> @@ -213,36 +220,38 @@ end_per_suite(Config) -> %% Note: This function is free to add any key/value pairs to the Config %% variable, but should NOT alter/remove any existing entries. %%-------------------------------------------------------------------- + init_per_testcase(otp_8154_1 = Case, Config) -> init_per_testcase(Case, 5, Config); -init_per_testcase(initial_server_connect, Config) -> +init_per_testcase(initial_server_connect = Case, Config) -> %% Try to check if crypto actually exist or not, %% this test case does not work unless it does - case (catch crypto:start()) of - ok -> - application:start(public_key), - application:start(ssl), + try + begin + ensure_started(crypto), + ensure_started(public_key), + ensure_started(ssl), inets:start(), - Config; - _ -> - {skip,"Could not start crypto"} + Config + end + catch + throw:{error, {failed_starting, App, ActualError}} -> + tsp("init_per_testcase(~w) -> failed starting ~w: " + "~n ~p", [Case, App, ActualError]), + SkipString = + "Could not start " ++ atom_to_list(App), + {skip, SkipString}; + _:X -> + SkipString = + lists:flatten( + io_lib:format("Failed starting apps: ~p", [X])), + {skip, SkipString} end; init_per_testcase(Case, Config) -> init_per_testcase(Case, 2, Config). -init_per_testcase_ssl(Tag, PrivDir, SslConfFile, Config) -> - tsp("init_per_testcase_ssl -> stop ssl"), - application:stop(ssl), - Config2 = lists:keydelete(local_ssl_server, 1, Config), - %% Will start inets - tsp("init_per_testcase_ssl -> try start http server (including inets)"), - Server = inets_test_lib:start_http_server( - filename:join(PrivDir, SslConfFile), Tag), - tsp("init_per_testcase -> Server: ~p", [Server]), - [{local_ssl_server, Server} | Config2]. - init_per_testcase(Case, Timeout, Config) -> io:format(user, "~n~n*** INIT ~w:~w[~w] ***~n~n", [?MODULE, Case, Timeout]), @@ -261,13 +270,16 @@ init_per_testcase(Case, Timeout, Config) -> NewConfig = case atom_to_list(Case) of [$s, $s, $l | _] -> - init_per_testcase_ssl(ssl, PrivDir, SslConfFile, [{watchdog, Dog} | TmpConfig]); + init_per_testcase_ssl(ssl, PrivDir, SslConfFile, + [{watchdog, Dog} | TmpConfig]); [$o, $s, $s, $l | _] -> - init_per_testcase_ssl(ossl, PrivDir, SslConfFile, [{watchdog, Dog} | TmpConfig]); + init_per_testcase_ssl(ossl, PrivDir, SslConfFile, + [{watchdog, Dog} | TmpConfig]); [$e, $s, $s, $l | _] -> - init_per_testcase_ssl(essl, PrivDir, SslConfFile, [{watchdog, Dog} | TmpConfig]); + init_per_testcase_ssl(essl, PrivDir, SslConfFile, + [{watchdog, Dog} | TmpConfig]); "proxy_" ++ Rest -> io:format("init_per_testcase -> Rest: ~p~n", [Rest]), @@ -275,16 +287,23 @@ init_per_testcase(Case, Timeout, Config) -> "https_not_supported" -> tsp("init_per_testcase -> [proxy case] start inets"), inets:start(), - tsp("init_per_testcase -> [proxy case] start ssl"), - application:start(crypto), - application:start(public_key), - case (catch application:start(ssl)) of + tsp("init_per_testcase -> " + "[proxy case] start crypto, public_key and ssl"), + try ensure_started([crypto, public_key, ssl]) of ok -> - [{watchdog, Dog} | TmpConfig]; - _ -> - [{skip, "SSL does not seem to be supported"} - | TmpConfig] + [{watchdog, Dog} | TmpConfig] + catch + throw:{error, {failed_starting, App, _}} -> + SkipString = + "Could not start " ++ atom_to_list(App), + {skip, SkipString}; + _:X -> + SkipString = + lists:flatten( + io_lib:format("Failed starting apps: ~p", [X])), + {skip, SkipString} end; + _ -> %% We use erlang.org for the proxy tests %% and after the switch to erlang-web, many @@ -321,6 +340,33 @@ init_per_testcase(Case, Timeout, Config) -> [{skip, "proxy not responding"} | TmpConfig] end end; + + "ipv6_" ++ _Rest -> + %% Ensure needed apps (crypto, public_key and ssl) started + try ensure_started([crypto, public_key, ssl]) of + ok -> + Profile = ipv6, + %% A stand-alone profile is represented by a pid() + {ok, ProfilePid} = + inets:start(httpc, + [{profile, Profile}, + {data_dir, PrivDir}], stand_alone), + httpc:set_options([{ipfamily, inet6}], ProfilePid), + tsp("httpc profile pid: ~p", [ProfilePid]), + [{watchdog, Dog}, {profile, ProfilePid}| TmpConfig] + catch + throw:{error, {failed_starting, App, ActualError}} -> + tsp("init_per_testcase(~w) -> failed starting ~w: " + "~n ~p", [Case, App, ActualError]), + SkipString = + "Could not start " ++ atom_to_list(App), + {skip, SkipString}; + _:X -> + SkipString = + lists:flatten( + io_lib:format("Failed starting apps: ~p", [X])), + {skip, SkipString} + end; _ -> TmpConfig2 = lists:keydelete(local_server, 1, TmpConfig), Server = @@ -330,9 +376,7 @@ init_per_testcase(Case, Timeout, Config) -> [{watchdog, Dog}, {local_server, Server} | TmpConfig2] end, - %% httpc:set_options([{proxy, {{?PROXY, ?PROXY_PORT}, - %% ["localhost", ?IPV6_LOCAL_HOST]}}]), - + %% This will fail for the ipv6_ - cases (but that is ok) httpc:set_options([{proxy, {{?PROXY, ?PROXY_PORT}, ["localhost", ?IPV6_LOCAL_HOST]}}, {ipfamily, inet6fb4}]), @@ -341,6 +385,19 @@ init_per_testcase(Case, Timeout, Config) -> NewConfig. +init_per_testcase_ssl(Tag, PrivDir, SslConfFile, Config) -> + tsp("init_per_testcase_ssl(~w) -> stop ssl", [Tag]), + application:stop(ssl), + Config2 = lists:keydelete(local_ssl_server, 1, Config), + %% Will start inets + tsp("init_per_testcase_ssl(~w) -> try start http server (including inets)", + [Tag]), + Server = inets_test_lib:start_http_server( + filename:join(PrivDir, SslConfFile), Tag), + tsp("init_per_testcase(~w) -> Server: ~p", [Tag, Server]), + [{local_ssl_server, Server} | Config2]. + + %%-------------------------------------------------------------------- %% Function: end_per_testcase(Case, Config) -> _ %% Case - atom() @@ -349,13 +406,36 @@ init_per_testcase(Case, Timeout, Config) -> %% A list of key/value pairs, holding the test case configuration. %% Description: Cleanup after each test case %%-------------------------------------------------------------------- -end_per_testcase(http_save_to_file, Config) -> - PrivDir = ?config(priv_dir, Config), +end_per_testcase(http_save_to_file = Case, Config) -> + io:format(user, "~n~n*** END ~w:~w ***~n~n", + [?MODULE, Case]), + PrivDir = ?config(priv_dir, Config), FullPath = filename:join(PrivDir, "dummy.html"), file:delete(FullPath), finish(Config); -end_per_testcase(_, Config) -> +end_per_testcase(Case, Config) -> + io:format(user, "~n~n*** END ~w:~w ***~n~n", + [?MODULE, Case]), + case atom_to_list(Case) of + "ipv6_" ++ _Rest -> + tsp("end_per_testcase(~w) -> stop ssl", [Case]), + application:stop(ssl), + tsp("end_per_testcase(~w) -> stop public_key", [Case]), + application:stop(public_key), + tsp("end_per_testcase(~w) -> stop crypto", [Case]), + application:stop(crypto), + ProfilePid = ?config(profile, Config), + tsp("end_per_testcase(~w) -> stop httpc profile (~p)", + [Case, ProfilePid]), + unlink(ProfilePid), + inets:stop(stand_alone, ProfilePid), + tsp("end_per_testcase(~w) -> httpc profile (~p) stopped", + [Case, ProfilePid]), + ok; + _ -> + ok + end, finish(Config). finish(Config) -> @@ -364,6 +444,7 @@ finish(Config) -> undefined -> ok; _ -> + tsp("finish -> stop watchdog (~p)", [Dog]), test_server:timetrap_cancel(Dog) end. @@ -565,7 +646,7 @@ http_relaxed(suite) -> http_relaxed(Config) when is_list(Config) -> ok = httpc:set_options([{ipv6, disabled}]), % also test the old option %% ok = httpc:set_options([{ipfamily, inet}]), - {DummyServerPid, Port} = dummy_server(self(), ipv4), + {DummyServerPid, Port} = dummy_server(ipv4), URL = ?URL_START ++ integer_to_list(Port) ++ "/missing_reason_phrase.html", @@ -591,7 +672,7 @@ http_dummy_pipe(suite) -> []; http_dummy_pipe(Config) when is_list(Config) -> ok = httpc:set_options([{ipfamily, inet}]), - {DummyServerPid, Port} = dummy_server(self(), ipv4), + {DummyServerPid, Port} = dummy_server(ipv4), URL = ?URL_START ++ integer_to_list(Port) ++ "/foobar.html", @@ -905,7 +986,7 @@ http_headers_dummy(suite) -> []; http_headers_dummy(Config) when is_list(Config) -> ok = httpc:set_options([{ipfamily, inet}]), - {DummyServerPid, Port} = dummy_server(self(), ipv4), + {DummyServerPid, Port} = dummy_server(ipv4), URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy_headers.html", @@ -970,7 +1051,7 @@ http_bad_response(suite) -> []; http_bad_response(Config) when is_list(Config) -> ok = httpc:set_options([{ipfamily, inet}]), - {DummyServerPid, Port} = dummy_server(self(), ipv4), + {DummyServerPid, Port} = dummy_server(ipv4), URL = ?URL_START ++ integer_to_list(Port) ++ "/missing_crlf.html", @@ -1089,9 +1170,9 @@ ssl_get(SslTag, Config) when is_list(Config) -> httpc:request(get, {URL, []}, [{ssl, SSLConfig}], []), inets_test_lib:check_body(Body); {ok, _} -> - {skip, "Failed to start local http-server"}; + {skip, "local http-server not started"}; _ -> - {skip, "Failed to start SSL"} + {skip, "SSL not started"} end. @@ -1149,9 +1230,9 @@ ssl_trace(SslTag, Config) when is_list(Config) -> tsf({failed, Error}) end; {ok, _} -> - {skip, "Failed to start local http-server"}; + {skip, "local http-server not started"}; _ -> - {skip, "Failed to start SSL"} + {skip, "SSL not started"} end. @@ -1170,7 +1251,7 @@ http_redirect(Config) when is_list(Config) -> ok = httpc:set_options([{ipfamily, inet}]), tsp("http_redirect -> start dummy server inet"), - {DummyServerPid, Port} = dummy_server(self(), ipv4), + {DummyServerPid, Port} = dummy_server(ipv4), tsp("http_redirect -> server port = ~p", [Port]), URL300 = ?URL_START ++ integer_to_list(Port) ++ "/300.html", @@ -1282,7 +1363,7 @@ http_redirect_loop(suite) -> []; http_redirect_loop(Config) when is_list(Config) -> ok = httpc:set_options([{ipfamily, inet}]), - {DummyServerPid, Port} = dummy_server(self(), ipv4), + {DummyServerPid, Port} = dummy_server(ipv4), URL = ?URL_START ++ integer_to_list(Port) ++ "/redirectloop.html", @@ -1299,7 +1380,7 @@ http_internal_server_error(suite) -> []; http_internal_server_error(Config) when is_list(Config) -> ok = httpc:set_options([{ipfamily, inet}]), - {DummyServerPid, Port} = dummy_server(self(), ipv4), + {DummyServerPid, Port} = dummy_server(ipv4), URL500 = ?URL_START ++ integer_to_list(Port) ++ "/500.html", @@ -1335,7 +1416,7 @@ http_userinfo(suite) -> http_userinfo(Config) when is_list(Config) -> ok = httpc:set_options([{ipfamily, inet}]), - {DummyServerPid, Port} = dummy_server(self(), ipv4), + {DummyServerPid, Port} = dummy_server(ipv4), URLAuth = "http://alladin:sesame@localhost:" ++ integer_to_list(Port) ++ "/userinfo.html", @@ -1361,7 +1442,7 @@ http_cookie(suite) -> []; http_cookie(Config) when is_list(Config) -> ok = httpc:set_options([{cookies, enabled}, {ipfamily, inet}]), - {DummyServerPid, Port} = dummy_server(self(), ipv4), + {DummyServerPid, Port} = dummy_server(ipv4), URLStart = ?URL_START ++ integer_to_list(Port), @@ -1735,7 +1816,7 @@ http_stream_once(Config) when is_list(Config) -> p("http_stream_once -> set ipfamily to inet", []), ok = httpc:set_options([{ipfamily, inet}]), p("http_stream_once -> start dummy server", []), - {DummyServerPid, Port} = dummy_server(self(), ipv4), + {DummyServerPid, Port} = dummy_server(ipv4), PortStr = integer_to_list(Port), p("http_stream_once -> once", []), @@ -1871,28 +1952,79 @@ parse_url(Config) when is_list(Config) -> %%------------------------------------------------------------------------- -ipv6() -> - [{require,ipv6_hosts}]. -ipv6(doc) -> - ["Test ipv6."]; -ipv6(suite) -> - []; -ipv6(Config) when is_list(Config) -> - {ok, Hostname} = inet:gethostname(), - - case lists:member(list_to_atom(Hostname), - ct:get_config(ipv6_hosts)) of - true -> - {DummyServerPid, Port} = dummy_server(self(), ipv6), - - URL = "http://[" ++ ?IPV6_LOCAL_HOST ++ "]:" ++ + +ipv6_ipcomm() -> + [{require, ipv6_hosts}]. +ipv6_ipcomm(doc) -> + ["Test ip_comm ipv6."]; +ipv6_ipcomm(suite) -> + []; +ipv6_ipcomm(Config) when is_list(Config) -> + HTTPOptions = [], + SocketType = ip_comm, + Scheme = "http", + Extra = [], + ipv6(SocketType, Scheme, HTTPOptions, Extra, Config). + + +%%------------------------------------------------------------------------- + +ipv6_essl() -> + [{require, ipv6_hosts}]. +ipv6_essl(doc) -> + ["Test essl ipv6."]; +ipv6_essl(suite) -> + []; +ipv6_essl(Config) when is_list(Config) -> + DataDir = ?config(data_dir, Config), + CertFile = filename:join(DataDir, "ssl_client_cert.pem"), + SSLOptions = [{certfile, CertFile}, {keyfile, CertFile}], + SSLConfig = {essl, SSLOptions}, + tsp("ssl_ipv6 -> make request using: " + "~n SSLOptions: ~p", [SSLOptions]), + HTTPOptions = [{ssl, SSLConfig}], + SocketType = essl, + Scheme = "https", + Extra = SSLOptions, + ipv6(SocketType, Scheme, HTTPOptions, Extra, Config). + + +%%------------------------------------------------------------------------- + +ipv6(SocketType, Scheme, HTTPOptions, Extra, Config) -> + %% Check if we are a IPv6 host + tsp("ipv6 -> verify ipv6 support", []), + case inets_test_lib:has_ipv6_support(Config) of + {ok, Addr} -> + tsp("ipv6 -> ipv6 supported: ~p", [Addr]), + {DummyServerPid, Port} = dummy_server(SocketType, ipv6, Extra), + Profile = ?config(profile, Config), + URL = + Scheme ++ + "://[" ++ http_transport:ipv6_name(Addr) ++ "]:" ++ integer_to_list(Port) ++ "/foobar.html", - {ok, {{_,200,_}, [_ | _], [_|_]}} = - httpc:request(get, {URL, []}, [], []), - - DummyServerPid ! stop, + tsp("ipv6 -> issue request with: " + "~n URL: ~p" + "~n HTTPOptions: ~p", [URL, HTTPOptions]), + case httpc:request(get, {URL, []}, HTTPOptions, [], Profile) of + {ok, {{_,200,_}, [_ | _], [_|_]}} -> + tsp("ipv6 -> expected result"), + DummyServerPid ! stop, + ok; + {ok, Unexpected} -> + tsp("ipv6 -> unexpected result: " + "~n ~p", [Unexpected]), + DummyServerPid ! stop, + tsf({unexpected_result, Unexpected}); + {error, Reason} -> + tsp("ipv6 -> error: " + "~n Reason: ~p", [Reason]), + DummyServerPid ! stop, + tsf(Reason) + end, ok; - false -> + _ -> + tsp("ipv6 -> ipv6 not supported", []), {skip, "Host does not support IPv6"} end. @@ -1945,7 +2077,7 @@ http_invalid_http(suite) -> []; http_invalid_http(Config) when is_list(Config) -> ok = httpc:set_options([{ipfamily, inet}]), - {DummyServerPid, Port} = dummy_server(self(), ipv4), + {DummyServerPid, Port} = dummy_server(ipv4), URL = ?URL_START ++ integer_to_list(Port) ++ "/invalid_http.html", @@ -2002,7 +2134,7 @@ transfer_encoding_otp_6807(suite) -> []; transfer_encoding_otp_6807(Config) when is_list(Config) -> ok = httpc:set_options([{ipfamily, inet}]), - {DummyServerPid, Port} = dummy_server(self(), ipv4), + {DummyServerPid, Port} = dummy_server(ipv4), URL = ?URL_START ++ integer_to_list(Port) ++ "/capital_transfer_encoding.html", @@ -2035,7 +2167,7 @@ empty_response_header_otp_6830(suite) -> []; empty_response_header_otp_6830(Config) when is_list(Config) -> ok = httpc:set_options([{ipfamily, inet}]), - {DummyServerPid, Port} = dummy_server(self(), ipv4), + {DummyServerPid, Port} = dummy_server(ipv4), URL = ?URL_START ++ integer_to_list(Port) ++ "/no_headers.html", {ok, {{_,200,_}, [], [_ | _]}} = httpc:request(URL), @@ -2052,7 +2184,7 @@ no_content_204_otp_6982(suite) -> []; no_content_204_otp_6982(Config) when is_list(Config) -> ok = httpc:set_options([{ipfamily, inet}]), - {DummyServerPid, Port} = dummy_server(self(), ipv4), + {DummyServerPid, Port} = dummy_server(ipv4), URL = ?URL_START ++ integer_to_list(Port) ++ "/no_content.html", {ok, {{_,204,_}, [], []}} = httpc:request(URL), @@ -2070,7 +2202,7 @@ missing_CR_otp_7304(suite) -> []; missing_CR_otp_7304(Config) when is_list(Config) -> ok = httpc:set_options([{ipfamily, inet}]), - {DummyServerPid, Port} = dummy_server(self(), ipv4), + {DummyServerPid, Port} = dummy_server(ipv4), URL = ?URL_START ++ integer_to_list(Port) ++ "/missing_CR.html", {ok, {{_,200,_}, _, [_ | _]}} = httpc:request(URL), @@ -2089,7 +2221,7 @@ otp_7883_1(suite) -> otp_7883_1(Config) when is_list(Config) -> ok = httpc:set_options([{ipfamily, inet}]), - {DummyServerPid, Port} = dummy_server(self(), ipv4), + {DummyServerPid, Port} = dummy_server(ipv4), URL = ?URL_START ++ integer_to_list(Port) ++ "/just_close.html", {error, socket_closed_remotely} = httpc:request(URL), @@ -2105,7 +2237,7 @@ otp_7883_2(suite) -> otp_7883_2(Config) when is_list(Config) -> ok = httpc:set_options([{ipfamily, inet}]), - {DummyServerPid, Port} = dummy_server(self(), ipv4), + {DummyServerPid, Port} = dummy_server(ipv4), URL = ?URL_START ++ integer_to_list(Port) ++ "/just_close.html", Method = get, @@ -2626,7 +2758,7 @@ otp_8371(suite) -> []; otp_8371(Config) when is_list(Config) -> ok = httpc:set_options([{ipv6, disabled}]), % also test the old option - {DummyServerPid, Port} = dummy_server(self(), ipv4), + {DummyServerPid, Port} = dummy_server(ipv4), URL = ?URL_START ++ integer_to_list(Port) ++ "/ensure_host_header_with_port.html", @@ -2864,75 +2996,179 @@ receive_streamed_body(RequestId, Body, Pid) -> test_server:fail(Msg) end. +%% Perform a synchronous stop +dummy_server_stop(Pid) -> + Pid ! {stop, self()}, + receive + {stopped, Pid} -> + ok + end. + +dummy_server(IpV) -> + dummy_server(self(), ip_comm, IpV, []). +dummy_server(SocketType, IpV, Extra) -> + dummy_server(self(), SocketType, IpV, Extra). -dummy_server(Caller, IpV) -> - Pid = spawn(httpc_SUITE, dummy_server_init, [Caller, IpV]), +dummy_server(Caller, SocketType, IpV, Extra) -> + Args = [Caller, SocketType, IpV, Extra], + Pid = spawn(httpc_SUITE, dummy_server_init, Args), receive {port, Port} -> {Pid, Port} end. -dummy_server_init(Caller, IpV) -> +dummy_server_init(Caller, ip_comm, IpV, _) -> + BaseOpts = [binary, {packet, 0}, {reuseaddr,true}, {active, false}], {ok, ListenSocket} = case IpV of ipv4 -> - gen_tcp:listen(0, [binary, inet, {packet, 0}, - {reuseaddr,true}, - {active, false}]); + tsp("ip_comm ipv4 listen", []), + gen_tcp:listen(0, [inet | BaseOpts]); ipv6 -> - gen_tcp:listen(0, [binary, inet6, {packet, 0}, - {reuseaddr,true}, - {active, false}]) + tsp("ip_comm ipv6 listen", []), + gen_tcp:listen(0, [inet6 | BaseOpts]) end, {ok, Port} = inet:port(ListenSocket), - tsp("dummy_server_init -> Port: ~p", [Port]), + tsp("dummy_server_init(ip_comm) -> Port: ~p", [Port]), Caller ! {port, Port}, - dummy_server_loop({httpd_request, parse, [?HTTP_MAX_HEADER_SIZE]}, - [], ListenSocket). + dummy_ipcomm_server_loop({httpd_request, parse, [?HTTP_MAX_HEADER_SIZE]}, + [], ListenSocket); +dummy_server_init(Caller, essl, IpV, SSLOptions) -> + BaseOpts = [{ssl_imp, new}, + {backlog, 128}, binary, {reuseaddr,true}, {active, false} | + SSLOptions], + dummy_ssl_server_init(Caller, BaseOpts, IpV); +dummy_server_init(Caller, ossl, IpV, SSLOptions) -> + BaseOpts = [{ssl_imp, old}, + {backlog, 128}, binary, {active, false} | SSLOptions], + dummy_ssl_server_init(Caller, BaseOpts, IpV). + +dummy_ssl_server_init(Caller, BaseOpts, IpV) -> + {ok, ListenSocket} = + case IpV of + ipv4 -> + tsp("dummy_ssl_server_init -> ssl ipv4 listen", []), + ssl:listen(0, [inet | BaseOpts]); + ipv6 -> + tsp("dummy_ssl_server_init -> ssl ipv6 listen", []), + ssl:listen(0, [inet6 | BaseOpts]) + end, + tsp("dummy_ssl_server_init -> ListenSocket: ~p", [ListenSocket]), + {ok, {_, Port}} = ssl:sockname(ListenSocket), + tsp("dummy_ssl_server_init -> Port: ~p", [Port]), + Caller ! {port, Port}, + dummy_ssl_server_loop({httpd_request, parse, [?HTTP_MAX_HEADER_SIZE]}, + [], ListenSocket). -dummy_server_loop(MFA, Handlers, ListenSocket) -> +dummy_ipcomm_server_loop(MFA, Handlers, ListenSocket) -> receive stop -> - lists:foreach(fun(Handler) -> Handler ! stop end, Handlers) + tsp("dummy_ipcomm_server_loop -> stop handlers", []), + lists:foreach(fun(Handler) -> Handler ! stop end, Handlers); + {stop, From} -> + tsp("dummy_ipcomm_server_loop -> " + "stop command from ~p for handlers (~p)", [From, Handlers]), + Stopper = fun(Handler) -> Handler ! stop end, + lists:foreach(Stopper, Handlers), + From ! {stopped, self()} after 0 -> + tsp("dummy_ipcomm_server_loop -> await accept", []), {ok, Socket} = gen_tcp:accept(ListenSocket), + tsp("dummy_ipcomm_server_loop -> accepted: ~p", [Socket]), HandlerPid = dummy_request_handler(MFA, Socket), + tsp("dummy_icomm_server_loop -> handler created: ~p", [HandlerPid]), gen_tcp:controlling_process(Socket, HandlerPid), - HandlerPid ! controller, - dummy_server_loop(MFA, [HandlerPid | Handlers], + tsp("dummy_ipcomm_server_loop -> " + "control transfered to handler", []), + HandlerPid ! ipcomm_controller, + tsp("dummy_ipcomm_server_loop -> " + "handler informed about control transfer", []), + dummy_ipcomm_server_loop(MFA, [HandlerPid | Handlers], ListenSocket) end. +dummy_ssl_server_loop(MFA, Handlers, ListenSocket) -> + receive + stop -> + tsp("dummy_ssl_server_loop -> stop handlers", []), + lists:foreach(fun(Handler) -> Handler ! stop end, Handlers); + {stop, From} -> + tsp("dummy_ssl_server_loop -> " + "stop command from ~p for handlers (~p)", [From, Handlers]), + Stopper = fun(Handler) -> Handler ! stop end, + lists:foreach(Stopper, Handlers), + From ! {stopped, self()} + after 0 -> + tsp("dummy_ssl_server_loop -> await accept", []), + {ok, Socket} = ssl:transport_accept(ListenSocket), + tsp("dummy_ssl_server_loop -> accepted: ~p", [Socket]), + HandlerPid = dummy_request_handler(MFA, Socket), + tsp("dummy_ssl_server_loop -> handler created: ~p", [HandlerPid]), + ssl:controlling_process(Socket, HandlerPid), + tsp("dummy_ssl_server_loop -> control transfered to handler", []), + HandlerPid ! ssl_controller, + tsp("dummy_ssl_server_loop -> " + "handler informed about control transfer", []), + dummy_ssl_server_loop(MFA, [HandlerPid | Handlers], + ListenSocket) + end. + dummy_request_handler(MFA, Socket) -> + tsp("spawn request handler", []), spawn(httpc_SUITE, dummy_request_handler_init, [MFA, Socket]). dummy_request_handler_init(MFA, Socket) -> - receive - controller -> - inet:setopts(Socket, [{active, true}]) - end, - dummy_request_handler_loop(MFA, Socket). + SockType = + receive + ipcomm_controller -> + tsp("dummy_request_handler_init -> " + "received ip_comm controller - activate", []), + inet:setopts(Socket, [{active, true}]), + ip_comm; + ssl_controller -> + tsp("dummy_request_handler_init -> " + "received ssl controller - activate", []), + ssl:setopts(Socket, [{active, true}]), + ssl + end, + dummy_request_handler_loop(MFA, SockType, Socket). -dummy_request_handler_loop({Module, Function, Args}, Socket) -> +dummy_request_handler_loop({Module, Function, Args}, SockType, Socket) -> tsp("dummy_request_handler_loop -> entry with" "~n Module: ~p" "~n Function: ~p" "~n Args: ~p", [Module, Function, Args]), receive - {tcp, _, Data} -> - tsp("dummy_request_handler_loop -> Data ~p", [Data]), - case handle_request(Module, Function, [Data | Args], Socket) of - stop -> + {Proto, _, Data} when (Proto =:= tcp) orelse (Proto =:= ssl) -> + tsp("dummy_request_handler_loop -> [~w] Data ~p", [Proto, Data]), + case handle_request(Module, Function, [Data | Args], Socket, Proto) of + stop when Proto =:= tcp -> gen_tcp:close(Socket); + stop when Proto =:= ssl -> + ssl:close(Socket); NewMFA -> - dummy_request_handler_loop(NewMFA, Socket) + dummy_request_handler_loop(NewMFA, SockType, Socket) end; - stop -> - gen_tcp:close(Socket) + stop when SockType =:= ip_comm -> + gen_tcp:close(Socket); + stop when SockType =:= ssl -> + ssl:close(Socket) end. -handle_request(Module, Function, Args, Socket) -> + +mk_close(tcp) -> fun(Sock) -> gen_tcp:close(Sock) end; +mk_close(ssl) -> fun(Sock) -> ssl:close(Sock) end. + +mk_send(tcp) -> fun(Sock, Data) -> gen_tcp:send(Sock, Data) end; +mk_send(ssl) -> fun(Sock, Data) -> ssl:send(Sock, Data) end. + +handle_request(Module, Function, Args, Socket, Proto) -> + Close = mk_close(Proto), + Send = mk_send(Proto), + handle_request(Module, Function, Args, Socket, Close, Send). + +handle_request(Module, Function, Args, Socket, Close, Send) -> tsp("handle_request -> entry with" "~n Module: ~p" "~n Function: ~p" @@ -2941,7 +3177,7 @@ handle_request(Module, Function, Args, Socket) -> {ok, Result} -> tsp("handle_request -> ok" "~n Result: ~p", [Result]), - case (catch handle_http_msg(Result, Socket)) of + case (catch handle_http_msg(Result, Socket, Close, Send)) of stop -> stop; <<>> -> @@ -2949,7 +3185,8 @@ handle_request(Module, Function, Args, Socket) -> {httpd_request, parse, [[<<>>, ?HTTP_MAX_HEADER_SIZE]]}; Data -> handle_request(httpd_request, parse, - [Data |[?HTTP_MAX_HEADER_SIZE]], Socket) + [Data |[?HTTP_MAX_HEADER_SIZE]], Socket, + Close, Send) end; NewMFA -> tsp("handle_request -> " @@ -2957,7 +3194,7 @@ handle_request(Module, Function, Args, Socket) -> NewMFA end. -handle_http_msg({_, RelUri, _, {_, Headers}, Body}, Socket) -> +handle_http_msg({_, RelUri, _, {_, Headers}, Body}, Socket, Close, Send) -> tsp("handle_http_msg -> entry with: " "~n RelUri: ~p" "~n Headers: ~p" @@ -3114,16 +3351,16 @@ handle_http_msg({_, RelUri, _, {_, Headers}, Body}, Socket) -> "Expires:Sat, 29 Oct 1994 19:43:31 GMT\r\n" ++ "Proxy-Authenticate:#1Basic" ++ "\r\n\r\n", - gen_tcp:send(Socket, Head), - gen_tcp:send(Socket, http_chunk:encode("<HTML><BODY>fo")), - gen_tcp:send(Socket, http_chunk:encode("obar</BODY></HTML>")), + Send(Socket, Head), + Send(Socket, http_chunk:encode("<HTML><BODY>fo")), + Send(Socket, http_chunk:encode("obar</BODY></HTML>")), http_chunk:encode_last(); "/capital_transfer_encoding.html" -> Head = "HTTP/1.1 200 ok\r\n" ++ "Transfer-Encoding:Chunked\r\n\r\n", - gen_tcp:send(Socket, Head), - gen_tcp:send(Socket, http_chunk:encode("<HTML><BODY>fo")), - gen_tcp:send(Socket, http_chunk:encode("obar</BODY></HTML>")), + Send(Socket, Head), + Send(Socket, http_chunk:encode("<HTML><BODY>fo")), + Send(Socket, http_chunk:encode("obar</BODY></HTML>")), http_chunk:encode_last(); "/cookie.html" -> "HTTP/1.1 200 ok\r\n" ++ @@ -3142,20 +3379,20 @@ handle_http_msg({_, RelUri, _, {_, Headers}, Body}, Socket) -> "/once_chunked.html" -> Head = "HTTP/1.1 200 ok\r\n" ++ "Transfer-Encoding:Chunked\r\n\r\n", - gen_tcp:send(Socket, Head), - gen_tcp:send(Socket, http_chunk:encode("<HTML><BODY>fo")), - gen_tcp:send(Socket, + Send(Socket, Head), + Send(Socket, http_chunk:encode("<HTML><BODY>fo")), + Send(Socket, http_chunk:encode("obar</BODY></HTML>")), http_chunk:encode_last(); "/once.html" -> Head = "HTTP/1.1 200 ok\r\n" ++ "Content-Length:32\r\n\r\n", - gen_tcp:send(Socket, Head), - gen_tcp:send(Socket, "<HTML><BODY>fo"), + Send(Socket, Head), + Send(Socket, "<HTML><BODY>fo"), test_server:sleep(1000), - gen_tcp:send(Socket, "ob"), + Send(Socket, "ob"), test_server:sleep(1000), - gen_tcp:send(Socket, "ar</BODY></HTML>"); + Send(Socket, "ar</BODY></HTML>"); "/invalid_http.html" -> "HTTP/1.1 301\r\nDate:Sun, 09 Dec 2007 13:04:18 GMT\r\n" ++ "Transfer-Encoding:chunked\r\n\r\n"; @@ -3178,9 +3415,9 @@ handle_http_msg({_, RelUri, _, {_, Headers}, Body}, Socket) -> ok; close -> %% Nothing to send, just close - gen_tcp:close(Socket); + Close(Socket); _ when is_list(Msg) orelse is_binary(Msg) -> - gen_tcp:send(Socket, Msg) + Send(Socket, Msg) end, tsp("handle_http_msg -> done"), NextRequest. @@ -3316,3 +3553,20 @@ dummy_ssl_server_hang_loop(_) -> stop -> ok end. + + +ensure_started([]) -> + ok; +ensure_started([App|Apps]) -> + ensure_started(App), + ensure_started(Apps); +ensure_started(App) when is_atom(App) -> + case (catch application:start(App)) of + ok -> + ok; + {error, {already_started, _}} -> + ok; + Error -> + throw({error, {failed_starting, App, Error}}) + end. + diff --git a/lib/inets/test/httpd_SUITE.erl b/lib/inets/test/httpd_SUITE.erl index fde5178879..c4d4bf969b 100644 --- a/lib/inets/test/httpd_SUITE.erl +++ b/lib/inets/test/httpd_SUITE.erl @@ -207,8 +207,11 @@ -export([ticket_5775/1,ticket_5865/1,ticket_5913/1,ticket_6003/1, ticket_7304/1]). -%%% Misc --export([ipv6_hostname/1, ipv6_address/1]). +%%% IPv6 tests +-export([ipv6_hostname_ipcomm/0, ipv6_hostname_ipcomm/1, + ipv6_address_ipcomm/0, ipv6_address_ipcomm/1, + ipv6_hostname_essl/0, ipv6_hostname_essl/1, + ipv6_address_essl/0, ipv6_address_essl/1]). %% Help functions -export([cleanup_mnesia/0, setup_mnesia/0, setup_mnesia/1]). @@ -241,9 +244,15 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [{group, ip}, {group, ssl}, {group, http_1_1_ip}, - {group, http_1_0_ip}, {group, http_0_9_ip}, - {group, tickets}]. + [ + {group, ip}, + {group, ssl}, + {group, http_1_1_ip}, + {group, http_1_0_ip}, + {group, http_0_9_ip}, + {group, ipv6}, + {group, tickets} + ]. groups() -> [{ip, [], @@ -329,7 +338,8 @@ groups() -> {http_1_0_ip, [], [ip_head_1_0, ip_get_1_0, ip_post_1_0]}, {http_0_9_ip, [], [ip_get_0_9]}, - {ipv6, [], [ipv6_hostname, ipv6_address]}, + {ipv6, [], [ipv6_hostname_ipcomm, ipv6_address_ipcomm, + ipv6_hostname_essl, ipv6_address_essl]}, {tickets, [], [ticket_5775, ticket_5865, ticket_5913, ticket_6003, ticket_7304]}]. @@ -408,10 +418,10 @@ init_per_testcase2(Case, Config) -> "~n Config: ~p" "~n", [?MODULE, Case, Config]), - IpNormal = integer_to_list(?IP_PORT) ++ ".conf", - IpHtacess = integer_to_list(?IP_PORT) ++ "htacess.conf", - SslNormal = integer_to_list(?SSL_PORT) ++ ".conf", - SslHtacess = integer_to_list(?SSL_PORT) ++ "htacess.conf", + IpNormal = integer_to_list(?IP_PORT) ++ ".conf", + IpHtaccess = integer_to_list(?IP_PORT) ++ "htaccess.conf", + SslNormal = integer_to_list(?SSL_PORT) ++ ".conf", + SslHtaccess = integer_to_list(?SSL_PORT) ++ "htaccess.conf", DataDir = ?config(data_dir, Config), SuiteTopDir = ?config(suite_top_dir, Config), @@ -471,9 +481,9 @@ init_per_testcase2(Case, Config) -> io:format(user, "~w:init_per_testcase2(~w) -> ip testcase setups~n", [?MODULE, Case]), create_config([{port, ?IP_PORT}, {sock_type, ip_comm} | NewConfig], - normal_acess, IpNormal), + normal_access, IpNormal), create_config([{port, ?IP_PORT}, {sock_type, ip_comm} | NewConfig], - mod_htaccess, IpHtacess), + mod_htaccess, IpHtaccess), %% To be used by SSL test cases io:format(user, "~w:init_per_testcase2(~w) -> ssl testcase setups~n", @@ -491,9 +501,9 @@ init_per_testcase2(Case, Config) -> end, create_config([{port, ?SSL_PORT}, {sock_type, SocketType} | NewConfig], - normal_acess, SslNormal), + normal_access, SslNormal), create_config([{port, ?SSL_PORT}, {sock_type, SocketType} | NewConfig], - mod_htaccess, SslHtacess), + mod_htaccess, SslHtaccess), %% To be used by IPv6 test cases. Case-clause is so that %% you can do ts:run(inets, httpd_SUITE, <test case>) @@ -501,22 +511,52 @@ init_per_testcase2(Case, Config) -> %% on 'test_host_ipv6_only' that will only be present %% when you run the whole test suite due to shortcomings %% of the test server. - %% case (catch ?config(test_host_ipv6_only, Config)) of - %% {_,IPv6Host,IPv6Adress,_,_} -> - %% create_ipv6_config([{port, ?IP_PORT}, - %% {sock_type, ip_comm} | NewConfig], - %% "ipv6_hostname.conf", IPv6Host), - %% create_ipv6_config([{port, ?IP_PORT}, - %% {sock_type, ip_comm} | NewConfig], - %% "ipv6_address.conf", IPv6Adress); - %% _ -> - %% ok - %% end, - + + io:format(user, "~w:init_per_testcase2(~w) -> " + "maybe generate IPv6 config file(s)", [?MODULE, Case]), + NewConfig2 = + case atom_to_list(Case) of + "ipv6_" ++ _ -> + case (catch inets_test_lib:has_ipv6_support(NewConfig)) of + {ok, IPv6Address0} -> + {ok, Hostname} = inet:gethostname(), + IPv6Address = http_transport:ipv6_name(IPv6Address0), + create_ipv6_config([{port, ?IP_PORT}, + {sock_type, ip_comm}, + {ipv6_host, IPv6Address} | + NewConfig], + "ipv6_hostname_ipcomm.conf", + Hostname), + create_ipv6_config([{port, ?IP_PORT}, + {sock_type, ip_comm}, + {ipv6_host, IPv6Address} | + NewConfig], + "ipv6_address_ipcomm.conf", + IPv6Address), + create_ipv6_config([{port, ?SSL_PORT}, + {sock_type, essl}, + {ipv6_host, IPv6Address} | + NewConfig], + "ipv6_hostname_essl.conf", + Hostname), + create_ipv6_config([{port, ?SSL_PORT}, + {sock_type, essl}, + {ipv6_host, IPv6Address} | + NewConfig], + "ipv6_address_essl.conf", + IPv6Address), + [{ipv6_host, IPv6Address} | NewConfig]; + _ -> + NewConfig + end; + _ -> + NewConfig + end, + io:format(user, "~w:init_per_testcase2(~w) -> done~n", [?MODULE, Case]), - NewConfig. + NewConfig2. init_per_testcase3(Case, Config) -> @@ -547,10 +587,10 @@ init_per_testcase3(Case, Config) -> [?MODULE, Case]), inets:disable_trace(); _ -> - %% TraceLevel = max, io:format(user, "~w:init_per_testcase3(~w) -> enabling trace", [?MODULE, Case]), - TraceLevel = 70, + %% TraceLevel = 70, + TraceLevel = max, TraceDest = io, inets:enable_trace(TraceLevel, TraceDest, httpd) end, @@ -569,7 +609,7 @@ init_per_testcase3(Case, Config) -> inets_test_lib:start_http_server( filename:join(TcTopDir, integer_to_list(?IP_PORT) ++ - "htacess.conf")), + "htaccess.conf")), "mod_htaccess"; "ip_" ++ Rest -> inets_test_lib:start_http_server( @@ -602,7 +642,7 @@ init_per_testcase3(Case, Config) -> case inets_test_lib:start_http_server_ssl( filename:join(TcTopDir, integer_to_list(?SSL_PORT) ++ - "htacess.conf"), SslTag) of + "htaccess.conf"), SslTag) of ok -> "mod_htaccess"; Other -> @@ -627,16 +667,13 @@ init_per_testcase3(Case, Config) -> {skip, "SSL does not seem to be supported"} end; "ipv6_" ++ _ = TestCaseStr -> - {ok, Hostname} = inet:gethostname(), - - case lists:member(list_to_atom(Hostname), - ?config(ipv6_hosts, Config)) of - true -> + case inets_test_lib:has_ipv6_support() of + {ok, _} -> inets_test_lib:start_http_server( filename:join(TcTopDir, TestCaseStr ++ ".conf")); - false -> + _ -> {skip, "Host does not support IPv6"} end end, @@ -650,8 +687,8 @@ init_per_testcase3(Case, Config) -> "mod_htaccess" -> ServerRoot = ?config(server_root, Config), Path = filename:join([ServerRoot, "htdocs"]), - catch remove_htacess(Path), - create_htacess_data(Path, ?config(address, Config)), + catch remove_htaccess(Path), + create_htaccess_data(Path, ?config(address, Config)), [{watchdog, Dog} | NewConfig]; "range" -> ServerRoot = ?config(server_root, Config), @@ -2409,30 +2446,76 @@ ip_mod_cgi_chunked_encoding_test(Config) when is_list(Config) -> ok. %------------------------------------------------------------------------- -ipv6_hostname(doc) -> + +ipv6_hostname_ipcomm() -> + [{require, ipv6_hosts}]. +ipv6_hostname_ipcomm(X) -> + SocketType = ip_comm, + Port = ?IP_PORT, + ipv6_hostname(SocketType, Port, X). + +ipv6_hostname_essl() -> + [{require, ipv6_hosts}]. +ipv6_hostname_essl(X) -> + SocketType = essl, + Port = ?SSL_PORT, + ipv6_hostname(SocketType, Port, X). + +ipv6_hostname(_SocketType, _Port, doc) -> ["Test standard ipv6 address"]; -ipv6_hostname(suite)-> +ipv6_hostname(_SocketType, _Port, suite)-> []; -ipv6_hostname(Config) when is_list(Config) -> +ipv6_hostname(SocketType, Port, Config) when is_list(Config) -> + tsp("ipv6_hostname -> entry with" + "~n SocketType: ~p" + "~n Port: ~p" + "~n Config: ~p", [SocketType, Port, Config]), Host = ?config(host, Config), - httpd_test_lib:verify_request(ip_comm, Host, ?IP_PORT, node(), - "GET / HTTP/1.1\r\n\r\n", - [{statuscode, 200}, - {version, "HTTP/1.1"}]), + URI = "GET HTTP://" ++ + Host ++ ":" ++ integer_to_list(Port) ++ "/ HTTP/1.1\r\n\r\n", + tsp("ipv6_hostname -> Host: ~p", [Host]), + httpd_test_lib:verify_request(SocketType, Host, Port, [inet6], + node(), + URI, + [{statuscode, 200}, {version, "HTTP/1.1"}]), ok. %%------------------------------------------------------------------------- -ipv6_address(doc) -> + +ipv6_address_ipcomm() -> + [{require, ipv6_hosts}]. +ipv6_address_ipcomm(X) -> + SocketType = ip_comm, + Port = ?IP_PORT, + ipv6_address(SocketType, Port, X). + +ipv6_address_essl() -> + [{require, ipv6_hosts}]. +ipv6_address_essl(X) -> + SocketType = essl, + Port = ?SSL_PORT, + ipv6_address(SocketType, Port, X). + +ipv6_address(_SocketType, _Port, doc) -> ["Test standard ipv6 address"]; -ipv6_address(suite)-> +ipv6_address(_SocketType, _Port, suite)-> []; -ipv6_address(Config) when is_list(Config) -> - httpd_test_lib:verify_request(ip_comm, ?IPV6_LOCAL_HOST, ?IP_PORT, - node(), "GET / HTTP/1.1\r\n\r\n", - [{statuscode, 200}, - {version, "HTTP/1.1"}]), +ipv6_address(SocketType, Port, Config) when is_list(Config) -> + tsp("ipv6_address -> entry with" + "~n SocketType: ~p" + "~n Port: ~p" + "~n Config: ~p", [SocketType, Port, Config]), + Host = ?config(host, Config), + tsp("ipv6_address -> Host: ~p", [Host]), + URI = "GET HTTP://" ++ + Host ++ ":" ++ integer_to_list(Port) ++ "/ HTTP/1.1\r\n\r\n", + httpd_test_lib:verify_request(SocketType, Host, Port, [inet6], + node(), + URI, + [{statuscode, 200}, {version, "HTTP/1.1"}]), ok. + %%-------------------------------------------------------------------- ticket_5775(doc) -> ["Tests that content-length is correct"]; @@ -2805,22 +2888,22 @@ cleanup_mnesia() -> mnesia:delete_schema([node()]), ok. -create_htacess_data(Path, IpAddress)-> - create_htacess_dirs(Path), +create_htaccess_data(Path, IpAddress)-> + create_htaccess_dirs(Path), create_html_file(filename:join([Path,"ht/open/dummy.html"])), create_html_file(filename:join([Path,"ht/blocknet/dummy.html"])), create_html_file(filename:join([Path,"ht/secret/dummy.html"])), create_html_file(filename:join([Path,"ht/secret/top_secret/dummy.html"])), - create_htacess_file(filename:join([Path,"ht/open/.htaccess"]), + create_htaccess_file(filename:join([Path,"ht/open/.htaccess"]), Path, "user one Aladdin"), - create_htacess_file(filename:join([Path,"ht/secret/.htaccess"]), + create_htaccess_file(filename:join([Path,"ht/secret/.htaccess"]), Path, "group group1 group2"), - create_htacess_file(filename:join([Path, + create_htaccess_file(filename:join([Path, "ht/secret/top_secret/.htaccess"]), Path, "user four"), - create_htacess_file(filename:join([Path,"ht/blocknet/.htaccess"]), + create_htaccess_file(filename:join([Path,"ht/blocknet/.htaccess"]), Path, nouser, IpAddress), create_user_group_file(filename:join([Path,"ht","users.file"]), @@ -2835,7 +2918,7 @@ create_html_file(PathAndFileName)-> "<html><head><title>test</title></head> <body>testar</body></html>")). -create_htacess_file(PathAndFileName, BaseDir, RequireData)-> +create_htaccess_file(PathAndFileName, BaseDir, RequireData)-> file:write_file(PathAndFileName, list_to_binary( "AuthUserFile "++ BaseDir ++ @@ -2844,7 +2927,7 @@ create_htacess_file(PathAndFileName, BaseDir, RequireData)-> " Basic\n<Limit>\nrequire " ++ RequireData ++ "\n</Limit>")). -create_htacess_file(PathAndFileName, BaseDir, nouser, IpAddress)-> +create_htaccess_file(PathAndFileName, BaseDir, nouser, IpAddress)-> file:write_file(PathAndFileName,list_to_binary( "AuthUserFile "++ BaseDir ++ "/ht/users.file\nAuthGroupFile " ++ @@ -2858,14 +2941,14 @@ create_htacess_file(PathAndFileName, BaseDir, nouser, IpAddress)-> create_user_group_file(PathAndFileName, Data)-> file:write_file(PathAndFileName, list_to_binary(Data)). -create_htacess_dirs(Path)-> +create_htaccess_dirs(Path)-> ok = file:make_dir(filename:join([Path,"ht"])), ok = file:make_dir(filename:join([Path,"ht/open"])), ok = file:make_dir(filename:join([Path,"ht/blocknet"])), ok = file:make_dir(filename:join([Path,"ht/secret"])), ok = file:make_dir(filename:join([Path,"ht/secret/top_secret"])). -remove_htacess_dirs(Path)-> +remove_htaccess_dirs(Path)-> file:del_dir(filename:join([Path,"ht/secret/top_secret"])), file:del_dir(filename:join([Path,"ht/secret"])), file:del_dir(filename:join([Path,"ht/blocknet"])), @@ -2888,7 +2971,7 @@ format_ip(IpAddress,Pos)when Pos > 0-> format_ip(IpAddress, _Pos)-> "1" ++ IpAddress. -remove_htacess(Path)-> +remove_htaccess(Path)-> file:delete(filename:join([Path,"ht/open/dummy.html"])), file:delete(filename:join([Path,"ht/secret/dummy.html"])), file:delete(filename:join([Path,"ht/secret/top_secret/dummy.html"])), @@ -2899,7 +2982,7 @@ remove_htacess(Path)-> file:delete(filename:join([Path,"ht/secret/top_secret/.htaccess"])), file:delete(filename:join([Path,"ht","users.file"])), file:delete(filename:join([Path,"ht","groups.file"])), - remove_htacess_dirs(Path). + remove_htaccess_dirs(Path). dos_hostname_poll(Type, Host, Port, Node, Hosts) -> @@ -2939,35 +3022,66 @@ create_range_data(Path) -> "12345678901234567890", "12345678901234567890"])). -%% create_ipv6_config(Config, FileName, Ipv6Address) -> -%% ServerRoot = ?config(server_root, Config), -%% TcTopDir = ?config(tc_top_dir, Config), -%% Port = ?config(port, Config), -%% SockType = ?config(sock_type, Config), -%% -%% MaxHdrSz = io_lib:format("~p", [256]), -%% MaxHdrAct = io_lib:format("~p", [close]), -%% -%% Mod_order = "Modules mod_alias mod_auth mod_esi mod_actions mod_cgi" -%% " mod_include mod_dir mod_get mod_head" -%% " mod_log mod_disk_log mod_trace", -%% -%% HttpConfig = [cline(["BindAddress ", "[" ++ Ipv6Address ++"]|inet6"]), -%% cline(["Port ", integer_to_list(Port)]), -%% cline(["ServerName ", "httpc_test"]), -%% cline(["SocketType ", atom_to_list(SockType)]), -%% cline([Mod_order]), -%% cline(["ServerRoot ", ServerRoot]), -%% cline(["DocumentRoot ", -%% filename:join(ServerRoot, "htdocs")]), -%% cline(["MaxHeaderSize ",MaxHdrSz]), -%% cline(["MaxHeaderAction ",MaxHdrAct]), -%% cline(["DirectoryIndex ", "index.html "]), -%% cline(["DefaultType ", "text/plain"])], -%% ConfigFile = filename:join([TcTopDir,FileName]), -%% {ok, Fd} = file:open(ConfigFile, [write]), -%% ok = file:write(Fd, lists:flatten(HttpConfig)), -%% ok = file:close(Fd). +create_ipv6_config(Config, FileName, Ipv6Address) -> + ServerRoot = ?config(server_root, Config), + TcTopDir = ?config(tc_top_dir, Config), + Port = ?config(port, Config), + SockType = ?config(sock_type, Config), + Mods = io_lib:format("~p", [httpd_mod]), + Funcs = io_lib:format("~p", [ssl_password_cb]), + Host = ?config(ipv6_host, Config), + + MaxHdrSz = io_lib:format("~p", [256]), + MaxHdrAct = io_lib:format("~p", [close]), + + Mod_order = "Modules mod_alias mod_auth mod_esi mod_actions mod_cgi" + " mod_include mod_dir mod_get mod_head" + " mod_log mod_disk_log mod_trace", + + SSL = + if + (SockType =:= ssl) orelse + (SockType =:= ossl) orelse + (SockType =:= essl) -> + [cline(["SSLCertificateFile ", + filename:join(ServerRoot, "ssl/ssl_server.pem")]), + cline(["SSLCertificateKeyFile ", + filename:join(ServerRoot, "ssl/ssl_server.pem")]), + cline(["SSLCACertificateFile ", + filename:join(ServerRoot, "ssl/ssl_server.pem")]), + cline(["SSLPasswordCallbackModule ", Mods]), + cline(["SSLPasswordCallbackFunction ", Funcs]), + cline(["SSLVerifyClient 0"]), + cline(["SSLVerifyDepth 1"])]; + true -> + [] + end, + + BindAddress = "[" ++ Ipv6Address ++"]|inet6", + + HttpConfig = + [cline(["BindAddress ", BindAddress]), + cline(["Port ", integer_to_list(Port)]), + cline(["ServerName ", Host]), + cline(["SocketType ", atom_to_list(SockType)]), + cline([Mod_order]), + cline(["ServerRoot ", ServerRoot]), + cline(["DocumentRoot ", filename:join(ServerRoot, "htdocs")]), + cline(["MaxHeaderSize ",MaxHdrSz]), + cline(["MaxHeaderAction ",MaxHdrAct]), + cline(["DirectoryIndex ", "index.html "]), + cline(["DefaultType ", "text/plain"]), + SSL], + ConfigFile = filename:join([TcTopDir,FileName]), + {ok, Fd} = file:open(ConfigFile, [write]), + ok = file:write(Fd, lists:flatten(HttpConfig)), + ok = file:close(Fd). + + +%% tsp(F) -> +%% inets_test_lib:tsp(F). +tsp(F, A) -> + inets_test_lib:tsp(F, A). tsf(Reason) -> - test_server:fail(Reason). + inets_test_lib:tsf(Reason). diff --git a/lib/inets/test/httpd_test_lib.erl b/lib/inets/test/httpd_test_lib.erl index 3189a758a5..2903aaafa5 100644 --- a/lib/inets/test/httpd_test_lib.erl +++ b/lib/inets/test/httpd_test_lib.erl @@ -22,7 +22,7 @@ -include("inets_test_lib.hrl"). %% Poll functions --export([verify_request/6, verify_request/7, is_expect/1]). +-export([verify_request/6, verify_request/7, verify_request/8, is_expect/1]). -record(state, {request, % string() socket, % socket() @@ -81,33 +81,57 @@ %%------------------------------------------------------------------ verify_request(SocketType, Host, Port, Node, RequestStr, Options) -> verify_request(SocketType, Host, Port, Node, RequestStr, Options, 30000). -verify_request(SocketType, Host, Port, Node, RequestStr, Options, TimeOut) -> - {ok, Socket} = inets_test_lib:connect_bin(SocketType, Host, Port), +verify_request(SocketType, Host, Port, TranspOpts, Node, RequestStr, Options) + when is_list(TranspOpts) -> + verify_request(SocketType, Host, Port, TranspOpts, Node, RequestStr, Options, 30000); +verify_request(SocketType, Host, Port, Node, RequestStr, Options, TimeOut) + when (is_integer(TimeOut) orelse (TimeOut =:= infinity)) -> + verify_request(SocketType, Host, Port, [], Node, RequestStr, Options, TimeOut). +verify_request(SocketType, Host, Port, TranspOpts, Node, RequestStr, Options, TimeOut) -> + tsp("verify_request -> entry with" + "~n SocketType: ~p" + "~n Host: ~p" + "~n Port: ~p" + "~n TranspOpts: ~p" + "~n Node: ~p" + "~n Options: ~p" + "~n TimeOut: ~p", + [SocketType, Host, Port, TranspOpts, Node, Options, TimeOut]), + case (catch inets_test_lib:connect_bin(SocketType, Host, Port, TranspOpts)) of + {ok, Socket} -> + tsp("verify_request -> connected - now send message"), + SendRes = inets_test_lib:send(SocketType, Socket, RequestStr), + tsp("verify_request -> send result: " + "~n ~p", [SendRes]), + State = case inets_regexp:match(RequestStr, "printenv") of + nomatch -> + #state{}; + _ -> + #state{print = true} + end, + + case request(State#state{request = RequestStr, + socket = Socket}, TimeOut) of + {error, Reason} -> + tsp("request failed: " + "~n Reason: ~p", [Reason]), + {error, Reason}; + NewState -> + tsp("validate reply: " + "~n NewState: ~p", [NewState]), + ValidateResult = + validate(RequestStr, NewState, Options, Node, Port), + tsp("validation result: " + "~n ~p", [ValidateResult]), + inets_test_lib:close(SocketType, Socket), + ValidateResult + end; - _SendRes = inets_test_lib:send(SocketType, Socket, RequestStr), - - State = case inets_regexp:match(RequestStr, "printenv") of - nomatch -> - #state{}; - _ -> - #state{print = true} - end, - - case request(State#state{request = RequestStr, - socket = Socket}, TimeOut) of - {error, Reason} -> - tsp("request failed: " - "~n Reason: ~p", [Reason]), - {error, Reason}; - NewState -> - tsp("validate reply: " - "~n NewState: ~p", [NewState]), - ValidateResult = validate(RequestStr, NewState, Options, - Node, Port), - tsp("validation result: " - "~n ~p", [ValidateResult]), - inets_test_lib:close(SocketType, Socket), - ValidateResult + ConnectError -> + tsp("verify_request -> connect failed: " + "~n ~p" + "~n", [ConnectError]), + tsf({connect_failure, ConnectError}) end. request(#state{mfa = {Module, Function, Args}, @@ -214,7 +238,10 @@ validate(RequestStr, #state{status_line = {Version, StatusCode, _}, headers = Headers, body = Body}, Options, N, P) -> - %io:format("Status~p: H:~p B:~p~n", [StatusCode, Headers, Body]), + %% tsp("validate -> entry with" + %% "~n StatusCode: ~p" + %% "~n Headers: ~p" + %% "~n Body: ~p", [StatusCode, Headers, Body]), check_version(Version, Options), case lists:keysearch(statuscode, 1, Options) of {value, _} -> @@ -342,8 +369,10 @@ print(_, _, #state{print = false}) -> ok. -%% tsp(F) -> -%% tsp(F, []). +tsp(F) -> + inets_test_lib:tsp(F). tsp(F, A) -> - test_server:format("~p ~p:" ++ F ++ "~n", [self(), ?MODULE | A]). + inets_test_lib:tsp(F, A). +tsf(Reason) -> + inets_test_lib:tsf(Reason). diff --git a/lib/inets/test/inets_test_lib.erl b/lib/inets/test/inets_test_lib.erl index 6cedaf9638..2e19c41f16 100644 --- a/lib/inets/test/inets_test_lib.erl +++ b/lib/inets/test/inets_test_lib.erl @@ -26,18 +26,64 @@ -export([start_http_server/1, start_http_server/2]). -export([start_http_server_ssl/1, start_http_server_ssl/2]). -export([hostname/0]). --export([connect_bin/3, connect_byte/3, send/3, close/2]). +-export([connect_bin/3, connect_bin/4, + connect_byte/3, connect_byte/4, + send/3, close/2]). -export([copy_file/3, copy_files/2, copy_dirs/2, del_dirs/1]). -export([info/4, log/4, debug/4, print/4]). +-export([tsp/1, tsp/2, tsf/1]). -export([check_body/1]). -export([millis/0, millis_diff/2, hours/1, minutes/1, seconds/1, sleep/1]). --export([oscmd/1]). +-export([oscmd/1, has_ipv6_support/1]). -export([non_pc_tc_maybe_skip/4, os_based_skip/1, skip/3, fail/3]). -export([flush/0]). -export([start_node/1, stop_node/1]). %% -- Misc os command and stuff +has_ipv6_support(Config) -> + case lists:keysearch(ipv6_hosts, 1, Config) of + false -> + %% Do a basic check to se if + %% our own host has a working IPv6 address... + tsp("has_ipv6_support -> no ipv6_hosts config"), + {ok, Hostname} = inet:gethostname(), + case inet:getaddrs(Hostname, inet6) of + {ok, [Addr|_]} when is_tuple(Addr) andalso + (element(1, Addr) =/= 0) -> + %% We actually need to test that the addr can be used, + %% this is done by attempting to create a (tcp) + %% listen socket + tsp("has_ipv6_support -> check Addr: ~p", [Addr]), + case (catch gen_tcp:listen(0, [inet6, {ip, Addr}])) of + {ok, LSock} -> + tsp("has_ipv6_support -> we are ipv6 host"), + gen_tcp:close(LSock), + {ok, Addr}; + _ -> + undefined + end; + _ -> + undefined + end; + {value, {_, Hosts}} when is_list(Hosts) -> + %% Check if our host is in the list of *known* IPv6 hosts + tsp("has_ipv6_support -> Hosts: ~p", [Hosts]), + {ok, Hostname} = inet:gethostname(), + case lists:member(list_to_atom(Hostname), Hosts) of + true -> + tsp("has_ipv6_support -> we are known ipv6 host"), + {ok, [Addr|_]} = inet:getaddrs(Hostname, inet6), + {ok, Addr}; + false -> + undefined + end; + + _ -> + undefined + + end. + oscmd(Cmd) -> string:strip(os:cmd(Cmd), right, $\n). @@ -87,31 +133,34 @@ start_http_server(Conf) -> start_http_server(Conf, ?HTTP_DEFAULT_SSL_KIND). start_http_server(Conf, essl = _SslTag) -> + tsp("start_http_server(essl) -> entry - try start crypto and public_key"), application:start(crypto), + application:start(public_key), do_start_http_server(Conf); -start_http_server(Conf, _SslTag) -> +start_http_server(Conf, SslTag) -> + tsp("start_http_server(~w) -> entry", [SslTag]), do_start_http_server(Conf). do_start_http_server(Conf) -> - tsp("start http server with " + tsp("do_start_http_server -> entry with" "~n Conf: ~p" "~n", [Conf]), application:load(inets), case application:set_env(inets, services, [{httpd, Conf}]) of ok -> + tsp("start_http_server -> httpd conf stored in inets app env"), case application:start(inets) of ok -> + tsp("start_http_server -> inets started"), ok; Error1 -> - test_server:format("<ERROR> Failed starting application: " - "~n Error: ~p" - "~n", [Error1]), + tsp("<ERROR> Failed starting application: " + "~n Error1: ~p", [Error1]), Error1 end; Error2 -> - test_server:format("<ERROR> Failed set application env: " - "~n Error: ~p" - "~n", [Error2]), + tsp("<ERROR> Failed set application env: " + "~n Error: ~p", [Error2]), Error2 end. @@ -285,29 +334,45 @@ os_based_skip(_) -> %% Host -> atom() | string() | {A, B, C, D} %% Port -> integer() -connect_bin(ssl, Host, Port) -> - connect(ssl, Host, Port, [binary, {packet,0}]); -connect_bin(ossl, Host, Port) -> - connect(ssl, Host, Port, [{ssl_imp, old}, binary, {packet,0}]); -connect_bin(essl, Host, Port) -> - connect(ssl, Host, Port, [{ssl_imp, new}, binary, {packet,0}, {reuseaddr, true}]); -connect_bin(ip_comm, Host, Port) -> - Opts = [inet6, binary, {packet,0}], +connect_bin(SockType, Host, Port) -> + connect_bin(SockType, Host, Port, []). + +connect_bin(ssl, Host, Port, Opts0) -> + Opts = [binary, {packet,0} | Opts0], + connect(ssl, Host, Port, Opts); +connect_bin(ossl, Host, Port, Opts0) -> + Opts = [{ssl_imp, old}, binary, {packet,0} | Opts0], + connect(ssl, Host, Port, Opts); +connect_bin(essl, Host, Port, Opts0) -> + Opts = [{ssl_imp, new}, binary, {packet,0}, {reuseaddr, true} | Opts0], + connect(ssl, Host, Port, Opts); +connect_bin(ip_comm, Host, Port, Opts0) -> + Opts = [binary, {packet, 0} | Opts0], connect(ip_comm, Host, Port, Opts). + +connect_byte(SockType, Host, Port) -> + connect_byte(SockType, Host, Port, []). -connect_byte(ssl, Host, Port) -> - connect(ssl, Host, Port, [{packet,0}]); -connect_byte(ossl, Host, Port) -> - connect(ssl, Host, Port, [{ssl_imp, old}, {packet,0}]); -connect_byte(essl, Host, Port) -> - connect(ssl, Host, Port, [{ssl_imp, new}, {packet,0}]); -connect_byte(ip_comm, Host, Port) -> - Opts = [inet6, {packet,0}], +connect_byte(ssl, Host, Port, Opts0) -> + Opts = [{packet,0} | Opts0], + connect(ssl, Host, Port, Opts); +connect_byte(ossl, Host, Port, Opts0) -> + Opts = [{ssl_imp, old}, {packet,0} | Opts0], + connect(ssl, Host, Port, Opts); +connect_byte(essl, Host, Port, Opts0) -> + Opts = [{ssl_imp, new}, {packet,0} | Opts0], + connect(ssl, Host, Port, Opts); +connect_byte(ip_comm, Host, Port, Opts0) -> + Opts = [{packet,0} | Opts0], connect(ip_comm, Host, Port, Opts). connect(ssl, Host, Port, Opts) -> + tsp("connect(ssl) -> entry with" + "~n Host: ~p" + "~n Port: ~p" + "~n Opts: ~p", [Host, Port, Opts]), ssl:start(), %% Does not support ipv6 in old ssl case ssl:connect(Host, Port, Opts) of @@ -319,21 +384,28 @@ connect(ssl, Host, Port, Opts) -> Error end; connect(ip_comm, Host, Port, Opts) -> + tsp("connect(ip_comm) -> entry with" + "~n Host: ~p" + "~n Port: ~p" + "~n Opts: ~p", [Host, Port, Opts]), case gen_tcp:connect(Host,Port, Opts) of {ok, Socket} -> - %% tsp("connect success"), + tsp("connect success"), {ok, Socket}; {error, nxdomain} -> - tsp("nxdomain opts: ~p", [Opts]), + tsp("connect error nxdomain when opts: ~p", [Opts]), connect(ip_comm, Host, Port, lists:delete(inet6, Opts)); {error, eafnosupport} -> - tsp("eafnosupport opts: ~p", [Opts]), + tsp("connect error eafnosupport when opts: ~p", [Opts]), + connect(ip_comm, Host, Port, lists:delete(inet6, Opts)); + {error, econnreset} -> + tsp("connect error econnreset when opts: ~p", [Opts]), connect(ip_comm, Host, Port, lists:delete(inet6, Opts)); {error, enetunreach} -> - tsp("eafnosupport opts: ~p", [Opts]), + tsp("connect error eafnosupport when opts: ~p", [Opts]), connect(ip_comm, Host, Port, lists:delete(inet6, Opts)); {error, {enfile,_}} -> - tsp("Error enfile"), + tsp("connect error enfile when opts: ~p", [Opts]), {error, enfile}; Error -> tsp("Unexpected error: " @@ -414,7 +486,22 @@ flush() -> tsp(F) -> tsp(F, []). tsp(F, A) -> - test_server:format("~p ~p ~p:" ++ F ++ "~n", [node(), self(), ?MODULE | A]). + Timestamp = formated_timestamp(), + test_server:format("*** ~s ~p ~p ~w:" ++ F ++ "~n", + [Timestamp, node(), self(), ?MODULE | A]). tsf(Reason) -> test_server:fail(Reason). + +formated_timestamp() -> + format_timestamp( os:timestamp() ). + +format_timestamp({_N1, _N2, N3} = Now) -> + {Date, Time} = calendar:now_to_datetime(Now), + {YYYY,MM,DD} = Date, + {Hour,Min,Sec} = Time, + FormatDate = + io_lib:format("~.4w:~.2.0w:~.2.0w ~.2.0w:~.2.0w:~.2.0w 4~w", + [YYYY,MM,DD,Hour,Min,Sec,round(N3/1000)]), + lists:flatten(FormatDate). + diff --git a/lib/inets/vsn.mk b/lib/inets/vsn.mk index c0e25a30e3..4abc1733d3 100644 --- a/lib/inets/vsn.mk +++ b/lib/inets/vsn.mk @@ -18,7 +18,7 @@ # %CopyrightEnd% APPLICATION = inets -INETS_VSN = 5.6 +INETS_VSN = 5.7 PRE_VSN = APP_VSN = "$(APPLICATION)-$(INETS_VSN)$(PRE_VSN)" diff --git a/lib/kernel/doc/src/Makefile b/lib/kernel/doc/src/Makefile index de10e31d36..214e994889 100644 --- a/lib/kernel/doc/src/Makefile +++ b/lib/kernel/doc/src/Makefile @@ -104,6 +104,8 @@ TOP_SPECS_FILE = specs.xml # ---------------------------------------------------- XML_FLAGS += +SPECS_ESRC = ../../src + SPECS_FLAGS = -I../../include # ---------------------------------------------------- diff --git a/lib/kernel/doc/src/code.xml b/lib/kernel/doc/src/code.xml index 6f85388c22..98cdd416b0 100644 --- a/lib/kernel/doc/src/code.xml +++ b/lib/kernel/doc/src/code.xml @@ -288,196 +288,156 @@ <datatypes> <datatype> + <name name="load_ret"/> + </datatype> + <datatype> <name name="load_error_rsn"/> </datatype> </datatypes> <funcs> <func> - <name>set_path(Path) -> true | {error, What}</name> + <name name="set_path" arity="1"/> <fsummary>Set the code server search path</fsummary> - <type> - <v>Path = [Dir]</v> - <v>Dir = string()</v> - <v>What = bad_directory | bad_path</v> - </type> <desc> - <p>Sets the code path to the list of directories <c>Path</c>.</p> + <p>Sets the code path to the list of directories <c><anno>Path</anno></c>.</p> <p>Returns <c>true</c> if successful, or - <c>{error, bad_directory}</c> if any <c>Dir</c> is not + <c>{error, bad_directory}</c> if any <c><anno>Dir</anno></c> is not the name of a directory, or <c>{error, bad_path}</c> if the argument is invalid.</p> </desc> </func> <func> - <name>get_path() -> Path</name> + <name name="get_path" arity="0"/> <fsummary>Return the code server search path</fsummary> - <type> - <v>Path = [Dir]</v> - <v>Dir = string()</v> - </type> <desc> <p>Returns the code path</p> </desc> </func> <func> - <name>add_path(Dir) -> true | {error, What}</name> - <name>add_pathz(Dir) -> true | {error, What}</name> + <name name="add_path" arity="1"/> + <name name="add_pathz" arity="1"/> <fsummary>Add a directory to the end of the code path</fsummary> - <type> - <v>Dir = string()</v> - <v>What = bad_directory</v> - </type> + <type name="add_path_ret"/> <desc> - <p>Adds <c>Dir</c> to the code path. The directory is added as - the last directory in the new path. If <c>Dir</c> already + <p>Adds <c><anno>Dir</anno></c> to the code path. The directory is added as + the last directory in the new path. If <c><anno>Dir</anno></c> already exists in the path, it is not added.</p> <p>Returns <c>true</c> if successful, or - <c>{error, bad_directory}</c> if <c>Dir</c> is not the name + <c>{error, bad_directory}</c> if <c><anno>Dir</anno></c> is not the name of a directory.</p> </desc> </func> <func> - <name>add_patha(Dir) -> true | {error, What}</name> + <name name="add_patha" arity="1"/> <fsummary>Add a directory to the beginning of the code path</fsummary> - <type> - <v>Dir = string()</v> - <v>What = bad_directory</v> - </type> + <type name="add_path_ret"/> <desc> - <p>Adds <c>Dir</c> to the beginning of the code path. If - <c>Dir</c> already exists, it is removed from the old + <p>Adds <c><anno>Dir</anno></c> to the beginning of the code path. If + <c><anno>Dir</anno></c> already exists, it is removed from the old position in the code path.</p> <p>Returns <c>true</c> if successful, or - <c>{error, bad_directory}</c> if <c>Dir</c> is not the name + <c>{error, bad_directory}</c> if <c><anno>Dir</anno></c> is not the name of a directory.</p> </desc> </func> <func> - <name>add_paths(Dirs) -> ok</name> - <name>add_pathsz(Dirs) -> ok</name> + <name name="add_paths" arity="1"/> + <name name="add_pathsz" arity="1"/> <fsummary>Add directories to the end of the code path</fsummary> - <type> - <v>Dirs = [Dir]</v> - <v>Dir = string()</v> - </type> <desc> - <p>Adds the directories in <c>Dirs</c> to the end of the code - path. If a <c>Dir</c> already exists, it is not added. This + <p>Adds the directories in <c><anno>Dirs</anno></c> to the end of the code + path. If a <c><anno>Dir</anno></c> already exists, it is not added. This function always returns <c>ok</c>, regardless of the validity - of each individual <c>Dir</c>.</p> + of each individual <c><anno>Dir</anno></c>.</p> </desc> </func> <func> - <name>add_pathsa(Dirs) -> ok</name> + <name name="add_pathsa" arity="1"/> <fsummary>Add directories to the beginning of the code path</fsummary> - <type> - <v>Dirs = [Dir]</v> - <v>Dir = string()</v> - </type> <desc> - <p>Adds the directories in <c>Dirs</c> to the beginning of - the code path. If a <c>Dir</c> already exists, it is removed + <p>Adds the directories in <c><anno>Dirs</anno></c> to the beginning of + the code path. If a <c><anno>Dir</anno></c> already exists, it is removed from the old position in the code path. This function always returns <c>ok</c>, regardless of the validity of each - individual <c>Dir</c>.</p> + individual <c><anno>Dir</anno></c>.</p> </desc> </func> <func> - <name>del_path(Name | Dir) -> true | false | {error, What}</name> + <name name="del_path" arity="1"/> <fsummary>Delete a directory from the code path</fsummary> - <type> - <v>Name = atom()</v> - <v>Dir = string()</v> - <v>What = bad_name</v> - </type> <desc> <p>Deletes a directory from the code path. The argument can be - an atom <c>Name</c>, in which case the directory with - the name <c>.../Name[-Vsn][/ebin]</c> is deleted from the code + an atom <c><anno>Name</anno></c>, in which case the directory with + the name <c>.../<anno>Name</anno>[-Vsn][/ebin]</c> is deleted from the code path. It is also possible to give the complete directory name - <c>Dir</c> as argument.</p> + <c><anno>Dir</anno></c> as argument.</p> <p>Returns <c>true</c> if successful, or <c>false</c> if the directory is not found, or <c>{error, bad_name}</c> if the argument is invalid.</p> </desc> </func> <func> - <name>replace_path(Name, Dir) -> true | {error, What}</name> + <name name="replace_path" arity="2"/> <fsummary>Replace a directory with another in the code path</fsummary> - <type> - <v>Name = atom()</v> - <v>Dir = string()</v> - <v>What = bad_name | bad_directory | {badarg, term()}</v> - </type> <desc> <p>This function replaces an old occurrence of a directory - named <c>.../Name[-Vsn][/ebin]</c>, in the code path, with - <c>Dir</c>. If <c>Name</c> does not exist, it adds the new - directory <c>Dir</c> last in the code path. The new directory - must also be named <c>.../Name[-Vsn][/ebin]</c>. This function + named <c>.../<anno>Name</anno>[-Vsn][/ebin]</c>, in the code path, with + <c><anno>Dir</anno></c>. If <c><anno>Name</anno></c> does not exist, it adds the new + directory <c><anno>Dir</anno></c> last in the code path. The new directory + must also be named <c>.../<anno>Name</anno>[-Vsn][/ebin]</c>. This function should be used if a new version of the directory (library) is added to a running system.</p> <p>Returns <c>true</c> if successful, or - <c>{error, bad_name}</c> if <c>Name</c> is not found, or - <c>{error, bad_directory}</c> if <c>Dir</c> does not exist, or - <c>{error, {badarg, [Name, Dir]}}</c> if <c>Name</c> or - <c>Dir</c> is invalid.</p> + <c>{error, bad_name}</c> if <c><anno>Name</anno></c> is not found, or + <c>{error, bad_directory}</c> if <c><anno>Dir</anno></c> does not exist, or + <c>{error, {badarg, [<anno>Name</anno>, <anno>Dir</anno>]}}</c> if <c><anno>Name</anno></c> or + <c><anno>Dir</anno></c> is invalid.</p> </desc> </func> <func> - <name>load_file(Module) -> {module, Module} | {error, What}</name> + <name name="load_file" arity="1"/> <fsummary>Load a module</fsummary> - <type> - <v>Module = atom()</v> - <v>What = nofile | sticky_directory | badarg | term()</v> - </type> + <type name="load_ret"/> <desc> - <p>Tries to load the Erlang module <c>Module</c>, using + <p>Tries to load the Erlang module <c><anno>Module</anno></c>, using the code path. It looks for the object code file with an extension that corresponds to the Erlang machine used, for - example <c>Module.beam</c>. The loading fails if the module + example <c><anno>Module</anno>.beam</c>. The loading fails if the module name found in the object code differs from the name - <c>Module</c>. + <c><anno>Module</anno></c>. <seealso marker="#load_binary/3">load_binary/3</seealso> must be used to load object code with a module name that is different from the file name.</p> - <p>Returns <c>{module, Module}</c> if successful, or + <p>Returns <c>{module, <anno>Module</anno>}</c> if successful, or <c>{error, nofile}</c> if no object code is found, or <c>{error, sticky_directory}</c> if the object code resides in - a sticky directory, or <c>{error, badarg}</c> if the argument - is invalid. Also if the loading fails, an error tuple is + a sticky directory. Also if the loading fails, an error tuple is returned. See <seealso marker="erts:erlang#load_module/2">erlang:load_module/2</seealso> - for possible values of <c>What</c>.</p> + for possible values of <c><anno>What</anno></c>.</p> </desc> </func> <func> - <name>load_abs(Filename) -> {module, Module} | {error, What}</name> + <name name="load_abs" arity="1"/> <fsummary>Load a module, residing in a given file</fsummary> - <type> - <v>Filename = string()</v> - <v>Module = atom()</v> - <v>What = nofile | sticky_directory | badarg | term()</v> - </type> + <type name="load_ret"/> + <type name="loaded_filename"/> + <type name="loaded_ret_atoms"/> <desc> - <p>Does the same as <c>load_file(Module)</c>, but - <c>Filename</c> is either an absolute file name, or a + <p>Does the same as <c>load_file(<anno>Module</anno>)</c>, but + <c><anno>Filename</anno></c> is either an absolute file name, or a relative file name. The code path is not searched. It returns a value in the same way as <seealso marker="#load_file/1">load_file/1</seealso>. Note - that <c>Filename</c> should not contain the extension (for + that <c><anno>Filename</anno></c> should not contain the extension (for example <c>".beam"</c>); <c>load_abs/1</c> adds the correct extension itself.</p> </desc> </func> <func> - <name>ensure_loaded(Module) -> {module, Module} | {error, What}</name> + <name name="ensure_loaded" arity="1"/> <fsummary>Ensure that a module is loaded</fsummary> - <type> - <v>Module = atom()</v> - <v>What = nofile | sticky_directory | embedded | badarg | term()</v> - </type> <desc> <p>Tries to to load a module in the same way as <seealso marker="#load_file/1">load_file/1</seealso>, @@ -487,54 +447,45 @@ </desc> </func> <func> - <name>load_binary(Module, Filename, Binary) -> {module, Module} | {error, What}</name> + <name name="load_binary" arity="3"/> <fsummary>Load object code for a module</fsummary> - <type> - <v>Module = atom()</v> - <v>Filename = string()</v> - <v>What = sticky_directory | badarg | term()</v> - </type> + <type name="loaded_filename"/> + <type name="loaded_ret_atoms"/> <desc> <p>This function can be used to load object code on remote - Erlang nodes. The argument <c>Binary</c> must contain - object code for <c>Module</c>. - <c>Filename</c> is only used by the code server to keep a - record of from which file the object code for <c>Module</c> - comes. Accordingly, <c>Filename</c> is not opened and read by + Erlang nodes. The argument <c><anno>Binary</anno></c> must contain + object code for <c><anno>Module</anno></c>. + <c><anno>Filename</anno></c> is only used by the code server to keep a + record of from which file the object code for <c><anno>Module</anno></c> + comes. Accordingly, <c><anno>Filename</anno></c> is not opened and read by the code server.</p> - <p>Returns <c>{module, Module}</c> if successful, or + <p>Returns <c>{module, <anno>Module</anno>}</c> if successful, or <c>{error, sticky_directory}</c> if the object code resides in a sticky directory, or <c>{error, badarg}</c> if any argument is invalid. Also if the loading fails, an error tuple is returned. See <seealso marker="erts:erlang#load_module/2">erlang:load_module/2</seealso> - for possible values of <c>What</c>.</p> + for possible values of <c><anno>What</anno></c>.</p> </desc> </func> <func> - <name>delete(Module) -> true | false</name> + <name name="delete" arity="1"/> <fsummary>Removes current code for a module</fsummary> - <type> - <v>Module = atom()</v> - </type> <desc> - <p>Removes the current code for <c>Module</c>, that is, - the current code for <c>Module</c> is made old. This means + <p>Removes the current code for <c><anno>Module</anno></c>, that is, + the current code for <c><anno>Module</anno></c> is made old. This means that processes can continue to execute the code in the module, but that no external function calls can be made to it.</p> <p>Returns <c>true</c> if successful, or <c>false</c> if there - is old code for <c>Module</c> which must be purged first, or - if <c>Module</c> is not a (loaded) module.</p> + is old code for <c><anno>Module</anno></c> which must be purged first, or + if <c><anno>Module</anno></c> is not a (loaded) module.</p> </desc> </func> <func> - <name>purge(Module) -> true | false</name> + <name name="purge" arity="1"/> <fsummary>Removes old code for a module</fsummary> - <type> - <v>Module = atom()</v> - </type> <desc> - <p>Purges the code for <c>Module</c>, that is, removes code + <p>Purges the code for <c><anno>Module</anno></c>, that is, removes code marked as old. If some processes still linger in the old code, these processes are killed before the code is removed.</p> <p>Returns <c>true</c> if successful and any process needed to @@ -542,31 +493,26 @@ </desc> </func> <func> - <name>soft_purge(Module) -> true | false</name> + <name name="soft_purge" arity="1"/> <fsummary>Removes old code for a module, unless no process uses it</fsummary> - <type> - <v>Module = atom()</v> - </type> <desc> - <p>Purges the code for <c>Module</c>, that is, removes code + <p>Purges the code for <c><anno>Module</anno></c>, that is, removes code marked as old, but only if no processes linger in it.</p> <p>Returns <c>false</c> if the module could not be purged due to processes lingering in old code, otherwise <c>true</c>.</p> </desc> </func> <func> - <name>is_loaded(Module) -> {file, Loaded} | false</name> + <name name="is_loaded" arity="1"/> <fsummary>Check if a module is loaded</fsummary> - <type> - <v>Module = atom()</v> - <v>Loaded = Absname | preloaded | cover_compiled</v> - <v>Absname = string()</v> - </type> - <desc> - <p>Checks if <c>Module</c> is loaded. If it is, - <c>{file, Loaded}</c> is returned, otherwise <c>false</c>.</p> - <p>Normally, <c>Loaded</c> is the absolute file name - <c>Absname</c> from which the code was obtained. If the module + <type name="loaded_filename"/> + <type name="loaded_ret_atoms"/> + <type_desc name="loaded_filename"><c><anno>Filename</anno></c> is an absolute filename</type_desc> + <desc> + <p>Checks if <c><anno>Module</anno></c> is loaded. If it is, + <c>{file, <anno>Loaded</anno>}</c> is returned, otherwise <c>false</c>.</p> + <p>Normally, <c><anno>Loaded</anno></c> is the absolute file name + <c>Filename</c> from which the code was obtained. If the module is preloaded (see <seealso marker="sasl:script">script(4)</seealso>), <c>Loaded==preloaded</c>. If the module is Cover compiled (see @@ -575,32 +521,26 @@ </desc> </func> <func> - <name>all_loaded() -> [{Module, Loaded}]</name> + <name name="all_loaded" arity="0"/> <fsummary>Get all loaded modules</fsummary> - <type> - <v>Module = atom()</v> - <v>Loaded = Absname | preloaded | cover_compiled</v> - <v>Absname = string()</v> - </type> + <type name="loaded_filename"/> + <type name="loaded_ret_atoms"/> + <type_desc name="loaded_filename"><c><anno>Filename</anno></c> is an absolute filename</type_desc> <desc> - <p>Returns a list of tuples <c>{Module, Loaded}</c> for all - loaded modules. <c>Loaded</c> is normally the absolute file + <p>Returns a list of tuples <c>{<anno>Module</anno>, <anno>Loaded</anno>}</c> for all + loaded modules. <c><anno>Loaded</anno></c> is normally the absolute file name, as described for <seealso marker="#is_loaded/1">is_loaded/1</seealso>.</p> </desc> </func> <func> - <name>which(Module) -> Which</name> + <name name="which" arity="1"/> <fsummary>The object code file of a module</fsummary> - <type> - <v>Module = atom()</v> - <v>Which = Filename | non_existing | preloaded | cover_compiled</v> - <v>Filename = string()</v> - </type> + <type name="loaded_ret_atoms"/> <desc> <p>If the module is not loaded, this function searches the code path for the first file which contains object code for - <c>Module</c> and returns the absolute file name. If + <c><anno>Module</anno></c> and returns the absolute file name. If the module is loaded, it returns the name of the file which contained the loaded object code. If the module is pre-loaded, <c>preloaded</c> is returned. If the module is Cover compiled, @@ -609,21 +549,16 @@ </desc> </func> <func> - <name>get_object_code(Module) -> {Module, Binary, Filename} | error</name> + <name name="get_object_code" arity="1"/> <fsummary>Get the object code for a module</fsummary> - <type> - <v>Module = atom()</v> - <v>Binary = binary()</v> - <v>Filename = string()</v> - </type> <desc> <p>Searches the code path for the object code of the module - <c>Module</c>. It returns <c>{Module, Binary, Filename}</c> - if successful, and <c>error</c> if not. <c>Binary</c> is a + <c><anno>Module</anno></c>. It returns <c>{<anno>Module</anno>, <anno>Binary</anno>, <anno>Filename</anno>}</c> + if successful, and <c>error</c> if not. <c><anno>Binary</anno></c> is a binary data object which contains the object code for the module. This can be useful if code is to be loaded on a remote node in a distributed system. For example, loading - module <c>Module</c> on a node <c>Node</c> is done as + module <c><anno>Module</anno></c> on a node <c>Node</c> is done as follows:</p> <code type="none"> ... @@ -633,7 +568,7 @@ rpc:call(Node, code, load_binary, [Module, Filename, Binary]), </desc> </func> <func> - <name>root_dir() -> string()</name> + <name name="root_dir" arity="0"/> <fsummary>Root directory of Erlang/OTP</fsummary> <desc> <p>Returns the root directory of Erlang/OTP, which is @@ -644,7 +579,7 @@ rpc:call(Node, code, load_binary, [Module, Filename, Binary]), </desc> </func> <func> - <name>lib_dir() -> string()</name> + <name name="lib_dir" arity="0"/> <fsummary>Library directory of Erlang/OTP</fsummary> <desc> <p>Returns the library directory, <c>$OTPROOT/lib</c>, where @@ -655,19 +590,16 @@ rpc:call(Node, code, load_binary, [Module, Filename, Binary]), </desc> </func> <func> - <name>lib_dir(Name) -> string() | {error, bad_name}</name> + <name name="lib_dir" arity="1"/> <fsummary>Library directory for an application</fsummary> - <type> - <v>Name = atom()</v> - </type> <desc> <p>This function is mainly intended for finding out the path for the "library directory", the top directory, for an - application <c>Name</c> located under <c>$OTPROOT/lib</c> or + application <c><anno>Name</anno></c> located under <c>$OTPROOT/lib</c> or on a directory referred to via the <c>ERL_LIBS</c> environment variable.</p> - <p>If there is a regular directory called <c>Name</c> or - <c>Name-Vsn</c> in the code path with an <c>ebin</c> + <p>If there is a regular directory called <c><anno>Name</anno></c> or + <c><anno>Name</anno>-Vsn</c> in the code path with an <c>ebin</c> subdirectory, the path to this directory is returned (not the <c>ebin</c> directory). If the directory refers to a directory in an archive, the archive name is stripped away @@ -681,23 +613,19 @@ rpc:call(Node, code, load_binary, [Module, Filename, Binary]), <pre> > <input>code:lib_dir(mnesia).</input> "/usr/local/otp/lib/mnesia-4.2.2"</pre> - <p>Returns <c>{error, bad_name}</c> if <c>Name</c> + <p>Returns <c>{error, bad_name}</c> if <c><anno>Name</anno></c> is not the name of an application under <c>$OTPROOT/lib</c> or on a directory referred to via the <c>ERL_LIBS</c> environment variable. Fails with an exception if <c>Name</c> has the wrong type.</p> - <warning><p>For backward compatibility, <c>Name</c> is also allowed to + <warning><p>For backward compatibility, <c><anno>Name</anno></c> is also allowed to be a string. That will probably change in a future release.</p></warning> </desc> </func> <func> - <name>lib_dir(Name, SubDir) -> string() | {error, bad_name}</name> + <name name="lib_dir" arity="2"/> <fsummary>subdirectory for an application</fsummary> - <type> - <v>Name = atom()</v> - <v>SubDir = atom()</v> - </type> <desc> <p>Returns the path to a subdirectory directly under the top directory of an application. Normally the subdirectories @@ -711,12 +639,12 @@ rpc:call(Node, code, load_binary, [Module, Filename, Binary]), > <input>code:lib_dir(megaco, priv).</input> "/usr/local/otp/lib/megaco-3.9.1.1/priv"</pre> - <p>Fails with an exception if <c>Name</c> or <c>SubDir</c> has + <p>Fails with an exception if <c><anno>Name</anno></c> or <c><anno>SubDir</anno></c> has the wrong type.</p> </desc> </func> <func> - <name>compiler_dir() -> string()</name> + <name name="compiler_dir" arity="0"/> <fsummary>Library directory for the compiler</fsummary> <desc> <p>Returns the compiler library directory. Equivalent to @@ -724,21 +652,18 @@ rpc:call(Node, code, load_binary, [Module, Filename, Binary]), </desc> </func> <func> - <name>priv_dir(Name) -> string() | {error, bad_name}</name> + <name name="priv_dir" arity="1"/> <fsummary>Priv directory for an application</fsummary> - <type> - <v>Name = atom()</v> - </type> <desc> <p>Returns the path to the <c>priv</c> directory in an - application. Equivalent to <c>code:lib_dir(Name,priv).</c>.</p> + application. Equivalent to <c>code:lib_dir(<anno>Name</anno>, priv).</c>.</p> - <warning><p>For backward compatibility, <c>Name</c> is also allowed to + <warning><p>For backward compatibility, <c><anno>Name</anno></c> is also allowed to be a string. That will probably change in a future release.</p></warning> </desc> </func> <func> - <name>objfile_extension() -> ".beam"</name> + <name name="objfile_extension" arity="0"/> <fsummary>Object code file extension</fsummary> <desc> <p>Returns the object code file extension that corresponds to @@ -746,24 +671,16 @@ rpc:call(Node, code, load_binary, [Module, Filename, Binary]), </desc> </func> <func> - <name>stick_dir(Dir) -> ok | error</name> + <name name="stick_dir" arity="1"/> <fsummary>Mark a directory as sticky</fsummary> - <type> - <v>Dir = string()</v> - <v>What = term()</v> - </type> <desc> - <p>This function marks <c>Dir</c> as sticky.</p> + <p>This function marks <c><anno>Dir</anno></c> as sticky.</p> <p>Returns <c>ok</c> if successful or <c>error</c> if not.</p> </desc> </func> <func> - <name>unstick_dir(Dir) -> ok | error</name> + <name name="unstick_dir" arity="1"/> <fsummary>Remove a sticky directory mark</fsummary> - <type> - <v>Dir = string()</v> - <v>What = term()</v> - </type> <desc> <p>This function unsticks a directory which has been marked as sticky.</p> @@ -771,45 +688,39 @@ rpc:call(Node, code, load_binary, [Module, Filename, Binary]), </desc> </func> <func> - <name>is_sticky(Module) -> true | false</name> + <name name="is_sticky" arity="1"/> <fsummary>Test whether a module is sticky</fsummary> - <type> - <v>Module = atom()</v> - </type> <desc> - <p>This function returns <c>true</c> if <c>Module</c> is the + <p>This function returns <c>true</c> if <c><anno>Module</anno></c> is the name of a module that has been loaded from a sticky directory (or in other words: an attempt to reload the module will fail), - or <c>false</c> if <c>Module</c> is not a loaded module or is + or <c>false</c> if <c><anno>Module</anno></c> is not a loaded module or is not sticky.</p> </desc> </func> <func> - <name>rehash() -> ok</name> + <name name="rehash" arity="0"/> <fsummary>Rehash or create code path cache</fsummary> <desc> <p>This function creates or rehashes the code path cache.</p> </desc> </func> <func> - <name>where_is_file(Filename) -> Absname | non_existing</name> + <name name="where_is_file" arity="1"/> <fsummary>Full name of a file located in the code path</fsummary> - <type> - <v>Filename = Absname = string()</v> - </type> <desc> - <p>Searches the code path for <c>Filename</c>, a file of + <p>Searches the code path for <c><anno>Filename</anno></c>, a file of arbitrary type. If found, the full name is returned. <c>non_existing</c> is returned if the file cannot be found. The function can be useful, for example, to locate application resource files. If the code path cache is used, the code server will efficiently read the full name from - the cache, provided that <c>Filename</c> is an object code + the cache, provided that <c><anno>Filename</anno></c> is an object code file or an <c>.app</c> file.</p> </desc> </func> <func> - <name>clash() -> ok</name> + <name name="clash" arity="0"/> <fsummary>Search for modules with identical names.</fsummary> <desc> <p>Searches the entire code space for module names with @@ -817,10 +728,10 @@ rpc:call(Node, code, load_binary, [Module, Filename, Binary]), </desc> </func> <func> - <name>is_module_native(Module) -> true | false | undefined</name> + <name>is_module_native(Module) -> boolean() | undefined</name> <fsummary>Test whether a module has native code</fsummary> <type> - <v>Module = atom()</v> + <v>Module = module()</v> </type> <desc> <p>This function returns <c>true</c> if <c>Module</c> is diff --git a/lib/kernel/doc/src/file.xml b/lib/kernel/doc/src/file.xml index e0feaf6ee7..861c582211 100644 --- a/lib/kernel/doc/src/file.xml +++ b/lib/kernel/doc/src/file.xml @@ -95,9 +95,6 @@ <datatypes> <datatype> - <name name="bindings"/> - </datatype> - <datatype> <name name="deep_list"/> </datatype> <datatype> @@ -136,12 +133,6 @@ </desc> </datatype> <datatype> - <name name="date"/> - </datatype> - <datatype> - <name name="time"/> - </datatype> - <datatype> <name name="date_time"/> <desc> <p>Must denote a valid date and time.</p> @@ -1220,15 +1211,15 @@ f.txt: {person, "kalle", 25}. <item> <p>The current system access to the file.</p> </item> - <tag><c>atime = time()</c></tag> + <tag><c>atime = <seealso marker="#type-date_time">date_time()</seealso></c></tag> <item> <p>The last (local) time the file was read.</p> </item> - <tag><c>mtime = time()</c></tag> + <tag><c>mtime = <seealso marker="#type-date_time">date_time()</seealso></c></tag> <item> <p>The last (local) time the file was written.</p> </item> - <tag><c>ctime = time()</c></tag> + <tag><c>ctime = <seealso marker="#type-date_time">date_time()</seealso></c></tag> <item> <p>The interpretation of this time field depends on the operating system. On Unix, it is the last time @@ -1669,15 +1660,15 @@ f.txt: {person, "kalle", 25}. <p>The following fields are used from the record, if they are given.</p> <taglist> - <tag><c>atime = time()</c></tag> + <tag><c>atime = <seealso marker="#type-date_time">date_time()</seealso></c></tag> <item> <p>The last (local) time the file was read.</p> </item> - <tag><c>mtime = time()</c></tag> + <tag><c>mtime = <seealso marker="#type-date_time">date_time()</seealso></c></tag> <item> <p>The last (local) time the file was written.</p> </item> - <tag><c>ctime = time()</c></tag> + <tag><c>ctime = <seealso marker="#type-date_time">date_time()</seealso></c></tag> <item> <p>On Unix, any value give for this field will be ignored (the "ctime" for the file will be set to the current diff --git a/lib/kernel/doc/src/gen_sctp.xml b/lib/kernel/doc/src/gen_sctp.xml index 5ceb82ae41..cc49090386 100644 --- a/lib/kernel/doc/src/gen_sctp.xml +++ b/lib/kernel/doc/src/gen_sctp.xml @@ -63,14 +63,13 @@ <item><seealso marker="#options">SCTP SOCKET OPTIONS</seealso></item> <item><seealso marker="#examples">SCTP EXAMPLES</seealso></item> <item><seealso marker="#seealso">SEE ALSO</seealso></item> - <item><seealso marker="#authors">AUTHORS</seealso></item> </list> <marker id="types"></marker> </section> <datatypes> <datatype> - <name name="assoc_id"/> + <name><marker id="type-assoc_id">assoc_id()</marker></name> <desc> <p>An opaque term returned in for example #sctp_paddr_change{} that identifies an association for an SCTP socket. The term @@ -80,36 +79,18 @@ </desc> </datatype> <datatype> - <name name="hostname"/> - </datatype> - <datatype> - <name name="ip_address"/> - <desc> - <p>Represents an address of an SCTP socket. - It is a tuple as explained in - <seealso marker="inet">inet(3)</seealso>.</p> - </desc> - </datatype> - <datatype> - <name name="port_number"/> - </datatype> - <datatype> - <name name="posix"/> - <desc> - <p>See <seealso marker="inet#error_codes"> - inet(3); POSIX Error Codes</seealso>.</p> - </desc> - </datatype> - <datatype> - <name name="sctp_option"/> + <name name="option"/> <desc> <p>One of the <seealso marker="#options">SCTP Socket Options.</seealso></p> - <marker id="type-sctp_socket"></marker> </desc> </datatype> <datatype> - <name name="sctp_socket"/> + <name name="option_name"/> + <desc><marker id="type-sctp_socket"></marker></desc> + </datatype> + <datatype> + <name><marker id="type-sctp_socket">sctp_socket()</marker></name> <desc> <p>Socket identifier returned from <c>open/*</c>.</p> <marker id="exports"></marker> @@ -175,8 +156,8 @@ #sctp_assoc_change{ state = atom(), error = atom(), - outbound_streams = int(), - inbound_streams = int(), + outbound_streams = integer(), + inbound_streams = integer(), assoc_id = assoc_id() } </pre> <p>The number of outbound and inbound streams can be set by @@ -300,6 +281,19 @@ The default <c><anno>IP</anno></c> and <c><anno>Port</anno></c> are <c>any</c> and <c>0</c>, meaning bind to all local addresses on any one free port.</p> + + <p>Other options are:</p> + <taglist> + <tag><c>inet6</c></tag> + <item> + <p>Set up the socket for IPv6.</p> + </item> + <tag><c>inet</c></tag> + <item> + <p>Set up the socket for IPv4. This is the default.</p> + </item> + </taglist> + <p>A default set of socket <seealso marker="#options">options</seealso> is used. In particular, the socket is opened in <seealso marker="#option-binary">binary</seealso> and @@ -350,7 +344,7 @@ #sctp_paddr_change{ addr = {ip_address(),port()}, state = atom(), - error = int(), + error = integer(), assoc_id = assoc_id() } </pre> <p>Indicates change of the status of the peer's IP address given by @@ -387,7 +381,7 @@ <pre> #sctp_send_failed{ flags = true | false, - error = int(), + error = integer(), info = #sctp_sndrcvinfo{}, assoc_id = assoc_id() data = binary() @@ -407,7 +401,7 @@ <item> <pre> #sctp_adaptation_event{ - adaptation_ind = int(), + adaptation_ind = integer(), assoc_id = assoc_id() } </pre> <p>Delivered when a peer sends an Adaptation Layer Indication @@ -505,7 +499,7 @@ </list> <marker id="option-buffer"></marker> </item> - <tag><c>{buffer, int()}</c></tag> + <tag><c>{buffer, integer()}</c></tag> <item> <p>Determines the size of the user-level software buffer used by the SCTP driver. Not to be confused with <c>sndbuf</c> @@ -515,7 +509,7 @@ In fact, the <c>val(buffer)</c> is automatically set to the above maximum when <c>sndbuf</c> or <c>recbuf</c> values are set.</p> </item> - <tag><c>{tos, int()}</c></tag> + <tag><c>{tos, integer()}</c></tag> <item> <p>Sets the Type-Of-Service field on the IP datagrams being sent, to the given value, which effectively determines a prioritization @@ -523,7 +517,7 @@ are system-dependent. TODO: we do not provide symbolic names for these values yet.</p> </item> - <tag><c>{priority, int()}</c></tag> + <tag><c>{priority, integer()}</c></tag> <item> <p>A protocol-independent equivalent of <c>tos</c> above. Setting priority implies setting tos as well.</p> @@ -542,7 +536,7 @@ required for high-throughput servers).</p> <marker id="option-linger"></marker> </item> - <tag><c>{linger, {true|false, int()}</c></tag> + <tag><c>{linger, {true|false, integer()}</c></tag> <item> <p>Determines the timeout in seconds for flushing unsent data in the <c>gen_sctp:close/1</c> socket call. If the 1st component of the value @@ -552,14 +546,14 @@ the flushing time-out in seconds.</p> <marker id="option-sndbuf"></marker> </item> - <tag><c>{sndbuf, int()}</c></tag> + <tag><c>{sndbuf, integer()}</c></tag> <item> <p>The size, in bytes, of the *kernel* send buffer for this socket. Sending errors would occur for datagrams larger than <c>val(sndbuf)</c>. Setting this option also adjusts the size of the driver buffer (see <c>buffer</c> above).</p> </item> - <tag><c>{recbuf, int()}</c></tag> + <tag><c>{recbuf, integer()}</c></tag> <item> <p>The size, in bytes, of the *kernel* recv buffer for this socket. Sending errors would occur for datagrams larger than @@ -571,9 +565,9 @@ <pre> #sctp_rtoinfo{ assoc_id = assoc_id(), - initial = int(), - max = int(), - min = int() + initial = integer(), + max = integer(), + min = integer() } </pre> <p>Determines re-transmission time-out parameters, in milliseconds, for the association(s) given by <c>assoc_id</c>. @@ -586,11 +580,11 @@ <pre> #sctp_assocparams{ assoc_id = assoc_id(), - asocmaxrxt = int(), - number_peer_destinations = int(), - peer_rwnd = int(), - local_rwnd = int(), - cookie_life = int() + asocmaxrxt = integer(), + number_peer_destinations = integer(), + peer_rwnd = integer(), + local_rwnd = integer(), + cookie_life = integer() } </pre> <p>Determines association parameters for the association(s) given by <c>assoc_id</c>. <c>assoc_id = 0</c> (default) indicates @@ -601,10 +595,10 @@ <item> <pre> #sctp_initmsg{ - num_ostreams = int(), - max_instreams = int(), - max_attempts = int(), - max_init_timeo = int() + num_ostreams = integer(), + max_instreams = integer(), + max_attempts = integer(), + max_init_timeo = integer() } </pre> <p>Determines the default parameters which this socket attempts to negotiate with its peer while establishing an association with it. @@ -630,10 +624,11 @@ </list> <p></p> </item> - <tag><c>{sctp_autoclose, int()|infinity}</c></tag> + <tag><c>{sctp_autoclose, integer() >= 0}</c></tag> <item> <p>Determines the time (in seconds) after which an idle association is - automatically closed.</p> + automatically closed. <c>0</c> means that the association is + never automatically closed.</p> </item> <tag><c>{sctp_nodelay, true|false}</c></tag> <item> @@ -655,7 +650,7 @@ <p>Turns on|off automatic mapping of IPv4 addresses into IPv6 ones (if the socket address family is AF_INET6).</p> </item> - <tag><c>{sctp_maxseg, int()}</c></tag> + <tag><c>{sctp_maxseg, integer()}</c></tag> <item> <p>Determines the maximum chunk size if message fragmentation is used. If <c>0</c>, the chunk size is limited by the Path MTU only.</p> @@ -693,7 +688,7 @@ <marker id="record-sctp_setadaptation"></marker> <pre> #sctp_setadaptation{ - adaptation_ind = int() + adaptation_ind = integer() } </pre> <p>When set, requests that the local endpoint uses the value given by <c>adaptation_ind</c> as the Adaptation Indication parameter for @@ -707,10 +702,10 @@ #sctp_paddrparams{ assoc_id = assoc_id(), address = {IP, Port}, - hbinterval = int(), - pathmaxrxt = int(), - pathmtu = int(), - sackdelay = int(), + hbinterval = integer(), + pathmaxrxt = integer(), + pathmtu = integer(), + sackdelay = integer(), flags = list() } IP = ip_address() @@ -771,14 +766,14 @@ <marker id="record-sctp_sndrcvinfo"></marker> <pre> #sctp_sndrcvinfo{ - stream = int(), - ssn = int(), + stream = integer(), + ssn = integer(), flags = list(), - ppid = int(), - context = int(), - timetolive = int(), - tsn = int(), - cumtsn = int(), + ppid = integer(), + context = integer(), + timetolive = integer(), + tsn = integer(), + cumtsn = integer(), assoc_id = assoc_id() } </pre> <p><c>#sctp_sndrcvinfo{}</c> is used both in this socket option, and as @@ -853,7 +848,7 @@ <pre> #sctp_assoc_value{ assoc_id = assoc_id(), - assoc_value = int() + assoc_value = integer() } </pre> <p>Rarely used. Determines the ACK time (given by <c>assoc_value</c> in milliseconds) for @@ -866,12 +861,12 @@ #sctp_status{ assoc_id = assoc_id(), state = atom(), - rwnd = int(), - unackdata = int(), - penddata = int(), - instrms = int(), - outstrms = int(), - fragmentation_point = int(), + rwnd = integer(), + unackdata = integer(), + penddata = integer(), + instrms = integer(), + outstrms = integer(), + fragmentation_point = integer(), primary = #sctp_paddrinfo{} } </pre> <p>This option is read-only. It determines the status of @@ -946,10 +941,10 @@ assoc_id = assoc_id(), address = {IP, Port}, state = inactive | active, - cwnd = int(), - srtt = int(), - rto = int(), - mtu = int() + cwnd = integer(), + srtt = integer(), + rto = integer(), + mtu = integer() } IP = ip_address() Port = port_number() </pre> @@ -990,7 +985,7 @@ server(IP, Port) when is_tuple(IP) orelse IP == any orelse IP == loopback, is_integer(Port) -> - {ok,S} = gen_sctp:open([{ip,IP},{port,Port}],[{recbuf,65536}]), + {ok,S} = gen_sctp:open(Port, [{recbuf,65536}, {ip,IP}]), io:format("Listening on ~w:~w. ~w~n", [IP,Port,S]), ok = gen_sctp:listen(S, true), server_loop(S). @@ -1119,7 +1114,6 @@ client_loop(S, Peer1, Port1, AssocId1, Peer2, Port2, AssocId2) -> <seealso marker="gen_udp">gen_udp(3)</seealso>, <url href="http://www.rfc-archive.org/getrfc.php?rfc=2960">RFC2960</url> (Stream Control Transmission Protocol), <url href="http://tools.ietf.org/html/draft-ietf-tsvwg-sctpsocket-13">Sockets API Extensions for SCTP.</url></p> - <marker id="authors"></marker> </section> </erlref> diff --git a/lib/kernel/doc/src/gen_tcp.xml b/lib/kernel/doc/src/gen_tcp.xml index f1d42d9faa..8a5d40bb16 100644 --- a/lib/kernel/doc/src/gen_tcp.xml +++ b/lib/kernel/doc/src/gen_tcp.xml @@ -37,7 +37,7 @@ binary and closing the connection:</p> <code type="none"> client() -> - SomeHostInNet = "localhost" % to make it runnable on one machine + SomeHostInNet = "localhost", % to make it runnable on one machine {ok, Sock} = gen_tcp:connect(SomeHostInNet, 5678, [binary, {packet, 0}]), ok = gen_tcp:send(Sock, "Some Data"), @@ -65,25 +65,16 @@ do_recv(Sock, Bs) -> <datatypes> <datatype> - <name name="hostname"/> + <name name="option"/> </datatype> <datatype> - <name name="ip_address"/> - <desc> - <p>Represents an address of a TCP socket. - It is a tuple as explained in - <seealso marker="inet">inet(3)</seealso>.</p> - </desc> + <name name="option_name"/> </datatype> <datatype> - <name name="port_number"/> + <name name="connect_option"/> </datatype> <datatype> - <name name="posix"/> - <desc> - <p>See <seealso marker="inet#error_codes"> - inet(3); POSIX Error Codes</seealso>.</p> - </desc> + <name name="listen_option"/> </datatype> <datatype> <name><marker id="type-socket">socket()</marker></name> @@ -122,7 +113,7 @@ do_recv(Sock, Bs) -> <item> <p>Specify which local port number to use.</p> </item> - <tag><c>{fd, int()}</c></tag> + <tag><c>{fd, integer() >= 0}</c></tag> <item> <p>If a socket has somehow been connected without using <c>gen_tcp</c>, use this option to pass the file @@ -196,6 +187,10 @@ do_recv(Sock, Bs) -> <p>If the host has several network interfaces, this option specifies which one to listen on.</p> </item> + <tag><c>{port, Port}</c></tag> + <item> + <p>Specify which local port number to use.</p> + </item> <tag><c>{fd, Fd}</c></tag> <item> <p>If a socket has somehow been connected without using diff --git a/lib/kernel/doc/src/gen_udp.xml b/lib/kernel/doc/src/gen_udp.xml index c0e783f508..daa9b7d887 100644 --- a/lib/kernel/doc/src/gen_udp.xml +++ b/lib/kernel/doc/src/gen_udp.xml @@ -36,25 +36,10 @@ <datatypes> <datatype> - <name name="hostname"/> + <name name="option"/> </datatype> <datatype> - <name name="ip_address"/> - <desc> - <p>Represents an address of a TCP socket. - It is a tuple as explained in - <seealso marker="inet">inet(3)</seealso>.</p> - </desc> - </datatype> - <datatype> - <name name="port_number"/> - </datatype> - <datatype> - <name name="posix"/> - <desc> - <p>See <seealso marker="inet#error_codes"> - inet(3); POSIX Error Codes</seealso>.</p> - </desc> + <name name="option_name"/> </datatype> <datatype> <name><marker id="type-socket">socket()</marker></name> @@ -87,7 +72,7 @@ <p>If the host has several network interfaces, this option specifies which one to use.</p> </item> - <tag><c>{fd, int()}</c></tag> + <tag><c>{fd, integer() >= 0}</c></tag> <item> <p>If a socket has somehow been opened without using <c>gen_udp</c>, use this option to pass the file diff --git a/lib/kernel/doc/src/inet.xml b/lib/kernel/doc/src/inet.xml index fd843b00d9..fad5af85bb 100644 --- a/lib/kernel/doc/src/inet.xml +++ b/lib/kernel/doc/src/inet.xml @@ -105,6 +105,9 @@ fe80::204:acff:fe17:bf38 <name name="ip6_address"/> </datatype> <datatype> + <name name="port_number"/> + </datatype> + <datatype> <name name="posix"/> <desc><p>An atom which is named from the Posix error codes used in Unix, and in the runtime libraries of most @@ -119,7 +122,7 @@ fe80::204:acff:fe17:bf38 </desc> </datatype> <datatype> - <name name="family_option"/> + <name name="address_family"/> </datatype> </datatypes> @@ -250,26 +253,15 @@ fe80::204:acff:fe17:bf38 </func> <func> - <name>getopts(Socket, Options) -> {ok, OptionValues} | {error, posix()}</name> + <name name="getopts" arity="2"/> <fsummary>Get one or more options for a socket</fsummary> - <type> - <v>Socket = term()</v> - <v>Options = [Opt | RawOptReq]</v> - <v>Opt = atom()</v> - <v>RawOptReq = {raw, Protocol, OptionNum, ValueSpec}</v> - <v>Protocol = integer()</v> - <v>OptionNum = integer()</v> - <v>ValueSpec = ValueSize | ValueBin</v> - <v>ValueSize = integer()</v> - <v>ValueBin = binary()</v> - <v>OptionValues = [{Opt, Val} | {raw, Protocol, OptionNum, ValueBin}]</v> - </type> <type name="socket_getopt"/> + <type name="socket_setopt"/> <desc> <p>Gets one or more options for a socket. See <seealso marker="#setopts/2">setopts/2</seealso> for a list of available options.</p> - <p>The number of elements in the returned <c>OptionValues</c> + <p>The number of elements in the returned <c><anno>OptionValues</anno></c> list does not necessarily correspond to the number of options asked for. If the operating system fails to support an option, it is simply left out in the returned list. An error tuple is only @@ -277,12 +269,12 @@ fe80::204:acff:fe17:bf38 (i.e. the socket is closed or the buffer size in a raw request is too large). This behavior is kept for backward compatibility reasons.</p> - <p>A <c>RawOptReq</c> can be used to get information about + <p>A raw option request <c>RawOptReq = {raw, Protocol, OptionNum, ValueSpec}</c> can be used to get information about socket options not (explicitly) supported by the emulator. The use of raw socket options makes the code non portable, but allows the Erlang programmer to take advantage of unusual features present on the current platform.</p> - <p>The <c>RawOptReq</c> consists of the tag <c>raw</c> followed + <p>The <c>RawOptReq</c> consists of the tag <c>raw</c> followed by the protocol level, the option number and either a binary or the size, in bytes, of the buffer in which the option value is to be stored. A binary @@ -325,19 +317,14 @@ fe80::204:acff:fe17:bf38 </func> <func> - <name>getstat(Socket)</name> - <name>getstat(Socket, Options) -> {ok, OptionValues} | {error, posix()}</name> + <name name="getstat" arity="1"/> + <name name="getstat" arity="2"/> <fsummary>Get one or more statistic options for a socket</fsummary> - <type> - <v>Socket = term()</v> - <v>Options = [Opt]</v> - <v>OptionValues = [{Opt, Val}]</v> - <v> Opt, Val -- see below</v> - </type> + <type name="stat_option"/> <desc> <p>Gets one or more statistic options for a socket.</p> - <p><c>getstat(Socket)</c> is equivalent to - <c>getstat(Socket, [recv_avg, recv_cnt, recv_dvi, recv_max, recv_oct, send_avg, send_cnt, send_dvi, send_max, send_oct])</c></p> + <p><c>getstat(<anno>Socket</anno>)</c> is equivalent to + <c>getstat(<anno>Socket</anno>, [recv_avg, recv_cnt, recv_dvi, recv_max, recv_oct, send_avg, send_cnt, send_dvi, send_max, send_oct])</c></p> <p>The following options are available:</p> <taglist> <tag><c>recv_avg</c></tag> @@ -394,12 +381,8 @@ fe80::204:acff:fe17:bf38 </desc> </func> <func> - <name>port(Socket) -> {ok, Port} | {error, any()}</name> + <name name="port" arity="1"/> <fsummary>Return the local port number for a socket</fsummary> - <type> - <v>Socket = socket()</v> - <v>Port = integer()</v> - </type> <desc> <p>Returns the local port number for a socket.</p> </desc> @@ -412,16 +395,9 @@ fe80::204:acff:fe17:bf38 </desc> </func> <func> - <name>setopts(Socket, Options) -> ok | {error, posix()}</name> + <name name="setopts" arity="2"/> <fsummary>Set one or more options for a socket</fsummary> - <type> - <v>Socket = term()</v> - <v>Options = [{Opt, Val} | {raw, Protocol, Option, ValueBin}]</v> - <v>Protocol = integer()</v> - <v>OptionNum = integer()</v> - <v>ValueBin = binary()</v> - <v> Opt, Val -- see below</v> - </type> + <type name="socket_setopt"/> <desc> <p>Sets one or more options for a socket. The following options are available:</p> @@ -579,8 +555,14 @@ fe80::204:acff:fe17:bf38 mode will return <c>{ok, HttpPacket}</c> from <c>gen_tcp:recv</c> while an active socket will send messages like <c>{http, Socket, HttpPacket}</c>.</p> - <p>Note that the packet type <c>httph</c> is not - needed when reading from a socket.</p> + </item> + <tag><c>httph | httph_bin</c></tag> + <item> + <p>These two types are often not needed as the socket will + automatically switch from <c>http</c>/<c>http_bin</c> to + <c>httph</c>/<c>httph_bin</c> internally after the first line + has been read. There might be occasions however when they are + useful, such as parsing trailers from chunked encoding.</p> </item> </taglist> </item> diff --git a/lib/kernel/doc/src/os.xml b/lib/kernel/doc/src/os.xml index 56fc1834ec..e94119845a 100644 --- a/lib/kernel/doc/src/os.xml +++ b/lib/kernel/doc/src/os.xml @@ -126,9 +126,10 @@ DirOut = os:cmd("dir"), % on Win32 platform</code> </desc> </func> <func> - <name>timestamp() -> {MegaSecs, Secs, MicroSecs}</name> + <name>timestamp() -> Timestamp</name> <fsummary>Returna a timestamp from the OS in the erlang:now/0 format</fsummary> <type> + <v>Timestamp = {MegaSecs, Secs, MicroSecs} = <seealso marker="erts:erlang#type-timestamp">erlang:timestamp()</seealso></v> <v>MegaSecs = Secs = MicroSecs = integer() >= 0</v> </type> <desc> diff --git a/lib/kernel/src/auth.erl b/lib/kernel/src/auth.erl index 25c88a4e1d..ac25ab958c 100644 --- a/lib/kernel/src/auth.erl +++ b/lib/kernel/src/auth.erl @@ -58,7 +58,7 @@ start_link() -> %%--Deprecated interface------------------------------------------------ -spec is_auth(Node) -> 'yes' | 'no' when - Node :: Node :: node(). + Node :: node(). is_auth(Node) -> case net_adm:ping(Node) of diff --git a/lib/kernel/src/code.erl b/lib/kernel/src/code.erl index b0f99305f2..882e9625fe 100644 --- a/lib/kernel/src/code.erl +++ b/lib/kernel/src/code.erl @@ -82,7 +82,8 @@ %% add_pathsa([Dir]) -> ok %% add_pathsz([Dir]) -> ok %% del_path(Dir) -> boolean() | {error, bad_name} -%% replace_path(Name, Dir) -> true | replace_path_error() +%% replace_path(Name, Dir) -> true | {error, bad_directory | bad_name +%% | {badarg,_}} %% load_file(Module) -> {module, Module} | {error, What :: atom()} %% load_abs(File) -> {module, Module} | {error, What :: atom()} %% load_abs(File, Module) -> {module, Module} | {error, What :: atom()} @@ -113,11 +114,16 @@ %% Some types for basic exported functions of this module %%---------------------------------------------------------------------------- --type load_error_rsn() :: 'badfile' | 'native_code' | 'nofile' | 'not_purged' - | 'sticky_directory'. % for some functions only --type load_ret() :: {'error', load_error_rsn()} | {'module', atom()}. +-type load_error_rsn() :: 'badfile' + | 'native_code' + | 'nofile' + | 'not_purged' + | 'on_load' + | 'sticky_directory'. +-type load_ret() :: {'error', What :: load_error_rsn()} + | {'module', Module :: module()}. -type loaded_ret_atoms() :: 'cover_compiled' | 'preloaded'. --type loaded_filename() :: file:filename() | loaded_ret_atoms(). +-type loaded_filename() :: (Filename :: file:filename()) | loaded_ret_atoms(). %%---------------------------------------------------------------------------- %% User interface @@ -127,55 +133,74 @@ objfile_extension() -> init:objfile_extension(). --spec load_file(Module :: atom()) -> load_ret(). +-spec load_file(Module) -> load_ret() when + Module :: module(). load_file(Mod) when is_atom(Mod) -> call({load_file,Mod}). --spec ensure_loaded(Module :: atom()) -> load_ret(). +-spec ensure_loaded(Module) -> {module, Module} | {error, What} when + Module :: module(), + What :: embedded | badfile | native_code | nofile | on_load. ensure_loaded(Mod) when is_atom(Mod) -> call({ensure_loaded,Mod}). %% XXX File as an atom is allowed only for backwards compatibility. --spec load_abs(Filename :: file:filename()) -> load_ret(). +-spec load_abs(Filename) -> load_ret() when + Filename :: file:filename(). load_abs(File) when is_list(File); is_atom(File) -> call({load_abs,File,[]}). %% XXX Filename is also an atom(), e.g. 'cover_compiled' --spec load_abs(Filename :: loaded_filename(), Module :: atom()) -> load_ret(). +-spec load_abs(Filename :: loaded_filename(), Module :: module()) -> load_ret(). load_abs(File, M) when (is_list(File) orelse is_atom(File)), is_atom(M) -> call({load_abs,File,M}). %% XXX Filename is also an atom(), e.g. 'cover_compiled' --spec load_binary(Module :: atom(), Filename :: loaded_filename(), Binary :: binary()) -> load_ret(). +-spec load_binary(Module, Filename, Binary) -> + {module, Module} | {error, What} when + Module :: module(), + Filename :: loaded_filename(), + Binary :: binary(), + What :: badarg | load_error_rsn(). load_binary(Mod, File, Bin) when is_atom(Mod), (is_list(File) orelse is_atom(File)), is_binary(Bin) -> call({load_binary,Mod,File,Bin}). --spec load_native_partial(Module :: atom(), Binary :: binary()) -> load_ret(). +-spec load_native_partial(Module :: module(), Binary :: binary()) -> load_ret(). load_native_partial(Mod, Bin) when is_atom(Mod), is_binary(Bin) -> call({load_native_partial,Mod,Bin}). --spec load_native_sticky(Module :: atom(), Binary :: binary(), WholeModule :: 'false' | binary()) -> load_ret(). +-spec load_native_sticky(Module :: module(), Binary :: binary(), WholeModule :: 'false' | binary()) -> load_ret(). load_native_sticky(Mod, Bin, WholeModule) when is_atom(Mod), is_binary(Bin), (is_binary(WholeModule) orelse WholeModule =:= false) -> call({load_native_sticky,Mod,Bin,WholeModule}). --spec delete(Module :: atom()) -> boolean(). +-spec delete(Module) -> boolean() when + Module :: module(). delete(Mod) when is_atom(Mod) -> call({delete,Mod}). --spec purge(Module :: atom()) -> boolean(). +-spec purge(Module) -> boolean() when + Module :: module(). purge(Mod) when is_atom(Mod) -> call({purge,Mod}). --spec soft_purge(Module :: atom()) -> boolean(). +-spec soft_purge(Module) -> boolean() when + Module :: module(). soft_purge(Mod) when is_atom(Mod) -> call({soft_purge,Mod}). --spec is_loaded(Module :: atom()) -> {'file', loaded_filename()} | 'false'. +-spec is_loaded(Module) -> {'file', Loaded} | false when + Module :: module(), + Loaded :: loaded_filename(). is_loaded(Mod) when is_atom(Mod) -> call({is_loaded,Mod}). --spec get_object_code(Module :: atom()) -> {atom(), binary(), file:filename()} | 'error'. +-spec get_object_code(Module) -> {Module, Binary, Filename} | error when + Module :: module(), + Binary :: binary(), + Filename :: file:filename(). get_object_code(Mod) when is_atom(Mod) -> call({get_object_code, Mod}). --spec all_loaded() -> [{atom(), loaded_filename()}]. +-spec all_loaded() -> [{Module, Loaded}] when + Module :: module(), + Loaded :: loaded_filename(). all_loaded() -> call(all_loaded). -spec stop() -> no_return(). @@ -188,65 +213,86 @@ root_dir() -> call({dir,root_dir}). lib_dir() -> call({dir,lib_dir}). %% XXX is_list() is for backwards compatibility -- take out in future version --spec lib_dir(App :: atom()) -> file:filename() | {'error', 'bad_name'}. +-spec lib_dir(Name) -> file:filename() | {'error', 'bad_name'} when + Name :: atom(). lib_dir(App) when is_atom(App) ; is_list(App) -> call({dir,{lib_dir,App}}). --spec lib_dir(App :: atom(), SubDir :: atom()) -> file:filename() | {'error', 'bad_name'}. +-spec lib_dir(Name, SubDir) -> file:filename() | {'error', 'bad_name'} when + Name :: atom(), + SubDir :: atom(). lib_dir(App, SubDir) when is_atom(App), is_atom(SubDir) -> call({dir,{lib_dir,App,SubDir}}). -spec compiler_dir() -> file:filename(). compiler_dir() -> call({dir,compiler_dir}). %% XXX is_list() is for backwards compatibility -- take out in future version --spec priv_dir(App :: atom()) -> file:filename() | {'error', 'bad_name'}. +-spec priv_dir(Name) -> file:filename() | {'error', 'bad_name'} when + Name :: atom(). priv_dir(App) when is_atom(App) ; is_list(App) -> call({dir,{priv_dir,App}}). --spec stick_dir(Directory :: file:filename()) -> 'ok' | 'error'. +-spec stick_dir(Dir) -> 'ok' | 'error' when + Dir :: file:filename(). stick_dir(Dir) when is_list(Dir) -> call({stick_dir,Dir}). --spec unstick_dir(Directory :: file:filename()) -> 'ok' | 'error'. +-spec unstick_dir(Dir) -> 'ok' | 'error' when + Dir :: file:filename(). unstick_dir(Dir) when is_list(Dir) -> call({unstick_dir,Dir}). --spec stick_mod(Module :: atom()) -> 'true'. +-spec stick_mod(Module :: module()) -> 'true'. stick_mod(Mod) when is_atom(Mod) -> call({stick_mod,Mod}). --spec unstick_mod(Module :: atom()) -> 'true'. +-spec unstick_mod(Module :: module()) -> 'true'. unstick_mod(Mod) when is_atom(Mod) -> call({unstick_mod,Mod}). --spec is_sticky(Module :: atom()) -> boolean(). +-spec is_sticky(Module) -> boolean() when + Module :: module(). is_sticky(Mod) when is_atom(Mod) -> call({is_sticky,Mod}). --spec set_path(Directories :: [file:filename()]) -> - 'true' | {'error', 'bad_directory' | 'bad_path'}. +-spec set_path(Path) -> 'true' | {'error', What} when + Path :: [Dir :: file:filename()], + What :: 'bad_directory' | 'bad_path'. set_path(PathList) when is_list(PathList) -> call({set_path,PathList}). --spec get_path() -> [file:filename()]. +-spec get_path() -> Path when + Path :: [Dir :: file:filename()]. get_path() -> call(get_path). -type add_path_ret() :: 'true' | {'error', 'bad_directory'}. --spec add_path(Directory :: file:filename()) -> add_path_ret(). +-spec add_path(Dir) -> add_path_ret() when + Dir :: file:filename(). add_path(Dir) when is_list(Dir) -> call({add_path,last,Dir}). --spec add_pathz(Directory :: file:filename()) -> add_path_ret(). +-spec add_pathz(Dir) -> add_path_ret() when + Dir :: file:filename(). add_pathz(Dir) when is_list(Dir) -> call({add_path,last,Dir}). --spec add_patha(Directory :: file:filename()) -> add_path_ret(). +-spec add_patha(Dir) -> add_path_ret() when + Dir :: file:filename(). add_patha(Dir) when is_list(Dir) -> call({add_path,first,Dir}). --spec add_paths(Directories :: [file:filename()]) -> 'ok'. +-spec add_paths(Dirs) -> 'ok' when + Dirs :: [Dir :: file:filename()]. add_paths(Dirs) when is_list(Dirs) -> call({add_paths,last,Dirs}). --spec add_pathsz(Directories :: [file:filename()]) -> 'ok'. +-spec add_pathsz(Dirs) -> 'ok' when + Dirs :: [Dir :: file:filename()]. add_pathsz(Dirs) when is_list(Dirs) -> call({add_paths,last,Dirs}). --spec add_pathsa(Directories :: [file:filename()]) -> 'ok'. +-spec add_pathsa(Dirs) -> 'ok' when + Dirs :: [Dir :: file:filename()]. add_pathsa(Dirs) when is_list(Dirs) -> call({add_paths,first,Dirs}). --spec del_path(Name :: file:filename() | atom()) -> boolean() | {'error', 'bad_name'}. +-spec del_path(NameOrDir) -> boolean() | {'error', What} when + NameOrDir :: Name | Dir, + Name :: atom(), + Dir :: file:filename(), + What :: 'bad_name'. del_path(Name) when is_list(Name) ; is_atom(Name) -> call({del_path,Name}). --type replace_path_error() :: {'error', 'bad_directory' | 'bad_name' | {'badarg',_}}. --spec replace_path(Name:: atom(), Dir :: file:filename()) -> 'true' | replace_path_error(). +-spec replace_path(Name, Dir) -> 'true' | {'error', What} when + Name:: atom(), + Dir :: file:filename(), + What :: 'bad_directory' | 'bad_name' | {'badarg',_}. replace_path(Name, Dir) when (is_atom(Name) orelse is_list(Name)), (is_atom(Dir) orelse is_list(Dir)) -> call({replace_path,Name,Dir}). @@ -351,10 +397,9 @@ get_mode(Flags) -> %% In that case return the name of the file which contains %% the loaded object code --type which_ret_atoms() :: loaded_ret_atoms() | 'non_existing'. - --spec which(Module :: atom()) -> file:filename() | which_ret_atoms(). - +-spec which(Module) -> Which when + Module :: module(), + Which :: file:filename() | loaded_ret_atoms() | non_existing. which(Module) when is_atom(Module) -> case is_loaded(Module) of false -> @@ -394,9 +439,9 @@ which(File, Base, [Directory|Tail]) -> %% Search the code path for a specific file. Try to locate %% it in the code path cache if possible. --spec where_is_file(Filename :: file:filename()) -> - 'non_existing' | file:filename(). - +-spec where_is_file(Filename) -> non_existing | Absname when + Filename :: file:filename(), + Absname :: file:filename(). where_is_file(File) when is_list(File) -> case call({is_cached,File}) of no -> diff --git a/lib/kernel/src/code_server.erl b/lib/kernel/src/code_server.erl index 4a1fc7df34..85bbff9cc3 100644 --- a/lib/kernel/src/code_server.erl +++ b/lib/kernel/src/code_server.erl @@ -1379,8 +1379,12 @@ absname_vr([[X, $:]|Name], _, _AbsBase) -> %% Kill all processes running code from *old* Module, and then purge the %% module. Return true if any processes killed, else false. -do_purge(Mod) -> - do_purge(processes(), to_atom(Mod), false). +do_purge(Mod0) -> + Mod = to_atom(Mod0), + case erlang:check_old_code(Mod) of + false -> false; + true -> do_purge(processes(), Mod, false) + end. do_purge([P|Ps], Mod, Purged) -> case erlang:check_process_code(P, Mod) of @@ -1399,16 +1403,19 @@ do_purge([], Mod, Purged) -> Purged. %% do_soft_purge(Module) -%% Purge old code only if no procs remain that run old code +%% Purge old code only if no procs remain that run old code. %% Return true in that case, false if procs remain (in this %% case old code is not purged) do_soft_purge(Mod) -> - catch do_soft_purge(processes(), Mod). + case erlang:check_old_code(Mod) of + false -> true; + true -> do_soft_purge(processes(), Mod) + end. do_soft_purge([P|Ps], Mod) -> case erlang:check_process_code(P, Mod) of - true -> throw(false); + true -> false; false -> do_soft_purge(Ps, Mod) end; do_soft_purge([], Mod) -> diff --git a/lib/kernel/src/file.erl b/lib/kernel/src/file.erl index f1a8aa9f77..5e4e1b0ba8 100644 --- a/lib/kernel/src/file.erl +++ b/lib/kernel/src/file.erl @@ -100,15 +100,7 @@ | 'enotblk' | 'enotdir' | 'enotsup' | 'enxio' | 'eperm' | 'epipe' | 'erofs' | 'espipe' | 'esrch' | 'estale' | 'exdev'. --type bindings() :: erl_eval:binding_struct(). - --type date() :: {Year :: pos_integer(), - Month :: pos_integer(), - Day ::pos_integer()}. --type time() :: {Hour :: non_neg_integer(), - Minute :: non_neg_integer(), - Second :: non_neg_integer()}. --type date_time() :: {date(), time()}. +-type date_time() :: calendar:datetime(). -type posix_file_advise() :: 'normal' | 'sequential' | 'random' | 'no_reuse' | 'will_need' | 'dont_need'. @@ -920,7 +912,7 @@ eval(File) -> -spec eval(Filename, Bindings) -> ok | {error, Reason} when Filename :: name(), - Bindings :: bindings(), + Bindings :: erl_eval:binding_struct(), Reason :: posix() | badarg | terminated | system_limit | {Line :: integer(), Mod :: module(), Term :: term()}. @@ -948,7 +940,7 @@ path_eval(Path, File) -> {ok, FullName} | {error, Reason} when Path :: [Dir :: name()], Filename :: name(), - Bindings :: bindings(), + Bindings :: erl_eval:binding_struct(), FullName :: filename(), Reason :: posix() | badarg | terminated | system_limit | {Line :: integer(), Mod :: module(), Term :: term()}. @@ -979,7 +971,7 @@ script(File) -> -spec script(Filename, Bindings) -> {ok, Value} | {error, Reason} when Filename :: name(), - Bindings :: bindings(), + Bindings :: erl_eval:binding_struct(), Value :: term(), Reason :: posix() | badarg | terminated | system_limit | {Line :: integer(), Mod :: module(), Term :: term()}. @@ -1010,7 +1002,7 @@ path_script(Path, File) -> {ok, Value, FullName} | {error, Reason} when Path :: [Dir :: name()], Filename :: name(), - Bindings :: bindings(), + Bindings :: erl_eval:binding_struct(), Value :: term(), FullName :: filename(), Reason :: posix() | badarg | terminated | system_limit diff --git a/lib/kernel/src/gen_sctp.erl b/lib/kernel/src/gen_sctp.erl index 004f03f231..6cebb7ab97 100644 --- a/lib/kernel/src/gen_sctp.erl +++ b/lib/kernel/src/gen_sctp.erl @@ -33,55 +33,85 @@ -export([error_string/1]). -export([controlling_process/2]). --opaque assoc_id() :: term(). --type hostname() :: inet:hostname(). --type ip_address() :: inet:ip_address(). --type port_number() :: 0..65535. --type posix() :: inet:posix(). --type sctp_option() :: - {mode, list | binary} | list | binary - | {active, true | false | once} - | {buffer, non_neg_integer()} - | {tos, integer()} - | {priority, integer()} - | {dontroute, boolean()} - | {reuseaddr, boolean()} - | {linger, {boolean(), non_neg_integer()}} - | {sndbuf, non_neg_integer()} - | {recbuf, non_neg_integer()} - | {sctp_rtoinfo, #sctp_rtoinfo{}} - | {sctp_associnfo, #sctp_assocparams{}} - | {sctp_initmsg, #sctp_initmsg{}} - | {sctp_autoclose, timeout()} - | {sctp_nodelay, boolean()} - | {sctp_disable_fragments, boolean()} - | {sctp_i_want_mapped_v4_addr, boolean()} - | {sctp_maxseg, non_neg_integer()} - | {sctp_primary_addr, #sctp_prim{}} - | {sctp_set_peer_primary_addr, #sctp_setpeerprim{}} - | {sctp_adaptation_layer, #sctp_setadaptation{}} - | {sctp_peer_addr_params, #sctp_paddrparams{}} - | {sctp_default_send_param, #sctp_sndrcvinfo{}} - | {sctp_events, #sctp_event_subscribe{}} - | {sctp_delayed_ack_time, #sctp_assoc_value{}} - | {sctp_status, #sctp_status{}} - | {sctp_get_peer_addr_info, #sctp_paddrinfo{}}. --opaque sctp_socket() :: port(). - --spec open() -> {ok, Socket} | {error, posix()} when +-type assoc_id() :: term(). +-type option() :: + {active, true | false | once} | + {buffer, non_neg_integer()} | + {dontroute, boolean()} | + {linger, {boolean(), non_neg_integer()}} | + {mode, list | binary} | list | binary | + {priority, non_neg_integer()} | + {recbuf, non_neg_integer()} | + {reuseaddr, boolean()} | + {sctp_adaptation_layer, #sctp_setadaptation{}} | + {sctp_associnfo, #sctp_assocparams{}} | + {sctp_autoclose, non_neg_integer()} | + {sctp_default_send_param, #sctp_sndrcvinfo{}} | + {sctp_delayed_ack_time, #sctp_assoc_value{}} | + {sctp_disable_fragments, boolean()} | + {sctp_events, #sctp_event_subscribe{}} | + {sctp_get_peer_addr_info, #sctp_paddrinfo{}} | + {sctp_i_want_mapped_v4_addr, boolean()} | + {sctp_initmsg, #sctp_initmsg{}} | + {sctp_maxseg, non_neg_integer()} | + {sctp_nodelay, boolean()} | + {sctp_peer_addr_params, #sctp_paddrparams{}} | + {sctp_primary_addr, #sctp_prim{}} | + {sctp_rtoinfo, #sctp_rtoinfo{}} | + {sctp_set_peer_primary_addr, #sctp_setpeerprim{}} | + {sctp_status, #sctp_status{}} | + {sndbuf, non_neg_integer()} | + {tos, non_neg_integer()}. +-type option_name() :: + active | + buffer | + dontroute | + linger | + mode | + priority | + recbuf | + reuseaddr | + sctp_adaptation_layer | + sctp_associnfo | + sctp_autoclose | + sctp_default_send_param | + sctp_delayed_ack_time | + sctp_disable_fragments | + sctp_events | + sctp_get_peer_addr_info | + sctp_i_want_mapped_v4_addr | + sctp_initmsg | + sctp_maxseg | + sctp_nodelay | + sctp_peer_addr_params | + sctp_primary_addr | + sctp_rtoinfo | + sctp_set_peer_primary_addr | + sctp_status | + sndbuf | + tos. +-type sctp_socket() :: port(). + +-export_type([assoc_id/0, option/0, option_name/0, sctp_socket/0]). + +-spec open() -> {ok, Socket} | {error, inet:posix()} when Socket :: sctp_socket(). open() -> open([]). --spec open(Port) -> {ok, Socket} | {error, posix()} when - Port :: port_number(), +-spec open(Port) -> {ok, Socket} | {error, inet:posix()} when + Port :: inet:port_number(), Socket :: sctp_socket(); - (Opts) -> {ok, Socket} | {error, posix()} when + (Opts) -> {ok, Socket} | {error, inet:posix()} when Opts :: [Opt], - Opt :: {ip,IP} | {ifaddr,IP} | {port,Port} | sctp_option(), - IP :: ip_address() | any | loopback, - Port :: port_number(), + Opt :: {ip,IP} + | {ifaddr,IP} + | inet:address_family() + | {port,Port} + | option(), + IP :: inet:ip_address() | any | loopback, + Port :: inet:port_number(), Socket :: sctp_socket(). open(Opts) when is_list(Opts) -> @@ -98,11 +128,15 @@ open(Port) when is_integer(Port) -> open(X) -> erlang:error(badarg, [X]). --spec open(Port, Opts) -> {ok, Socket} | {error, posix()} when +-spec open(Port, Opts) -> {ok, Socket} | {error, inet:posix()} when Opts :: [Opt], - Opt :: {ip,IP} | {ifaddr,IP} | {port,Port} | sctp_option(), - IP :: ip_address() | any | loopback, - Port :: port_number(), + Opt :: {ip,IP} + | {ifaddr,IP} + | inet:address_family() + | {port,Port} + | option(), + IP :: inet:ip_address() | any | loopback, + Port :: inet:port_number(), Socket :: sctp_socket(). open(Port, Opts) when is_integer(Port), is_list(Opts) -> @@ -110,7 +144,7 @@ open(Port, Opts) when is_integer(Port), is_list(Opts) -> open(Port, Opts) -> erlang:error(badarg, [Port,Opts]). --spec close(Socket) -> ok | {error, posix()} when +-spec close(Socket) -> ok | {error, inet:posix()} when Socket :: sctp_socket(). close(S) when is_port(S) -> @@ -138,22 +172,22 @@ listen(S, Flag) when is_port(S), is_boolean(Flag) -> listen(S, Flag) -> erlang:error(badarg, [S,Flag]). --spec connect(Socket, Addr, Port, Opts) -> {ok, Assoc} | {error, posix()} when +-spec connect(Socket, Addr, Port, Opts) -> {ok, Assoc} | {error, inet:posix()} when Socket :: sctp_socket(), - Addr :: ip_address() | hostname(), - Port :: port_number(), - Opts :: [Opt :: sctp_option()], + Addr :: inet:ip_address() | inet:hostname(), + Port :: inet:port_number(), + Opts :: [Opt :: option()], Assoc :: #sctp_assoc_change{}. connect(S, Addr, Port, Opts) -> connect(S, Addr, Port, Opts, infinity). -spec connect(Socket, Addr, Port, Opts, Timeout) -> - {ok, Assoc} | {error, posix()} when + {ok, Assoc} | {error, inet:posix()} when Socket :: sctp_socket(), - Addr :: ip_address() | hostname(), - Port :: port_number(), - Opts :: [Opt :: sctp_option()], + Addr :: inet:ip_address() | inet:hostname(), + Port :: inet:port_number(), + Opts :: [Opt :: option()], Timeout :: timeout(), Assoc :: #sctp_assoc_change{}. @@ -166,21 +200,21 @@ connect(S, Addr, Port, Opts, Timeout) -> end. -spec connect_init(Socket, Addr, Port, Opts) -> - ok | {error, posix()} when + ok | {error, inet:posix()} when Socket :: sctp_socket(), - Addr :: ip_address() | hostname(), - Port :: port_number(), - Opts :: [sctp_option()]. + Addr :: inet:ip_address() | inet:hostname(), + Port :: inet:port_number(), + Opts :: [option()]. connect_init(S, Addr, Port, Opts) -> connect_init(S, Addr, Port, Opts, infinity). -spec connect_init(Socket, Addr, Port, Opts, Timeout) -> - ok | {error, posix()} when + ok | {error, inet:posix()} when Socket :: sctp_socket(), - Addr :: ip_address() | hostname(), - Port :: port_number(), - Opts :: [sctp_option()], + Addr :: inet:ip_address() | inet:hostname(), + Port :: inet:port_number(), + Opts :: [option()], Timeout :: timeout(). connect_init(S, Addr, Port, Opts, Timeout) -> @@ -232,7 +266,7 @@ eof(S, #sctp_assoc_change{assoc_id=AssocId}) when is_port(S) -> eof(S, Assoc) -> erlang:error(badarg, [S,Assoc]). --spec abort(Socket, Assoc) -> ok | {error, posix()} when +-spec abort(Socket, Assoc) -> ok | {error, inet:posix()} when Socket :: sctp_socket(), Assoc :: #sctp_assoc_change{}. @@ -294,13 +328,13 @@ send(S, AssocChange, Stream, Data) -> -spec recv(Socket) -> {ok, {FromIP, FromPort, AncData, Data}} | {error, Reason} when Socket :: sctp_socket(), - FromIP :: ip_address(), - FromPort :: port_number(), + FromIP :: inet:ip_address(), + FromPort :: inet:port_number(), AncData :: [#sctp_sndrcvinfo{}], Data :: binary() | string() | #sctp_sndrcvinfo{} | #sctp_assoc_change{} | #sctp_paddr_change{} | #sctp_adaptation_event{}, - Reason :: posix() | #sctp_send_failed{} | #sctp_paddr_change{} + Reason :: inet:posix() | #sctp_send_failed{} | #sctp_paddr_change{} | #sctp_pdapi_event{} | #sctp_remote_error{} | #sctp_shutdown_event{}. @@ -311,13 +345,13 @@ recv(S) -> | {error, Reason} when Socket :: sctp_socket(), Timeout :: timeout(), - FromIP :: ip_address(), - FromPort :: port_number(), + FromIP :: inet:ip_address(), + FromPort :: inet:port_number(), AncData :: [#sctp_sndrcvinfo{}], Data :: binary() | string() | #sctp_sndrcvinfo{} | #sctp_assoc_change{} | #sctp_paddr_change{} | #sctp_adaptation_event{}, - Reason :: posix() | #sctp_send_failed{} | #sctp_paddr_change{} + Reason :: inet:posix() | #sctp_send_failed{} | #sctp_paddr_change{} | #sctp_pdapi_event{} | #sctp_remote_error{} | #sctp_shutdown_event{}. diff --git a/lib/kernel/src/gen_tcp.erl b/lib/kernel/src/gen_tcp.erl index bee61ca84a..8ab18c01b4 100644 --- a/lib/kernel/src/gen_tcp.erl +++ b/lib/kernel/src/gen_tcp.erl @@ -28,34 +28,108 @@ -include("inet_int.hrl"). --type hostname() :: inet:hostname(). --type ip_address() :: inet:ip_address(). --type port_number() :: 0..65535. --type posix() :: inet:posix(). +-type option() :: + {active, true | false | once} | + {bit8, clear | set | on | off} | + {buffer, non_neg_integer()} | + {delay_send, boolean()} | + {deliver, port | term} | + {dontroute, boolean()} | + {exit_on_close, boolean()} | + {header, non_neg_integer()} | + {high_watermark, non_neg_integer()} | + {keepalive, boolean()} | + {linger, {boolean(), non_neg_integer()}} | + {low_watermark, non_neg_integer()} | + {mode, list | binary} | list | binary | + {nodelay, boolean()} | + {packet, + 0 | 1 | 2 | 4 | raw | sunrm | asn1 | + cdr | fcgi | line | tpkt | http | httph | http_bin | httph_bin } | + {packet_size, non_neg_integer()} | + {priority, non_neg_integer()} | + {raw, + Protocol :: non_neg_integer(), + OptionNum :: non_neg_integer(), + ValueBin :: binary()} | + {recbuf, non_neg_integer()} | + {reuseaddr, boolean()} | + {send_timeout, non_neg_integer() | infinity} | + {send_timeout_close, boolean()} | + {sndbuf, non_neg_integer()} | + {tos, non_neg_integer()}. +-type option_name() :: + active | + bit8 | + buffer | + delay_send | + deliver | + dontroute | + exit_on_close | + header | + high_watermark | + keepalive | + linger | + low_watermark | + mode | + nodelay | + packet | + packet_size | + priority | + {raw, + Protocol :: non_neg_integer(), + OptionNum :: non_neg_integer(), + ValueSpec :: (ValueSize :: non_neg_integer()) | + (ValueBin :: binary())} | + recbuf | + reuseaddr | + send_timeout | + send_timeout_close | + sndbuf | + tos. +-type connect_option() :: + {ip, inet:ip_address()} | + {fd, Fd :: non_neg_integer()} | + {ifaddr, inet:ip_address()} | + inet:address_family() | + {port, inet:port_number()} | + {tcp_module, module()} | + option(). +-type listen_option() :: + {ip, inet:ip_address()} | + {fd, Fd :: non_neg_integer()} | + {ifaddr, inet:ip_address()} | + inet:address_family() | + {port, inet:port_number()} | + {backlog, B :: non_neg_integer()} | + {tcp_module, module()} | + option(). -type socket() :: port(). +-export_type([option/0, option_name/0, connect_option/0, listen_option/0]). + %% %% Connect a socket %% -spec connect(Address, Port, Options) -> {ok, Socket} | {error, Reason} when - Address :: ip_address() | hostname(), - Port :: port_number(), - Options :: [Opt :: term()], + Address :: inet:ip_address() | inet:hostname(), + Port :: inet:port_number(), + Options :: [connect_option()], Socket :: socket(), - Reason :: posix(). + Reason :: inet:posix(). connect(Address, Port, Opts) -> connect(Address,Port,Opts,infinity). -spec connect(Address, Port, Options, Timeout) -> {ok, Socket} | {error, Reason} when - Address :: ip_address() | hostname(), - Port :: port_number(), - Options :: [Opt :: term()], + Address :: inet:ip_address() | inet:hostname(), + Port :: inet:port_number(), + Options :: [connect_option()], Timeout :: timeout(), Socket :: socket(), - Reason :: posix(). + Reason :: inet:posix(). connect(Address, Port, Opts, Time) -> Timer = inet:start_timer(Time), @@ -97,10 +171,10 @@ try_connect([], _Port, _Opts, _Timer, _Mod, Err) -> %% -spec listen(Port, Options) -> {ok, ListenSocket} | {error, Reason} when - Port :: port_number(), - Options :: [Opt :: term()], + Port :: inet:port_number(), + Options :: [listen_option()], ListenSocket :: socket(), - Reason :: posix(). + Reason :: inet:posix(). listen(Port, Opts) -> Mod = mod(Opts, undefined), @@ -119,7 +193,7 @@ listen(Port, Opts) -> -spec accept(ListenSocket) -> {ok, Socket} | {error, Reason} when ListenSocket :: socket(), Socket :: socket(), - Reason :: closed | timeout | posix(). + Reason :: closed | timeout | inet:posix(). accept(S) -> case inet_db:lookup_socket(S) of @@ -133,7 +207,7 @@ accept(S) -> ListenSocket :: socket(), Timeout :: timeout(), Socket :: socket(), - Reason :: closed | timeout | posix(). + Reason :: closed | timeout | inet:posix(). accept(S, Time) when is_port(S) -> case inet_db:lookup_socket(S) of @@ -150,7 +224,7 @@ accept(S, Time) when is_port(S) -> -spec shutdown(Socket, How) -> ok | {error, Reason} when Socket :: socket(), How :: read | write | read_write, - Reason :: posix(). + Reason :: inet:posix(). shutdown(S, How) when is_port(S) -> case inet_db:lookup_socket(S) of @@ -176,8 +250,8 @@ close(S) -> -spec send(Socket, Packet) -> ok | {error, Reason} when Socket :: socket(), - Packet :: string() | binary(), - Reason :: posix(). + Packet :: iodata(), + Reason :: inet:posix(). send(S, Packet) when is_port(S) -> case inet_db:lookup_socket(S) of @@ -195,7 +269,7 @@ send(S, Packet) when is_port(S) -> Socket :: socket(), Length :: non_neg_integer(), Packet :: string() | binary() | HttpPacket, - Reason :: closed | posix(), + Reason :: closed | inet:posix(), HttpPacket :: term(). recv(S, Length) when is_port(S) -> @@ -211,7 +285,7 @@ recv(S, Length) when is_port(S) -> Length :: non_neg_integer(), Timeout :: timeout(), Packet :: string() | binary() | HttpPacket, - Reason :: closed | posix(), + Reason :: closed | inet:posix(), HttpPacket :: term(). recv(S, Length, Time) when is_port(S) -> @@ -237,7 +311,7 @@ unrecv(S, Data) when is_port(S) -> -spec controlling_process(Socket, Pid) -> ok | {error, Reason} when Socket :: socket(), Pid :: pid(), - Reason :: closed | not_owner | posix(). + Reason :: closed | not_owner | inet:posix(). controlling_process(S, NewOwner) -> case inet_db:lookup_socket(S) of diff --git a/lib/kernel/src/gen_udp.erl b/lib/kernel/src/gen_udp.erl index 7d14615c04..8688799ae9 100644 --- a/lib/kernel/src/gen_udp.erl +++ b/lib/kernel/src/gen_udp.erl @@ -25,25 +25,74 @@ -include("inet_int.hrl"). --type hostname() :: inet:hostname(). --type ip_address() :: inet:ip_address(). --type port_number() :: 0..65535. --type posix() :: inet:posix(). +-type option() :: + {active, true | false | once} | + {add_membership, {inet:ip_address(), inet:ip_address()}} | + {broadcast, boolean()} | + {buffer, non_neg_integer()} | + {deliver, port | term} | + {dontroute, boolean()} | + {drop_membership, {inet:ip_address(), inet:ip_address()}} | + {header, non_neg_integer()} | + {mode, list | binary} | list | binary | + {multicast_if, inet:ip_address()} | + {multicast_loop, boolean()} | + {multicast_ttl, non_neg_integer()} | + {priority, non_neg_integer()} | + {raw, + Protocol :: non_neg_integer(), + OptionNum :: non_neg_integer(), + ValueBin :: binary()} | + {read_packets, non_neg_integer()} | + {recbuf, non_neg_integer()} | + {reuseaddr, boolean()} | + {sndbuf, non_neg_integer()} | + {tos, non_neg_integer()}. +-type option_name() :: + active | + broadcast | + buffer | + deliver | + dontroute | + header | + mode | + multicast_if | + multicast_loop | + multicast_ttl | + priority | + {raw, + Protocol :: non_neg_integer(), + OptionNum :: non_neg_integer(), + ValueSpec :: (ValueSize :: non_neg_integer()) | + (ValueBin :: binary())} | + read_packets | + recbuf | + reuseaddr | + sndbuf | + tos. -type socket() :: port(). +-export_type([option/0, option_name/0]). + -spec open(Port) -> {ok, Socket} | {error, Reason} when - Port :: port_number(), + Port :: inet:port_number(), Socket :: socket(), - Reason :: posix(). + Reason :: inet:posix(). open(Port) -> open(Port, []). -spec open(Port, Opts) -> {ok, Socket} | {error, Reason} when - Port :: port_number(), - Opts :: [Opt :: term()], + Port :: inet:port_number(), + Opts :: [Option], + Option :: {ip, inet:ip_address()} + | {fd, non_neg_integer()} + | {ifaddr, inet:ip_address()} + | inet:address_family() + | {port, inet:port_number()} + | option(), Socket :: socket(), - Reason :: posix(). + Reason :: inet:posix(). open(Port, Opts) -> Mod = mod(Opts, undefined), @@ -58,10 +107,10 @@ close(S) -> -spec send(Socket, Address, Port, Packet) -> ok | {error, Reason} when Socket :: socket(), - Address :: ip_address() | hostname(), - Port :: port_number(), - Packet :: string() | binary(), - Reason :: not_owner | posix(). + Address :: inet:ip_address() | inet:hostname(), + Port :: inet:port_number(), + Packet :: iodata(), + Reason :: not_owner | inet:posix(). send(S, Address, Port, Packet) when is_port(S) -> case inet_db:lookup_socket(S) of @@ -92,10 +141,10 @@ send(S, Packet) when is_port(S) -> {ok, {Address, Port, Packet}} | {error, Reason} when Socket :: socket(), Length :: non_neg_integer(), - Address :: ip_address(), - Port :: port_number(), + Address :: inet:ip_address(), + Port :: inet:port_number(), Packet :: string() | binary(), - Reason :: not_owner | posix(). + Reason :: not_owner | inet:posix(). recv(S,Len) when is_port(S), is_integer(Len) -> case inet_db:lookup_socket(S) of @@ -110,10 +159,10 @@ recv(S,Len) when is_port(S), is_integer(Len) -> Socket :: socket(), Length :: non_neg_integer(), Timeout :: timeout(), - Address :: ip_address(), - Port :: port_number(), + Address :: inet:ip_address(), + Port :: inet:port_number(), Packet :: string() | binary(), - Reason :: not_owner | posix(). + Reason :: not_owner | inet:posix(). recv(S,Len,Time) when is_port(S) -> case inet_db:lookup_socket(S) of diff --git a/lib/kernel/src/inet.erl b/lib/kernel/src/inet.erl index 5649188c38..48a6f3db65 100644 --- a/lib/kernel/src/inet.erl +++ b/lib/kernel/src/inet.erl @@ -63,8 +63,9 @@ %% timer interface -export([start_timer/1, timeout/1, timeout/2, stop_timer/1]). --export_type([family_option/0, hostent/0, hostname/0, ip4_address/0, - ip6_address/0, ip_address/0, posix/0, socket/0]). +-export_type([address_family/0, hostent/0, hostname/0, ip4_address/0, + ip6_address/0, ip_address/0, posix/0, socket/0, + port_number/0]). %% imports -import(lists, [append/1, duplicate/2, filter/2, foldl/3]). @@ -87,98 +88,15 @@ -type ip6_address() :: {0..65535,0..65535,0..65535,0..65535, 0..65535,0..65535,0..65535,0..65535}. -type ip_address() :: ip4_address() | ip6_address(). --type ip_port() :: 0..65535. +-type port_number() :: 0..65535. -type posix() :: exbadport | exbadseq | file:posix(). -type socket() :: port(). -type socket_setopt() :: - {'raw', non_neg_integer(), non_neg_integer(), binary()} | - %% TCP/UDP options - {'reuseaddr', boolean()} | - {'keepalive', boolean()} | - {'dontroute', boolean()} | - {'linger', {boolean(), non_neg_integer()}} | - {'broadcast', boolean()} | - {'sndbuf', non_neg_integer()} | - {'recbuf', non_neg_integer()} | - {'priority', non_neg_integer()} | - {'tos', non_neg_integer()} | - {'nodelay', boolean()} | - {'multicast_ttl', non_neg_integer()} | - {'multicast_loop', boolean()} | - {'multicast_if', ip_address()} | - {'add_membership', {ip_address(), ip_address()}} | - {'drop_membership', {ip_address(), ip_address()}} | - {'header', non_neg_integer()} | - {'buffer', non_neg_integer()} | - {'active', boolean() | 'once'} | - {'packet', - 0 | 1 | 2 | 4 | 'raw' | 'sunrm' | 'asn1' | - 'cdr' | 'fcgi' | 'line' | 'tpkt' | 'http' | 'httph' | 'http_bin' | 'httph_bin' } | - {'mode', 'list' | 'binary'} | - {'port', 'port', 'term'} | - {'exit_on_close', boolean()} | - {'low_watermark', non_neg_integer()} | - {'high_watermark', non_neg_integer()} | - {'bit8', 'clear' | 'set' | 'on' | 'off'} | - {'send_timeout', non_neg_integer() | 'infinity'} | - {'send_timeout_close', boolean()} | - {'delay_send', boolean()} | - {'packet_size', non_neg_integer()} | - {'read_packets', non_neg_integer()} | - %% SCTP options - {'sctp_rtoinfo', #sctp_rtoinfo{}} | - {'sctp_associnfo', #sctp_assocparams{}} | - {'sctp_initmsg', #sctp_initmsg{}} | - {'sctp_nodelay', boolean()} | - {'sctp_autoclose', non_neg_integer()} | - {'sctp_disable_fragments', boolean()} | - {'sctp_i_want_mapped_v4_addr', boolean()} | - {'sctp_maxseg', non_neg_integer()} | - {'sctp_primary_addr', #sctp_prim{}} | - {'sctp_set_peer_primary_addr', #sctp_setpeerprim{}} | - {'sctp_adaptation_layer', #sctp_setadaptation{}} | - {'sctp_peer_addr_params', #sctp_paddrparams{}} | - {'sctp_default_send_param', #sctp_sndrcvinfo{}} | - {'sctp_events', #sctp_event_subscribe{}} | - {'sctp_delayed_ack_time', #sctp_assoc_value{}}. + gen_sctp:option() | gen_tcp:option() | gen_udp:option(). -type socket_getopt() :: - {'raw', - non_neg_integer(), non_neg_integer(), binary()|non_neg_integer()} | - %% TCP/UDP options - 'reuseaddr' | 'keepalive' | 'dontroute' | 'linger' | - 'broadcast' | 'sndbuf' | 'recbuf' | 'priority' | 'tos' | 'nodelay' | - 'multicast_ttl' | 'multicast_loop' | 'multicast_if' | - 'add_membership' | 'drop_membership' | - 'header' | 'buffer' | 'active' | 'packet' | 'mode' | 'port' | - 'exit_on_close' | 'low_watermark' | 'high_watermark' | 'bit8' | - 'send_timeout' | 'send_timeout_close' | - 'delay_send' | 'packet_size' | 'read_packets' | - %% SCTP options - {'sctp_status', #sctp_status{}} | - 'sctp_get_peer_addr_info' | - {'sctp_get_peer_addr_info', #sctp_status{}} | - 'sctp_rtoinfo' | - {'sctp_rtoinfo', #sctp_rtoinfo{}} | - 'sctp_associnfo' | - {'sctp_associnfo', #sctp_assocparams{}} | - 'sctp_initmsg' | - {'sctp_initmsg', #sctp_initmsg{}} | - 'sctp_nodelay' | 'sctp_autoclose' | 'sctp_disable_fragments' | - 'sctp_i_want_mapped_v4_addr' | 'sctp_maxseg' | - {'sctp_primary_addr', #sctp_prim{}} | - {'sctp_set_peer_primary_addr', #sctp_setpeerprim{}} | - 'sctp_adaptation_layer' | - {'sctp_adaptation_layer', #sctp_setadaptation{}} | - {'sctp_peer_addr_params', #sctp_paddrparams{}} | - 'sctp_default_send_param' | - {'sctp_default_send_param', #sctp_sndrcvinfo{}} | - 'sctp_events' | - {'sctp_events', #sctp_event_subscribe{}} | - 'sctp_delayed_ack_time' | - {'sctp_delayed_ack_time', #sctp_assoc_value{}}. - + gen_sctp:option_name() | gen_tcp:option_name() | gen_udp:option_name(). -type ether_address() :: [0..255]. -type if_setopt() :: @@ -196,7 +114,7 @@ 'addr' | 'broadaddr' | 'dstaddr' | 'mtu' | 'netmask' | 'flags' |'hwaddr'. --type family_option() :: 'inet' | 'inet6'. +-type address_family() :: 'inet' | 'inet6'. -type protocol_option() :: 'tcp' | 'udp' | 'sctp'. -type stat_option() :: 'recv_cnt' | 'recv_max' | 'recv_avg' | 'recv_oct' | 'recv_dvi' | @@ -229,7 +147,7 @@ close(Socket) -> peername(Socket) -> prim_inet:peername(Socket). --spec setpeername(Socket :: socket(), Address :: {ip_address(), ip_port()}) -> +-spec setpeername(Socket :: socket(), Address :: {ip_address(), port_number()}) -> 'ok' | {'error', any()}. setpeername(Socket, {IP,Port}) -> @@ -246,7 +164,7 @@ setpeername(Socket, undefined) -> sockname(Socket) -> prim_inet:sockname(Socket). --spec setsockname(Socket :: socket(), Address :: {ip_address(), ip_port()}) -> +-spec setsockname(Socket :: socket(), Address :: {ip_address(), port_number()}) -> 'ok' | {'error', any()}. setsockname(Socket, {IP,Port}) -> @@ -254,7 +172,9 @@ setsockname(Socket, {IP,Port}) -> setsockname(Socket, undefined) -> prim_inet:setsockname(Socket, undefined). --spec port(Socket :: socket()) -> {'ok', ip_port()} | {'error', any()}. +-spec port(Socket) -> {'ok', Port} | {'error', any()} when + Socket :: socket(), + Port :: port_number(). port(Socket) -> case prim_inet:sockname(Socket) of @@ -268,16 +188,18 @@ port(Socket) -> send(Socket, Packet) -> prim_inet:send(Socket, Packet). --spec setopts(Socket :: socket(), Opts :: [socket_setopt()]) -> - 'ok' | {'error', posix()}. +-spec setopts(Socket, Options) -> ok | {error, posix()} when + Socket :: socket(), + Options :: [socket_setopt()]. setopts(Socket, Opts) -> prim_inet:setopts(Socket, Opts). -spec getopts(Socket, Options) -> - {'ok', [socket_setopt()]} | {'error', posix()} when + {'ok', OptionValues} | {'error', posix()} when Socket :: socket(), - Options :: [socket_getopt()]. + Options :: [socket_getopt()], + OptionValues :: [socket_setopt()]. getopts(Socket, Opts) -> prim_inet:getopts(Socket, Opts). @@ -419,14 +341,19 @@ gethostname() -> gethostname(Socket) -> prim_inet:gethostname(Socket). --spec getstat(Socket :: socket()) -> - {'ok', [{stat_option(), integer()}]} | {'error', posix()}. +-spec getstat(Socket) -> + {ok, OptionValues} | {error, posix()} when + Socket :: socket(), + OptionValues :: [{stat_option(), integer()}]. getstat(Socket) -> prim_inet:getstat(Socket, stats()). --spec getstat(Socket :: socket(), Statoptions :: [stat_option()]) -> - {'ok', [{stat_option(), integer()}]} | {'error', posix()}. +-spec getstat(Socket, Options) -> + {ok, OptionValues} | {error, posix()} when + Socket :: socket(), + Options :: [stat_option()], + OptionValues :: [{stat_option(), integer()}]. getstat(Socket,What) -> prim_inet:getstat(Socket, What). @@ -441,14 +368,14 @@ gethostbyname(Name) -> -spec gethostbyname(Hostname, Family) -> {ok, Hostent} | {error, posix()} when Hostname :: hostname(), - Family :: family_option(), + Family :: address_family(), Hostent :: hostent(). gethostbyname(Name,Family) -> gethostbyname_tm(Name, Family, false). -spec gethostbyname(Name :: hostname(), - Family :: family_option(), + Family :: address_family(), Timeout :: non_neg_integer() | 'infinity') -> {'ok', #hostent{}} | {'error', posix()}. @@ -527,14 +454,14 @@ getfd(Socket) -> -spec getaddr(Host, Family) -> {ok, Address} | {error, posix()} when Host :: ip_address() | hostname(), - Family :: family_option(), + Family :: address_family(), Address :: ip_address(). getaddr(Address, Family) -> getaddr(Address, Family, infinity). -spec getaddr(Host :: ip_address() | hostname(), - Family :: family_option(), + Family :: address_family(), Timeout :: non_neg_integer() | 'infinity') -> {'ok', ip_address()} | {'error', posix()}. @@ -553,14 +480,14 @@ getaddr_tm(Address, Family, Timer) -> -spec getaddrs(Host, Family) -> {ok, Addresses} | {error, posix()} when Host :: ip_address() | hostname(), - Family :: family_option(), + Family :: address_family(), Addresses :: [ip_address()]. getaddrs(Address, Family) -> getaddrs(Address, Family, infinity). -spec getaddrs(Host :: ip_address() | string() | atom(), - Family :: family_option(), + Family :: address_family(), Timeout :: non_neg_integer() | 'infinity') -> {'ok', [ip_address()]} | {'error', posix()}. @@ -570,7 +497,7 @@ getaddrs(Address, Family, Timeout) -> stop_timer(Timer), Res. --spec getservbyport(Port :: ip_port(), Protocol :: atom() | string()) -> +-spec getservbyport(Port :: port_number(), Protocol :: atom() | string()) -> {'ok', string()} | {'error', posix()}. getservbyport(Port, Proto) -> @@ -584,7 +511,7 @@ getservbyport(Port, Proto) -> -spec getservbyname(Name :: atom() | string(), Protocol :: atom() | string()) -> - {'ok', ip_port()} | {'error', posix()}. + {'ok', port_number()} | {'error', posix()}. getservbyname(Name, Protocol) when is_atom(Name) -> case inet_udp:open(0, []) of @@ -1067,7 +994,7 @@ gethostbyaddr_tm_native(Addr, Timer, Opts) -> -spec open(Fd :: integer(), Addr :: ip_address(), - Port :: ip_port(), + Port :: port_number(), Opts :: [socket_setopt()], Protocol :: protocol_option(), Family :: 'inet' | 'inet6', @@ -1108,7 +1035,7 @@ open(Fd, _Addr, _Port, Opts, Protocol, Family, Module) -> -spec fdopen(Fd :: non_neg_integer(), Opts :: [socket_setopt()], Protocol :: protocol_option(), - Family :: family_option(), + Family :: address_family(), Module :: atom()) -> {'ok', socket()} | {'error', posix()}. diff --git a/lib/kernel/src/inet_config.erl b/lib/kernel/src/inet_config.erl index 2458876326..1ddbdcec25 100644 --- a/lib/kernel/src/inet_config.erl +++ b/lib/kernel/src/inet_config.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% Copyright Ericsson AB 1997-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -44,26 +44,6 @@ %% -spec init() -> 'ok'. init() -> - OsType = os:type(), - case OsType of - {ose,_} -> - case init:get_argument(loader) of - {ok,[["ose_inet"]]} -> - %% port already started by prim_loader - ok; - _Other -> - %% Setup reserved port for ose_inet driver (only OSE) - case catch erlang:open_port({spawn,"ose_inet"}, [binary]) of - {'EXIT',Why} -> - error("can't open port for ose_inet: ~p", [Why]); - OseInetPort -> - erlang:display({ose_inet_port,OseInetPort}) - end - end; - _ -> - ok - end, - set_hostname(), %% Note: In shortnames (or non-distributed) mode we don't need to know @@ -71,6 +51,7 @@ init() -> %% the user to provide it (by means of inetrc), so we need to look %% for it ourselves. + OsType = os:type(), do_load_resolv(OsType, erl_dist_mode()), case OsType of @@ -226,35 +207,6 @@ do_load_resolv(vxworks, _) -> load_resolv(Resolv, resolv) end; -do_load_resolv({ose,_Type}, _) -> - inet_db:set_lookup([file, dns]), - case os:getenv("NAMESERVER") of - false -> - case os:getenv("RESOLVFILE") of - false -> - erlang:display('Warning: No NAMESERVER or RESOLVFILE specified!'), - no_resolv; - Resolv -> - load_resolv(Resolv, resolv) - end; - Ns -> - {ok,IP} = inet_parse:address(Ns), - inet_db:add_rc_list([{nameserver,IP}]) - end, - case os:getenv("DOMAIN") of - false -> - no_domain; - D -> - ok = inet_db:add_rc_list([{domain,D}]) - end, - case os:getenv("HOSTSFILE") of - false -> - erlang:display('Warning: No HOSTSFILE specified!'), - no_hosts_file; - File -> - load_hosts(File, ose) - end; - do_load_resolv(_, _) -> inet_db:set_lookup([native]). diff --git a/lib/kernel/src/inet_dns_record_adts.pl b/lib/kernel/src/inet_dns_record_adts.pl index b1d8fab939..da50c7114f 100644 --- a/lib/kernel/src/inet_dns_record_adts.pl +++ b/lib/kernel/src/inet_dns_record_adts.pl @@ -2,7 +2,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2009. All Rights Reserved. +# Copyright Ericsson AB 2009-2011. All Rights Reserved. # # The contents of this file are subject to the Erlang Public License, # Version 1.1, (the "License"); you may not use this file except in @@ -73,6 +73,10 @@ while( my ($Name, $r) = each(%Names)) { # "@Values" = "V1,V2"...",VN" my @D = @DATA; foreach my $line (@D) { + # Ignore !name lines + if ($line =~ s/^\!(\S+)\s+//) { + next if $1 eq $Name; + } my $m = 1; # For leading * iterate $n times, otherwise once $line =~ s/^\s*[*]// and $m = $n; @@ -155,9 +159,9 @@ make_Name() -> \ make_Name(L) when is_list(L) -> \ make_Name(#Record{}, L). -%% Generate #Record{} with one updated field -%% -*make_Name(Field, Value) -> \ +!dns_rr_opt %% Generate #Record{} with one updated field +!dns_rr_opt %% +!dns_rr_opt *make_Name(Field, Value) -> \ #Record{Field=Value}; %% %% Update #Record{} from property list diff --git a/lib/kernel/src/inet_res.erl b/lib/kernel/src/inet_res.erl index d1f5644ff7..59ba408d7a 100644 --- a/lib/kernel/src/inet_res.erl +++ b/lib/kernel/src/inet_res.erl @@ -407,7 +407,7 @@ gethostbyname(Name) -> -spec gethostbyname(Name, Family) -> {ok, Hostent} | {error, Reason} when Name :: dns_name(), Hostent :: inet:hostent(), - Family :: inet:family_option(), + Family :: inet:address_family(), Reason :: inet:posix() | res_error(). gethostbyname(Name,Family) -> @@ -418,7 +418,7 @@ gethostbyname(Name,Family) -> Name :: dns_name(), Hostent :: inet:hostent(), Timeout :: timeout(), - Family :: inet:family_option(), + Family :: inet:address_family(), Reason :: inet:posix() | res_error(). gethostbyname(Name,Family,Timeout) -> diff --git a/lib/kernel/src/rpc.erl b/lib/kernel/src/rpc.erl index be35f99ed2..e214ffa404 100644 --- a/lib/kernel/src/rpc.erl +++ b/lib/kernel/src/rpc.erl @@ -662,9 +662,10 @@ async_call(Node, Mod, Fun, Args) -> ReplyTo ! {self(), {promise_reply, R}} %% self() is key end). --spec yield(Key) -> {value, Val} | timeout when +-spec yield(Key) -> Res | {badrpc, Reason} when Key :: key(), - Val :: (Res :: term()) | {badrpc, Reason :: term()}. + Res :: term(), + Reason :: term(). yield(Key) when is_pid(Key) -> {value,R} = do_yield(Key, infinity), diff --git a/lib/kernel/test/application_SUITE.erl b/lib/kernel/test/application_SUITE.erl index 4ae4151004..2c5b8ccb66 100644 --- a/lib/kernel/test/application_SUITE.erl +++ b/lib/kernel/test/application_SUITE.erl @@ -967,7 +967,7 @@ otp_1586(doc) -> ["Test recursive load of applications."]; otp_1586(Conf) when is_list(Conf) -> Dir = ?config(priv_dir,Conf), - {ok, Fd} = file:open(filename:join(Dir, "app5.app"), write), + {ok, Fd} = file:open(filename:join(Dir, "app5.app"), [write]), w_app5(Fd), file:close(Fd), ?line code:add_patha(Dir), @@ -1021,10 +1021,10 @@ otp_2012(Conf) when is_list(Conf) -> ?line yes = global:register_name(conf_change, CcPid), % Write a .app file - {ok, Fd} = file:open("app1.app", write), + {ok, Fd} = file:open("app1.app", [write]), w_app1(Fd), file:close(Fd), - {ok, Fd2} = file:open("app2.app", write), + {ok, Fd2} = file:open("app2.app", [write]), w_app1(Fd2), file:close(Fd2), @@ -1096,7 +1096,7 @@ otp_2973(doc) -> ["Test of two processes simultanously starting the same application."]; otp_2973(Conf) when is_list(Conf) -> % Write a .app file - {ok, Fd} = file:open("app0.app", write), + {ok, Fd} = file:open("app0.app", [write]), w_app(Fd, app0()), file:close(Fd), @@ -1138,7 +1138,7 @@ otp_2973(Conf) when is_list(Conf) -> % Write a .app file - ?line {ok, Fda} = file:open("app_start_error.app", write), + ?line {ok, Fda} = file:open("app_start_error.app", [write]), ?line w_app_start_error(Fda), ?line file:close(Fda), @@ -1273,12 +1273,12 @@ otp_4066(Conf) when is_list(Conf) -> App1Nodes = {app1, AllNodes}, Dir = ?config(priv_dir,Conf), - ?line {ok, FdC} = file:open(filename:join(Dir, "otp_4066.config"), write), + ?line {ok, FdC} = file:open(filename:join(Dir, "otp_4066.config"), [write]), ?line write_config(FdC, config_4066(AllNodes, 5000, [App1Nodes])), ?line file:close(FdC), % Write the app1.app file - ?line {ok, FdA12} = file:open(filename:join(Dir, "app1.app"), write), + ?line {ok, FdA12} = file:open(filename:join(Dir, "app1.app"), [write]), ?line w_app1(FdA12), ?line file:close(FdA12), @@ -1441,7 +1441,7 @@ otp_5606(Conf) when is_list(Conf) -> %% Write a config file Dir = ?config(priv_dir, Conf), - {ok, Fd} = file:open(filename:join(Dir, "sys.config"), write), + {ok, Fd} = file:open(filename:join(Dir, "sys.config"), [write]), NodeNames = [Ncp1, Ncp2] = node_names([cp1, cp2], Conf), (config4(NodeNames))(Fd, 10000), file:close(Fd), @@ -2436,7 +2436,7 @@ start_node_config_sf(Name, SysConfigFun, Conf) -> write_config_file(SysConfigFun, Conf) -> Dir = ?config(priv_dir, Conf), - {ok, Fd} = file:open(filename:join(Dir, "sys.config"), write), + {ok, Fd} = file:open(filename:join(Dir, "sys.config"), [write]), SysConfigFun(Fd), file:close(Fd), filename:join(Dir,"sys"). @@ -2571,15 +2571,15 @@ cc(List) -> create_app() -> ?line Dir = "./", ?line App1 = Dir ++ "app1", - ?line {ok, Fd1} = file:open(App1++".app",write), + ?line {ok, Fd1} = file:open(App1++".app",[write]), ?line io:format(Fd1, "~p. \n", [app1()]), ?line file:close(Fd1), ?line App2 = Dir ++ "app2", - ?line {ok, Fd2} = file:open(App2++".app",write), + ?line {ok, Fd2} = file:open(App2++".app",[write]), ?line io:format(Fd2, "~p. \n", [app2()]), ?line file:close(Fd2), ?line App3 = Dir ++ "app_sp", - ?line {ok, Fd3} = file:open(App3++".app",write), + ?line {ok, Fd3} = file:open(App3++".app",[write]), ?line io:format(Fd3, "~p. \n", [app_sp()]), ?line file:close(Fd3), ok. @@ -2591,7 +2591,7 @@ create_script(ScriptName) -> ?line Apps = which_applications(), ?line {value,{_,_,KernelVer}} = lists:keysearch(kernel,1,Apps), ?line {value,{_,_,StdlibVer}} = lists:keysearch(stdlib,1,Apps), - ?line {ok,Fd} = file:open(Name++".rel",write), + ?line {ok,Fd} = file:open(Name++".rel",[write]), ?line io:format(Fd, "{release, {\"Test release 3\", \"LATEST\"}, \n" " {erts, \"4.4\"}, \n" @@ -2610,7 +2610,7 @@ create_script_dc(ScriptName) -> ?line Apps = which_applications(), ?line {value,{_,_,KernelVer}} = lists:keysearch(kernel,1,Apps), ?line {value,{_,_,StdlibVer}} = lists:keysearch(stdlib,1,Apps), - ?line {ok,Fd} = file:open(Name++".rel",write), + ?line {ok,Fd} = file:open(Name++".rel",[write]), ?line io:format(Fd, "{release, {\"Test release 3\", \"LATEST\"}, \n" " {erts, \"4.4\"}, \n" @@ -2630,7 +2630,7 @@ create_script_3002(ScriptName) -> ?line {value,{_,_,KernelVer}} = lists:keysearch(kernel,1,Apps), ?line {value,{_,_,StdlibVer}} = lists:keysearch(stdlib,1,Apps), ?line {value,{_,_,SaslVer}} = lists:keysearch(sasl,1,Apps), - ?line {ok,Fd} = file:open(Name++".rel",write), + ?line {ok,Fd} = file:open(Name++".rel",[write]), ?line io:format(Fd, "{release, {\"Test release 3\", \"LATEST\"}, \n" " {erts, \"4.4\"}, \n" @@ -2646,22 +2646,22 @@ create_script_3002(ScriptName) -> distr_changed_prep(Conf) when is_list(Conf) -> % Write .app files - ?line {ok, Fd1} = file:open("app1.app", write), + ?line {ok, Fd1} = file:open("app1.app", [write]), ?line w_app1(Fd1), ?line file:close(Fd1), - ?line {ok, Fd2} = file:open("app2.app", write), + ?line {ok, Fd2} = file:open("app2.app", [write]), ?line w_app2(Fd2), ?line file:close(Fd2), - ?line {ok, Fd3} = file:open("app3.app", write), + ?line {ok, Fd3} = file:open("app3.app", [write]), ?line w_app3(Fd3), ?line file:close(Fd3), - ?line {ok, Fd4} = file:open("app6.app", write), + ?line {ok, Fd4} = file:open("app6.app", [write]), ?line w_app6(Fd4), ?line file:close(Fd4), - ?line {ok, Fd5} = file:open("app7.app", write), + ?line {ok, Fd5} = file:open("app7.app", [write]), ?line w_app7(Fd5), ?line file:close(Fd5), - ?line {ok, Fd6} = file:open("app8.app", write), + ?line {ok, Fd6} = file:open("app8.app", [write]), ?line w_app8(Fd6), ?line file:close(Fd6), @@ -2683,7 +2683,7 @@ distr_changed_prep(Conf) when is_list(Conf) -> WithSyncTime = config_fun(config_dc(NodeNames)), ?line Dir = ?config(priv_dir,Conf), - ?line {ok, Fd_dc2} = file:open(filename:join(Dir, "sys2.config"), write), + ?line {ok, Fd_dc2} = file:open(filename:join(Dir, "sys2.config"), [write]), ?line (config_dc2(NodeNames))(Fd_dc2), ?line file:close(Fd_dc2), ?line Config2 = filename:join(Dir, "sys2"), diff --git a/lib/kernel/test/code_SUITE.erl b/lib/kernel/test/code_SUITE.erl index 3ad49254f1..86cccebc29 100644 --- a/lib/kernel/test/code_SUITE.erl +++ b/lib/kernel/test/code_SUITE.erl @@ -258,8 +258,8 @@ replace_path(Config) when is_list(Config) -> %% Add a completly new application. - NewAppName = "blurf_blarfer", - ?line NewAppDir = filename:join(Cwd, NewAppName ++ "-6.33.1"), + NewAppName = 'blurf_blarfer', + ?line NewAppDir = filename:join(Cwd, atom_to_list(NewAppName) ++ "-6.33.1"), ?line ok = file:make_dir(NewAppDir), ?line true = code:replace_path(NewAppName, NewAppDir), ?line NewAppDir = code:lib_dir(NewAppName), @@ -410,8 +410,10 @@ all_loaded_1() -> ?line Loaded2 = match_and_remove(Preloaded, Loaded1), ObjExt = code:objfile_extension(), - ?line [] = lists:filter(fun({Mod,AbsName}) when is_atom(Mod), is_list(AbsName) -> - Mod =:= filename:basename(AbsName, ObjExt); + ?line [] = lists:filter(fun({Mod,AbsName}) when is_atom(Mod), + is_list(AbsName) -> + Mod =/= list_to_atom(filename:basename(AbsName, + ObjExt)); (_) -> true end, Loaded2), @@ -1023,8 +1025,8 @@ mult_lib_roots(Config) when is_list(Config) -> "my_dummy_app-c/ebin/code_SUITE_mult_root_module"), %% Set up ERL_LIBS and start a slave node. - ErlLibs = filename:join(DataDir, first_root) ++ mult_lib_sep() ++ - filename:join(DataDir, second_root), + ErlLibs = filename:join(DataDir, "first_root") ++ mult_lib_sep() ++ + filename:join(DataDir, "second_root"), ?line {ok,Node} = ?t:start_node(mult_lib_roots, slave, @@ -1344,7 +1346,7 @@ create_script(Config) -> ?line Apps = application_controller:which_applications(), ?line {value,{_,_,KernelVer}} = lists:keysearch(kernel, 1, Apps), ?line {value,{_,_,StdlibVer}} = lists:keysearch(stdlib, 1, Apps), - ?line {ok,Fd} = file:open(Name ++ ".rel", write), + ?line {ok,Fd} = file:open(Name ++ ".rel", [write]), ?line io:format(Fd, "{release, {\"Test release 3\", \"P2A\"}, \n" " {erts, \"9.42\"}, \n" @@ -1409,7 +1411,7 @@ create_big_script(Config,Local) -> %% Now we should have only "real" applications... ?line [application:load(list_to_atom(Y)) || {match,[Y]} <- [ re:run(X,code:lib_dir()++"/"++"([^/-]*).*/ebin",[{capture,[1],list}]) || X <- code:get_path()],filter_app(Y,Local)], ?line Apps = [ {N,V} || {N,_,V} <- application:loaded_applications()], - ?line {ok,Fd} = file:open(Name ++ ".rel", write), + ?line {ok,Fd} = file:open(Name ++ ".rel", [write]), ?line io:format(Fd, "{release, {\"Test release 3\", \"P2A\"}, \n" " {erts, \"9.42\"}, \n" diff --git a/lib/kernel/test/disk_log_SUITE.erl b/lib/kernel/test/disk_log_SUITE.erl index 4ae47b4762..ee1e2319b5 100644 --- a/lib/kernel/test/disk_log_SUITE.erl +++ b/lib/kernel/test/disk_log_SUITE.erl @@ -4917,7 +4917,7 @@ mark(FileName, What) -> ok = file:close(Fd). crash(File, Where) -> - {ok, Fd} = file:open(File, read_write), + {ok, Fd} = file:open(File, [read,write]), file:position(Fd, Where), ok = file:write(Fd, [10]), ok = file:close(Fd). @@ -4933,7 +4933,7 @@ writable(Fname) -> file:write_file_info(Fname, Info#file_info{mode = Mode}). truncate(File, Where) -> - {ok, Fd} = file:open(File, read_write), + {ok, Fd} = file:open(File, [read,write]), file:position(Fd, Where), ok = file:truncate(Fd), ok = file:close(Fd). diff --git a/lib/kernel/test/erl_prim_loader_SUITE.erl b/lib/kernel/test/erl_prim_loader_SUITE.erl index f47c4603cf..7599a89779 100644 --- a/lib/kernel/test/erl_prim_loader_SUITE.erl +++ b/lib/kernel/test/erl_prim_loader_SUITE.erl @@ -547,8 +547,6 @@ host() -> stop_node(Node) -> test_server:stop_node(Node). -get_loader_flag({ose,_}) -> - " -loader ose_inet "; get_loader_flag(_) -> " -loader inet ". diff --git a/lib/kernel/test/gen_tcp_api_SUITE.erl b/lib/kernel/test/gen_tcp_api_SUITE.erl index fd4685cdad..cbaec2d6dd 100644 --- a/lib/kernel/test/gen_tcp_api_SUITE.erl +++ b/lib/kernel/test/gen_tcp_api_SUITE.erl @@ -158,6 +158,10 @@ t_shutdown_error(Config) when is_list(Config) -> t_fdopen(Config) when is_list(Config) -> ?line Question = "Aaaa... Long time ago in a small town in Germany,", + ?line Question1 = list_to_binary(Question), + ?line Question2 = [<<"Aaaa">>, "... ", $L, <<>>, $o, "ng time ago ", + ["in ", [], <<"a small town">>, [" in Germany,", <<>>]]], + ?line Question1 = iolist_to_binary(Question2), ?line Answer = "there was a shoemaker, Schumacher was his name.", ?line {ok, L} = gen_tcp:listen(0, [{active, false}]), ?line {ok, Port} = inet:port(L), @@ -167,6 +171,10 @@ t_fdopen(Config) when is_list(Config) -> ?line {ok, Server} = gen_tcp:fdopen(FD, []), ?line ok = gen_tcp:send(Client, Question), ?line {ok, Question} = gen_tcp:recv(Server, length(Question), 2000), + ?line ok = gen_tcp:send(Client, Question1), + ?line {ok, Question} = gen_tcp:recv(Server, length(Question), 2000), + ?line ok = gen_tcp:send(Client, Question2), + ?line {ok, Question} = gen_tcp:recv(Server, length(Question), 2000), ?line ok = gen_tcp:send(Server, Answer), ?line {ok, Answer} = gen_tcp:recv(Client, length(Answer), 2000), ?line ok = gen_tcp:close(Client), diff --git a/lib/kernel/test/gen_udp_SUITE.erl b/lib/kernel/test/gen_udp_SUITE.erl index d8a5519195..514deaf065 100644 --- a/lib/kernel/test/gen_udp_SUITE.erl +++ b/lib/kernel/test/gen_udp_SUITE.erl @@ -201,13 +201,21 @@ binary_passive_recv(suite) -> binary_passive_recv(doc) -> ["OTP-3823 gen_udp:recv does not return address in binary mode"]; binary_passive_recv(Config) when is_list(Config) -> - ?line D = "The quick brown fox jumps over a lazy dog", - ?line B = list_to_binary(D), + ?line D1 = "The quick brown fox jumps over a lazy dog", + ?line D2 = list_to_binary(D1), + ?line D3 = ["The quick", <<" brown ">>, "fox jumps ", <<"over ">>, + <<>>, $a, [[], " lazy ", <<"dog">>]], + ?line D2 = iolist_to_binary(D3), + ?line B = D2, ?line {ok, R} = gen_udp:open(0, [binary, {active, false}]), ?line {ok, RP} = inet:port(R), ?line {ok, S} = gen_udp:open(0), ?line {ok, SP} = inet:port(S), - ?line ok = gen_udp:send(S, localhost, RP, D), + ?line ok = gen_udp:send(S, localhost, RP, D1), + ?line {ok, {{127, 0, 0, 1}, SP, B}} = gen_udp:recv(R, byte_size(B)+1), + ?line ok = gen_udp:send(S, localhost, RP, D2), + ?line {ok, {{127, 0, 0, 1}, SP, B}} = gen_udp:recv(R, byte_size(B)+1), + ?line ok = gen_udp:send(S, localhost, RP, D3), ?line {ok, {{127, 0, 0, 1}, SP, B}} = gen_udp:recv(R, byte_size(B)+1), ?line ok = gen_udp:close(S), ?line ok = gen_udp:close(R), @@ -400,6 +408,7 @@ open_fd(Config) when is_list(Config) -> {ok,S1} = gen_udp:open(0), {ok,P2} = inet:port(S1), {ok,FD} = prim_inet:getfd(S1), + {error,einval} = gen_udp:open(P2, [inet6, {fd,FD}]), {ok,S2} = gen_udp:open(P2, [{fd,FD}]), {ok,S3} = gen_udp:open(0), {ok,P3} = inet:port(S3), diff --git a/lib/kernel/test/global_group_SUITE.erl b/lib/kernel/test/global_group_SUITE.erl index 13b2fd07b5..799b0d9d05 100644 --- a/lib/kernel/test/global_group_SUITE.erl +++ b/lib/kernel/test/global_group_SUITE.erl @@ -100,7 +100,7 @@ start_gg_proc(Config) when is_list(Config) -> ?line Dir = ?config(priv_dir, Config), ?line File = filename:join(Dir, "global_group.config"), - ?line {ok, Fd}=file:open(File, write), + ?line {ok, Fd}=file:open(File, [write]), [Ncp1,Ncp2,Ncp3] = node_names([cp1, cp2, cp3], Config), ?line config(Fd, Ncp1, Ncp2, Ncp3, "cpx", "cpy", "cpz", "cpq"), @@ -135,7 +135,7 @@ no_gg_proc(Config) when is_list(Config) -> ?line Dir = ?config(priv_dir, Config), ?line File = filename:join(Dir, "no_global_group.config"), - ?line {ok, Fd} = file:open(File, write), + ?line {ok, Fd} = file:open(File, [write]), ?line config_no(Fd), ?line NN = node_name(atom_to_list(node())), @@ -308,7 +308,7 @@ no_gg_proc_sync(Config) when is_list(Config) -> ?line Dir = ?config(priv_dir, Config), ?line File = filename:join(Dir, "no_global_group_sync.config"), - ?line {ok, Fd} = file:open(File, write), + ?line {ok, Fd} = file:open(File, [write]), [Ncp1,Ncp2,Ncp3,Ncpx,Ncpy,Ncpz] = node_names([cp1,cp2,cp3,cpx,cpy,cpz], Config), @@ -482,7 +482,7 @@ compatible(Config) when is_list(Config) -> ?line Dir = ?config(priv_dir, Config), ?line File = filename:join(Dir, "global_group_comp.config"), - ?line {ok, Fd} = file:open(File, write), + ?line {ok, Fd} = file:open(File, [write]), [Ncp1,Ncp2,Ncp3,Ncpx,Ncpy,Ncpz] = node_names([cp1,cp2,cp3,cpx,cpy,cpz], Config), @@ -655,7 +655,7 @@ one_grp(Config) when is_list(Config) -> ?line Dir = ?config(priv_dir, Config), ?line File = filename:join(Dir, "global_group.config"), - ?line {ok, Fd} = file:open(File, write), + ?line {ok, Fd} = file:open(File, [write]), [Ncp1,Ncp2,Ncp3] = node_names([cp1, cp2, cp3], Config), ?line config(Fd, Ncp1, Ncp2, Ncp3, "cpx", "cpy", "cpz", "cpq"), @@ -742,7 +742,7 @@ one_grp_x(Config) when is_list(Config) -> ?line Dir = ?config(priv_dir, Config), ?line File = filename:join(Dir, "global_group.config"), - ?line {ok, Fd} = file:open(File, write), + ?line {ok, Fd} = file:open(File, [write]), [Ncp1,Ncp2,Ncp3] = node_names([cp1, cp2, cp3], Config), ?line config(Fd, Ncp1, Ncp2, Ncp3, "cpx", "cpy", "cpz", "cpq"), @@ -804,7 +804,7 @@ two_grp(Config) when is_list(Config) -> ?line Dir = ?config(priv_dir, Config), ?line File = filename:join(Dir, "global_group.config"), - ?line {ok, Fd} = file:open(File, write), + ?line {ok, Fd} = file:open(File, [write]), [Ncp1,Ncp2,Ncp3,Ncpx,Ncpy,Ncpz,Ncpq] = node_names([cp1,cp2,cp3,cpx,cpy,cpz,cpq], Config), @@ -1104,7 +1104,7 @@ hidden_groups(Config) when is_list(Config) -> ?line Dir = ?config(priv_dir, Config), ?line File = filename:join(Dir, "global_group.config"), - ?line {ok, Fd} = file:open(File, write), + ?line {ok, Fd} = file:open(File, [write]), [Ncp1,Ncp2,Ncp3,Ncpx,Ncpy,Ncpz,Ncpq] = node_names([cp1,cp2,cp3,cpx,cpy,cpz,cpq], Config), diff --git a/lib/kernel/test/init_SUITE.erl b/lib/kernel/test/init_SUITE.erl index 2db0f7dcb8..b39fadd65f 100644 --- a/lib/kernel/test/init_SUITE.erl +++ b/lib/kernel/test/init_SUITE.erl @@ -656,7 +656,7 @@ create_script(Config) -> ?line Apps = application_controller:which_applications(), ?line {value,{_,_,KernelVer}} = lists:keysearch(kernel,1,Apps), ?line {value,{_,_,StdlibVer}} = lists:keysearch(stdlib,1,Apps), - ?line {ok,Fd} = file:open(Name ++ ".rel", write), + ?line {ok,Fd} = file:open(Name ++ ".rel", [write]), ?line io:format(Fd, "{release, {\"Test release 3\", \"P2A\"}, \n" " {erts, \"4.4\"}, \n" diff --git a/lib/kernel/test/ram_file_SUITE.erl b/lib/kernel/test/ram_file_SUITE.erl index 9b3fbb91fc..ab95a3ff5f 100644 --- a/lib/kernel/test/ram_file_SUITE.erl +++ b/lib/kernel/test/ram_file_SUITE.erl @@ -552,7 +552,7 @@ large_file_light(Config) when is_list(Config) -> ?line PrivDir = ?config(priv_dir, Config), %% Marker for next test case that is to heavy to run in a suite. ?line ok = ?FILE_MODULE:write_file( - filename:join(PrivDir, large_file_light), + filename:join(PrivDir, "large_file_light"), <<"TAG">>), %% ?line Data = "abcdefghijklmnopqrstuvwzyz", @@ -582,7 +582,7 @@ large_file_heavy(Config) when is_list(Config) -> ?line PrivDir = ?config(priv_dir, Config), %% Check previous test case marker. case ?FILE_MODULE:read_file_info( - filename:join(PrivDir, large_file_light)) of + filename:join(PrivDir, "large_file_light")) of {ok,_} -> {skipped,"Too heavy for casual testing!"}; _ -> diff --git a/lib/kernel/test/zlib_SUITE.erl b/lib/kernel/test/zlib_SUITE.erl index 9eb84c9167..4ad9c6923d 100644 --- a/lib/kernel/test/zlib_SUITE.erl +++ b/lib/kernel/test/zlib_SUITE.erl @@ -412,6 +412,7 @@ api_crc32(Config) when is_list(Config) -> Compressed = list_to_binary(Compressed1 ++ Compressed2), CRC1 = ?m( CRC1 when is_integer(CRC1), zlib:crc32(Z1)), ?m(CRC1 when is_integer(CRC1), zlib:crc32(Z1,Bin)), + ?m(CRC1 when is_integer(CRC1), zlib:crc32(Z1,binary_to_list(Bin))), ?m(CRC2 when is_integer(CRC2), zlib:crc32(Z1,Compressed)), CRC2 = ?m(CRC2 when is_integer(CRC2), zlib:crc32(Z1,0,Compressed)), ?m(CRC3 when CRC2 /= CRC3, zlib:crc32(Z1,234,Compressed)), @@ -437,6 +438,7 @@ api_adler32(Config) when is_list(Config) -> Compressed2 = ?m(_, zlib:deflate(Z1, <<>>, finish)), Compressed = list_to_binary(Compressed1 ++ Compressed2), ?m(ADLER1 when is_integer(ADLER1), zlib:adler32(Z1,Bin)), + ?m(ADLER1 when is_integer(ADLER1), zlib:adler32(Z1,binary_to_list(Bin))), ADLER2 = ?m(ADLER2 when is_integer(ADLER2), zlib:adler32(Z1,Compressed)), ?m(ADLER2 when is_integer(ADLER2), zlib:adler32(Z1,1,Compressed)), ?m(ADLER3 when ADLER2 /= ADLER3, zlib:adler32(Z1,234,Compressed)), @@ -464,6 +466,7 @@ api_un_compress(Config) when is_list(Config) -> ?m({'EXIT',{data_error,_}}, zlib:uncompress(<<120,156,3>>)), ?m({'EXIT',{data_error,_}}, zlib:uncompress(<<120,156,3,0>>)), ?m({'EXIT',{data_error,_}}, zlib:uncompress(<<0,156,3,0,0,0,0,1>>)), + ?m(Bin, zlib:uncompress(binary_to_list(Comp))), ?m(Bin, zlib:uncompress(Comp)). api_un_zip(doc) -> "Test zip"; @@ -472,10 +475,12 @@ api_un_zip(Config) when is_list(Config) -> ?m(?BARG,zlib:zip(not_a_binary)), Bin = <<1,11,1,23,45>>, ?line Comp = zlib:zip(Bin), + ?m(Comp, zlib:zip(binary_to_list(Bin))), ?m(?BARG,zlib:unzip(not_a_binary)), ?m({'EXIT',{data_error,_}}, zlib:unzip(<<171,171,171,171,171>>)), ?m({'EXIT',{data_error,_}}, zlib:unzip(<<>>)), ?m(Bin, zlib:unzip(Comp)), + ?m(Bin, zlib:unzip(binary_to_list(Comp))), %% OTP-6396 B = <<131,104,19,100,0,13,99,95,99,105,100,95,99,115,103,115,110,95,50,97,1,107,0,4,208,161,246,29,107,0,3,237,166,224,107,0,6,66,240,153,0,2,10,1,0,8,97,116,116,97,99,104,101,100,104,2,100,0,22,117,112,100,97,116,101,95,112,100,112,95,99,111,110,116,101,120,116,95,114,101,113,107,0,114,69,3,12,1,11,97,31,113,150,64,104,132,61,64,104,12,3,197,31,113,150,64,104,132,61,64,104,12,1,11,97,31,115,150,64,104,116,73,64,104,0,0,0,0,0,0,65,149,16,61,65,149,16,61,1,241,33,4,5,0,33,4,4,10,6,10,181,4,10,6,10,181,38,15,99,111,109,109,97,110,100,1,114,45,97,112,110,45,49,3,99,111,109,5,109,110,99,57,57,6,109,99,99,50,52,48,4,103,112,114,115,8,0,104,2,104,2,100,0,8,97,99,116,105,118,97,116,101,104,23,100,0,11,112,100,112,95,99,111,110,116,1,120,116,100,0,7,112,114,105,109,97,114,121,97,1,100,0,9,117,110,100,101,102,105,110,101,100,97,1,97,4,97,4,97,7,100,0,9,117,110,100,101,102,105,110,101,100,100,0,9,117,110,100,101,102,105,110,10100,100,0,9,117,110,100,101,102,105,110,101,100,100,0,5,102,97,108,115,101,100,0,9,117,110,100,101,102,105,110,101,100,100,0,9,117,110,100,101,102,105,110,101,100,100,0,9,117,110,100,101,102,105,1,101,100,97,0,100,0,9,117,110,100,101,102,105,110,101,100,107,0,4,16,0,1,144,107,0,4,61,139,186,181,107,0,4,10,8,201,49,100,0,9,117,110,100,101,102,105,110,101,100,100,0,9,117,110,100,101,102,105,0,101,100,100,0,9,117,110,100,101,102,105,110,101,100,104,2,104,3,98,0,0,7,214,97,11,97,20,104,3,97,17,97,16,97,21,106,108,0,0,0,3,104,2,97,1,104,2,104,3,98,0,0,7,214,97,11,97,20,104,3,97,17,97,167,20,104,2,97,4,104,2,104,3,98,0,0,7,214,97,11,97,20,104,3,97,17,97,16,97,21,104,2,97,10,104,2,104,3,98,0,0,7,214,97,11,97,20,104,3,97,17,97,16,97,26,106,100,0,5,118,101,114,57,57,100,0,9,117,110,0,101,102,105,110,101,100,107,0,2,0,244,107,0,4,10,6,102,195,107,0,4,10,6,102,195,100,0,9,117,110,100,101,102,105,110,101,100,100,0,9,117,110,100,101,102,105,110,101,100,107,0,125,248,143,0,203,25115,157,116,65,185,65,172,55,87,164,88,225,50,203,251,115,157,116,65,185,65,172,55,87,164,88,225,50,0,0,82,153,50,0,200,98,87,148,237,193,185,65,149,167,69,144,14,16,153,50,3,81,70,94,13,109,193,1,120,5,181,113,198,118,50,3,81,70,94,13,109,193,185,120,5,181,113,198,118,153,3,81,70,94,13,109,193,185,120,5,181,113,198,118,153,50,16,1,2,3,4,5,6,7,8,9,0,1,2,3,4,5,6,113,92,2,119,128,0,0,108,0,0,1,107,0,114,69,3,12,1,11,97,31,113,150,64,104,132,61,64,104,12,3,11,97,31,113,150,64,104,132,61,64,104,12,1,11,97,31,115,150,64,104,116,73,64,104,0,0,0,0,0,0,65,149,16,61,65,149,16,61,1,241,33,4,0,33,4,4,10,6,10,181,4,10,6,10,181,38,15,99,111,109,109,97,110,100,101,114,45,97,112,110,45,49,3,99,111,109,5,109,110,99,57,57,6,109,99,99,50,52,48,4,103,112,114,115,8,0,106>>, @@ -504,10 +509,12 @@ api_g_un_zip(Config) when is_list(Config) -> ?m(?BARG,zlib:gzip(not_a_binary)), Bin = <<1,11,1,23,45>>, ?line Comp = zlib:gzip(Bin), + ?m(Comp, zlib:gzip(binary_to_list(Bin))), ?m(?BARG, zlib:gunzip(not_a_binary)), ?m(?DATA_ERROR, zlib:gunzip(<<171,171,171,171,171>>)), ?m(?DATA_ERROR, zlib:gunzip(<<>>)), ?m(Bin, zlib:gunzip(Comp)), + ?m(Bin, zlib:gunzip(binary_to_list(Comp))), %% Bad CRC; bad length. BadCrc = bad_crc_data(), @@ -844,6 +851,7 @@ dictionary_usage({run}) -> ?m(ok, zlib:inflateInit(Z2)), ?line {'EXIT',{{need_dictionary,DictID},_}} = (catch zlib:inflate(Z2, Compressed)), ?m(ok, zlib:inflateSetDictionary(Z2, Dict)), + ?m(ok, zlib:inflateSetDictionary(Z2, binary_to_list(Dict))), ?line Uncompressed = ?m(B when is_list(B), zlib:inflate(Z2, [])), ?m(ok, zlib:inflateEnd(Z2)), ?m(ok, zlib:close(Z2)), diff --git a/lib/kernel/vsn.mk b/lib/kernel/vsn.mk index e7b71cc168..8be265e79d 100644 --- a/lib/kernel/vsn.mk +++ b/lib/kernel/vsn.mk @@ -1 +1 @@ -KERNEL_VSN = 2.14.4 +KERNEL_VSN = 2.14.5 diff --git a/lib/mnesia/src/Makefile b/lib/mnesia/src/Makefile index e032f563fa..1c8ec54605 100644 --- a/lib/mnesia/src/Makefile +++ b/lib/mnesia/src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1996-2009. All Rights Reserved. +# Copyright Ericsson AB 1996-2011. All Rights Reserved. # # The contents of this file are subject to the Erlang Public License, # Version 1.1, (the "License"); you may not use this file except in @@ -113,6 +113,8 @@ clean: docs: +$(TARGET_FILES): $(HRL_FILES) + # ---------------------------------------------------- # Special Build Targets # ---------------------------------------------------- diff --git a/lib/mnesia/src/mnesia_controller.erl b/lib/mnesia/src/mnesia_controller.erl index d4b2c7b5cc..1d3bd55b48 100644 --- a/lib/mnesia/src/mnesia_controller.erl +++ b/lib/mnesia/src/mnesia_controller.erl @@ -57,7 +57,8 @@ release_schema_commit_lock/0, create_table/1, get_disc_copy/1, - get_cstructs/0, + get_remote_cstructs/0, % new function + get_cstructs/0, % old function sync_and_block_table_whereabouts/4, sync_del_table_copy_whereabouts/2, block_table/1, @@ -278,9 +279,51 @@ rec_tabs([], _, _, Init) -> unlink(Init), ok. -get_cstructs() -> +%% New function that does exactly what get_cstructs() used to do. +%% When this function is called, we know that the calling node knows +%% how to convert cstructs on the receiving end (should they differ). +get_remote_cstructs() -> call(get_cstructs). +%% Old function kept for backwards compatibility; converts cstructs before sending. +get_cstructs() -> + {cstructs, Cstructs, Running} = call(get_cstructs), + Node = node(group_leader()), + {cstructs, normalize_cstructs(Cstructs, Node), Running}. + +normalize_cstructs(Cstructs, Node) -> + %% backward-compatibility hack; normalize before returning + case rpc:call(Node, mnesia_lib, val, [{schema,cstruct}]) of + {badrpc, _} -> + %% assume it's not a schema merge + Cstructs; + #cstruct{} -> + %% same format + Cstructs; + Cstruct -> + %% some other format + RemoteFields = [F || {F,_} <- rpc:call(Node, mnesia_schema, cs2list, [Cstruct])], + [convert_cs(Cs, RemoteFields) || Cs <- Cstructs] + end. + +convert_cs(Cs, Fields) -> + MyFields = record_info(fields, cstruct), + convert(tl(tuple_to_list(Cs)), MyFields, Fields, []). + +convert([H|T], [F|FsL], [F|FsR], Acc) -> + convert(T, FsL, FsR, [H|Acc]); +convert([H|T], [Fl|FsL] = L, [Fr|FsR] = R, Acc) -> + case {lists:member(Fl, FsR), lists:member(Fr, FsL)} of + {true, false} -> + convert(T, L, FsR, [H|Acc]); + {false, true} -> + %% Field Fl doesn't exist on receiver side; skip. + convert(T, FsL, R, Acc) + end; +convert([], _, _, Acc) -> + list_to_tuple([cstruct|lists:reverse(Acc)]). + + update(Fun) -> call({update,Fun}). diff --git a/lib/mnesia/src/mnesia_dumper.erl b/lib/mnesia/src/mnesia_dumper.erl index 92fd9dfade..daa9e6aff2 100644 --- a/lib/mnesia/src/mnesia_dumper.erl +++ b/lib/mnesia/src/mnesia_dumper.erl @@ -214,7 +214,12 @@ insert_rec(Rec, InPlace, InitBy, LogV) when is_record(Rec, commit) -> {Tid, committed} -> do_insert_rec(Tid, Rec, InPlace, InitBy, LogV); {Tid, aborted} -> - mnesia_schema:undo_prepare_commit(Tid, Rec) + case InitBy of + startup -> + mnesia_schema:undo_prepare_commit(Tid, Rec); + _ -> + ok + end end; insert_rec(H, _InPlace, _InitBy, _LogV) when is_record(H, log_header) -> CurrentVersion = mnesia_log:version(), diff --git a/lib/mnesia/src/mnesia_loader.erl b/lib/mnesia/src/mnesia_loader.erl index e785b795d1..eb83168498 100644 --- a/lib/mnesia/src/mnesia_loader.erl +++ b/lib/mnesia/src/mnesia_loader.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2010. All Rights Reserved. +%% Copyright Ericsson AB 1998-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -27,7 +27,6 @@ net_load_table/4, send_table/3]). --export([old_node_init_table/6]). %% Spawned old node protocol conversion hack -export([spawned_receiver/8]). %% Spawned lock taking process -import(mnesia_lib, [set/2, fatal/2, verbose/2, dbg_out/2]). @@ -36,7 +35,7 @@ val(Var) -> case ?catch_val(Var) of - {'EXIT', Reason} -> mnesia_lib:other_val(Var, Reason); + {'EXIT', Reason} -> mnesia_lib:other_val(Var, Reason); Value -> Value end. @@ -51,7 +50,7 @@ disc_load_table(Tab, Reason) -> ?eval_debug_fun({?MODULE, do_get_disc_copy}, [{tab, Tab}, {reason, Reason}, - {storage, Storage}, + {storage, Storage}, {type, Type}]), do_get_disc_copy2(Tab, Reason, Storage, Type). @@ -63,19 +62,19 @@ do_get_disc_copy2(Tab, Reason, Storage, Type) when Storage == disc_copies -> %% NOW we create the actual table Repair = mnesia_monitor:get_env(auto_repair), Args = [{keypos, 2}, public, named_table, Type], - case Reason of + case Reason of {dumper, _} -> %% Resources allready allocated ignore; _ -> mnesia_monitor:mktab(Tab, Args), - Count = mnesia_log:dcd2ets(Tab, Repair), + Count = mnesia_log:dcd2ets(Tab, Repair), case ets:info(Tab, size) of X when X < Count * 4 -> - ok = mnesia_log:ets2dcd(Tab); + ok = mnesia_log:ets2dcd(Tab); _ -> ignore end - end, + end, mnesia_index:init_index(Tab, Storage), snmpify(Tab, Storage), set({Tab, load_node}, node()), @@ -84,7 +83,7 @@ do_get_disc_copy2(Tab, Reason, Storage, Type) when Storage == disc_copies -> do_get_disc_copy2(Tab, Reason, Storage, Type) when Storage == ram_copies -> Args = [{keypos, 2}, public, named_table, Type], - case Reason of + case Reason of {dumper, _} -> %% Resources allready allocated ignore; _ -> @@ -94,12 +93,12 @@ do_get_disc_copy2(Tab, Reason, Storage, Type) when Storage == ram_copies -> Repair = mnesia_monitor:get_env(auto_repair), case mnesia_monitor:use_dir() of true -> - case mnesia_lib:exists(Fname) of + case mnesia_lib:exists(Fname) of true -> mnesia_log:dcd2ets(Tab, Repair); false -> case mnesia_lib:exists(Datname) of true -> - mnesia_lib:dets_to_ets(Tab, Tab, Datname, + mnesia_lib:dets_to_ets(Tab, Tab, Datname, Type, Repair, no); false -> false @@ -154,11 +153,11 @@ do_get_disc_copy2(Tab, Reason, Storage, Type) when Storage == disc_only_copies - %% Disable rehashing of table %% Release read lock on table %% Send table to receiver in chunks -%% +%% %% Grab read lock on table %% Block dirty updates %% Update wherabouts -%% +%% %% Cancel the update subscription %% Process the subscription events %% Optionally dump to disc @@ -166,7 +165,7 @@ do_get_disc_copy2(Tab, Reason, Storage, Type) when Storage == disc_only_copies - %% Release read lock on table %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% --define(MAX_TRANSFER_SIZE, 7500). +-define(MAX_TRANSFER_SIZE, 7500). -define(MAX_RAM_FILE_SIZE, 1000000). -define(MAX_RAM_TRANSFERS, (?MAX_RAM_FILE_SIZE div ?MAX_TRANSFER_SIZE) + 1). -define(MAX_NOPACKETS, 20). @@ -187,14 +186,14 @@ try_net_load_table(Tab, Reason, Ns, Cs) -> do_get_network_copy(Tab, _Reason, _Ns, unknown, _Cs) -> verbose("Local table copy of ~p has recently been deleted, ignored.~n", [Tab]), {not_loaded, storage_unknown}; -do_get_network_copy(Tab, Reason, Ns, Storage, Cs) -> +do_get_network_copy(Tab, Reason, Ns, Storage, Cs) -> [Node | Tail] = Ns, case lists:member(Node,val({current, db_nodes})) of true -> dbg_out("Getting table ~p (~p) from node ~p: ~p~n", [Tab, Storage, Node, Reason]), ?eval_debug_fun({?MODULE, do_get_network_copy}, - [{tab, Tab}, {reason, Reason}, + [{tab, Tab}, {reason, Reason}, {nodes, Ns}, {storage, Storage}]), case init_receiver(Node, Tab, Storage, Cs, Reason) of ok -> @@ -208,7 +207,7 @@ do_get_network_copy(Tab, Reason, Ns, Storage, Cs) -> restart -> try_net_load_table(Tab, Reason, Tail ++ [Node], Cs); down -> - try_net_load_table(Tab, Reason, Tail, Cs) + try_net_load_table(Tab, Reason, Tail, Cs) end; false -> try_net_load_table(Tab, Reason, Tail, Cs) @@ -223,10 +222,10 @@ do_snmpify(Tab, Us, Storage) -> Snmp = mnesia_snmp_hook:create_table(Us, Tab, Storage), set({Tab, {index, snmp}}, Snmp). -%% Start the recieiver +%% Start the recieiver init_receiver(Node, Tab, Storage, Cs, Reas={dumper,add_table_copy}) -> case start_remote_sender(Node, Tab, Storage) of - {SenderPid, TabSize, DetsData} -> + {SenderPid, TabSize, DetsData} -> start_receiver(Tab,Storage,Cs,SenderPid,TabSize,DetsData,Reas); Else -> Else @@ -234,21 +233,21 @@ init_receiver(Node, Tab, Storage, Cs, Reas={dumper,add_table_copy}) -> init_receiver(Node, Tab,Storage,Cs,Reason) -> %% Grab a schema lock to avoid deadlock between table_loader and schema_commit dumping. %% Both may grab tables-locks in different order. - Load = - fun() -> - {_,Tid,Ts} = get(mnesia_activity_state), + Load = + fun() -> + {_,Tid,Ts} = get(mnesia_activity_state), mnesia_locker:rlock(Tid, Ts#tidstore.store, {schema, Tab}), - %% Check that table still exists + %% Check that table still exists Active = val({Tab, active_replicas}), %% Check that we havn't loaded it already case val({Tab,where_to_read}) == node() of true -> ok; _ -> - %% And that sender still got a copy - %% (something might have happend while + %% And that sender still got a copy + %% (something might have happend while %% we where waiting for the lock) true = lists:member(Node, Active), - {SenderPid, TabSize, DetsData} = + {SenderPid, TabSize, DetsData} = start_remote_sender(Node,Tab,Storage), Init = table_init_fun(SenderPid), Args = [self(),Tab,Storage,Cs,SenderPid, @@ -258,18 +257,18 @@ init_receiver(Node, Tab,Storage,Cs,Reason) -> wait_on_load_complete(Pid) end end, - Res = + Res = case mnesia:transaction(Load, 20) of - {atomic, {error,Result}} when - element(1,Reason) == dumper -> + {atomic, {error,Result}} when + element(1,Reason) == dumper -> {error,Result}; - {atomic, {error,Result}} -> + {atomic, {error,Result}} -> fatal("Cannot create table ~p: ~p~n", [[Tab, Storage], Result]); {atomic, Result} -> Result; {aborted, nomore} -> restart; - {aborted, _Reas} -> - verbose("Receiver failed on ~p from ~p:~nReason: ~p~n", + {aborted, _Reas} -> + verbose("Receiver failed on ~p from ~p:~nReason: ~p~n", [Tab,Node,_Reas]), down %% either this node or sender is dying end, @@ -279,7 +278,7 @@ init_receiver(Node, Tab,Storage,Cs,Reason) -> start_remote_sender(Node,Tab,Storage) -> mnesia_controller:start_remote_sender(Node, Tab, self(), Storage), put(mnesia_table_sender_node, {Tab, Node}), - receive + receive {SenderPid, {first, TabSize}} -> {SenderPid, TabSize, false}; {SenderPid, {first, TabSize, DetsData}} -> @@ -291,22 +290,14 @@ start_remote_sender(Node,Tab,Storage) -> end. table_init_fun(SenderPid) -> - PConv = mnesia_monitor:needs_protocol_conversion(node(SenderPid)), - MeMyselfAndI = self(), fun(read) -> - Receiver = - if - PConv == true -> - MeMyselfAndI ! {actual_tabrec, self()}, - MeMyselfAndI; %% Old mnesia - PConv == false -> self() - end, + Receiver = self(), SenderPid ! {Receiver, more}, get_data(SenderPid, Receiver) end. %% Add_table_copy get's it's own locks. -start_receiver(Tab,Storage,Cs,SenderPid,TabSize,DetsData,{dumper,add_table_copy}) -> +start_receiver(Tab,Storage,Cs,SenderPid,TabSize,DetsData,{dumper,add_table_copy}) -> Init = table_init_fun(SenderPid), case do_init_table(Tab,Storage,Cs,SenderPid,TabSize,DetsData,self(), Init) of Err = {error, _} -> @@ -317,8 +308,8 @@ start_receiver(Tab,Storage,Cs,SenderPid,TabSize,DetsData,{dumper,add_table_copy} end. spawned_receiver(ReplyTo,Tab,Storage,Cs, SenderPid,TabSize,DetsData, Init) -> - process_flag(trap_exit, true), - Done = do_init_table(Tab,Storage,Cs, + process_flag(trap_exit, true), + Done = do_init_table(Tab,Storage,Cs, SenderPid,TabSize,DetsData, ReplyTo, Init), ReplyTo ! {self(),Done}, @@ -327,17 +318,17 @@ spawned_receiver(ReplyTo,Tab,Storage,Cs, SenderPid,TabSize,DetsData, Init) -> exit(normal). wait_on_load_complete(Pid) -> - receive - {Pid, Res} -> + receive + {Pid, Res} -> Res; - {'EXIT', Pid, Reason} -> + {'EXIT', Pid, Reason} -> exit(Reason); - Else -> + Else -> Pid ! Else, wait_on_load_complete(Pid) end. -do_init_table(Tab,Storage,Cs,SenderPid, +do_init_table(Tab,Storage,Cs,SenderPid, TabSize,DetsInfo,OrigTabRec,Init) -> case create_table(Tab, TabSize, Storage, Cs) of {Storage,Tab} -> @@ -345,11 +336,9 @@ do_init_table(Tab,Storage,Cs,SenderPid, Node = node(SenderPid), put(mnesia_table_receiver, {Tab, Node, SenderPid}), mnesia_tm:block_tab(Tab), - PConv = mnesia_monitor:needs_protocol_conversion(Node), - - case init_table(Tab,Storage,Init,PConv,DetsInfo,SenderPid) of - ok -> - tab_receiver(Node,Tab,Storage,Cs,PConv,OrigTabRec); + case init_table(Tab,Storage,Init,DetsInfo,SenderPid) of + ok -> + tab_receiver(Node,Tab,Storage,Cs,OrigTabRec); Reason -> Msg = "[d]ets:init table failed", verbose("~s: ~p: ~p~n", [Msg, Tab, Reason]), @@ -360,7 +349,7 @@ do_init_table(Tab,Storage,Cs,SenderPid, end. create_table(Tab, TabSize, Storage, Cs) -> - if + if Storage == disc_only_copies -> mnesia_lib:lock_table(Tab), Tmp = mnesia_lib:tab2tmp(Tab), @@ -390,54 +379,30 @@ create_table(Tab, TabSize, Storage, Cs) -> end end. -tab_receiver(Node, Tab, Storage, Cs, PConv, OrigTabRec) -> +tab_receiver(Node, Tab, Storage, Cs, OrigTabRec) -> receive - {SenderPid, {no_more, DatBin}} when PConv == false -> + {SenderPid, {no_more, DatBin}} -> finish_copy(Storage,Tab,Cs,SenderPid,DatBin,OrigTabRec); - - %% Protocol conversion hack - {SenderPid, {no_more, DatBin}} when is_pid(PConv) -> - PConv ! {SenderPid, no_more}, - receive - {old_init_table_complete, ok} -> - finish_copy(Storage, Tab, Cs, SenderPid, DatBin,OrigTabRec); - {old_init_table_complete, Reason} -> - Msg = "OLD: [d]ets:init table failed", - verbose("~s: ~p: ~p~n", [Msg, Tab, Reason]), - down(Tab, Storage) - end; - - {actual_tabrec, Pid} -> - tab_receiver(Node, Tab, Storage, Cs, Pid,OrigTabRec); - - {SenderPid, {more, [Recs]}} when is_pid(PConv) -> - PConv ! {SenderPid, {more, Recs}}, %% Forward Msg to OldNodes - tab_receiver(Node, Tab, Storage, Cs, PConv,OrigTabRec); - {'EXIT', PConv, Reason} -> %% [d]ets:init process crashed - Msg = "Receiver crashed", - verbose("~s: ~p: ~p~n", [Msg, Tab, Reason]), - down(Tab, Storage); - %% Protocol conversion hack {copier_done, Node} -> verbose("Sender of table ~p crashed on node ~p ~n", [Tab, Node]), down(Tab, Storage); - + {'EXIT', Pid, Reason} -> handle_exit(Pid, Reason), - tab_receiver(Node, Tab, Storage, Cs, PConv,OrigTabRec) + tab_receiver(Node, Tab, Storage, Cs, OrigTabRec) end. make_table_fun(Pid, TabRec) -> fun(close) -> ok; (read) -> - get_data(Pid, TabRec) + get_data(Pid, TabRec) end. get_data(Pid, TabRec) -> - receive + receive {Pid, {more_z, CompressedRecs}} when is_binary(CompressedRecs) -> Pid ! {TabRec, more}, {zlib_uncompress(CompressedRecs), make_table_fun(Pid,TabRec)}; @@ -448,7 +413,7 @@ get_data(Pid, TabRec) -> end_of_input; {copier_done, Node} -> case node(Pid) of - Node -> + Node -> {copier_done, Node}; _ -> get_data(Pid, TabRec) @@ -458,10 +423,10 @@ get_data(Pid, TabRec) -> get_data(Pid, TabRec) end. -init_table(Tab, disc_only_copies, Fun, false, DetsInfo,Sender) -> +init_table(Tab, disc_only_copies, Fun, DetsInfo,Sender) -> ErtsVer = erlang:system_info(version), case DetsInfo of - {ErtsVer, DetsData} -> + {ErtsVer, DetsData} -> Res = (catch dets:is_compatible_bchunk_format(Tab, DetsData)), case Res of {'EXIT',{undef,[{dets,_,_}|_]}} -> @@ -481,28 +446,19 @@ init_table(Tab, disc_only_copies, Fun, false, DetsInfo,Sender) -> _ -> dets:init_table(Tab, Fun) end; -init_table(Tab, _, Fun, false, _DetsInfo,_) -> +init_table(Tab, _, Fun, _DetsInfo,_) -> case catch ets:init_table(Tab, Fun) of true -> ok; {'EXIT', Else} -> Else - end; -init_table(Tab, Storage, Fun, true, _DetsInfo, Sender) -> %% Old Nodes - spawn_link(?MODULE, old_node_init_table, - [Tab, Storage, Fun, self(), false, Sender]), - ok. + end. -old_node_init_table(Tab, Storage, Fun, TabReceiver, DetsInfo,Sender) -> - Res = init_table(Tab, Storage, Fun, false, DetsInfo,Sender), - TabReceiver ! {old_init_table_complete, Res}, - unlink(TabReceiver), - ok. finish_copy(Storage,Tab,Cs,SenderPid,DatBin,OrigTabRec) -> TabRef = {Storage, Tab}, subscr_receiver(TabRef, Cs#cstruct.record_name), case handle_last(TabRef, Cs#cstruct.type, DatBin) of - ok -> + ok -> mnesia_index:init_index(Tab, Storage), snmpify(Tab, Storage), %% OrigTabRec must not be the spawned tab-receiver @@ -534,7 +490,7 @@ subscr_receiver(TabRef = {_, Tab}, RecName) -> ok end. -handle_event(TabRef, write, Rec) -> +handle_event(TabRef, write, Rec) -> db_put(TabRef, Rec); handle_event(TabRef, delete, {_Tab, Key}) -> db_erase(TabRef, Key); @@ -545,8 +501,8 @@ handle_event(TabRef, clear_table, {_Tab, _Key}) -> handle_last({disc_copies, Tab}, _Type, nobin) -> Ret = mnesia_log:ets2dcd(Tab), - Fname = mnesia_lib:tab2dat(Tab), - case mnesia_lib:exists(Fname) of + Fname = mnesia_lib:tab2dat(Tab), + case mnesia_lib:exists(Fname) of true -> %% Remove old .DAT files. file:delete(Fname); false -> @@ -653,31 +609,29 @@ send_table(Pid, Tab, RemoteS) -> {error, {no_exists, Tab}}; Storage -> %% Send first - TabSize = mnesia:table_info(Tab, size), - Pconvert = mnesia_monitor:needs_protocol_conversion(node(Pid)), + TabSize = mnesia:table_info(Tab, size), KeysPerTransfer = calc_nokeys(Storage, Tab), ChunkData = dets:info(Tab, bchunk_format), - UseDetsChunk = - Storage == RemoteS andalso - Storage == disc_only_copies andalso - ChunkData /= undefined andalso - Pconvert == false, - if + UseDetsChunk = + Storage == RemoteS andalso + Storage == disc_only_copies andalso + ChunkData /= undefined, + if UseDetsChunk == true -> DetsInfo = erlang:system_info(version), Pid ! {self(), {first, TabSize, {DetsInfo, ChunkData}}}; true -> Pid ! {self(), {first, TabSize}} end, - + %% Debug info put(mnesia_table_sender, {Tab, node(Pid), Pid}), {Init, Chunk} = reader_funcs(UseDetsChunk, Tab, Storage, KeysPerTransfer), - + SendIt = fun() -> prepare_copy(Pid, Tab, Storage), - send_more(Pid, 1, Chunk, Init(), Tab, Pconvert), + send_more(Pid, 1, Chunk, Init(), Tab), finish_copy(Pid, Tab, Storage, RemoteS) end, @@ -698,7 +652,7 @@ send_table(Pid, Tab, RemoteS) -> {error, Reason} end end. - + prepare_copy(Pid, Tab, Storage) -> Trans = fun() -> @@ -717,11 +671,11 @@ prepare_copy(Pid, Tab, Storage) -> update_where_to_write(Tab, Node) -> case val({Tab, access_mode}) of - read_only -> + read_only -> ignore; - read_write -> + read_write -> Current = val({current, db_nodes}), - Ns = + Ns = case lists:member(Node, Current) of true -> Current; false -> [Node | Current] @@ -729,27 +683,27 @@ update_where_to_write(Tab, Node) -> update_where_to_write(Ns, Tab, Node) end. -update_where_to_write([], _, _) -> +update_where_to_write([], _, _) -> ok; update_where_to_write([H|T], Tab, AddNode) -> - rpc:call(H, mnesia_controller, call, + rpc:call(H, mnesia_controller, call, [{update_where_to_write, [add, Tab, AddNode], self()}]), update_where_to_write(T, Tab, AddNode). -send_more(Pid, N, Chunk, DataState, Tab, OldNode) -> +send_more(Pid, N, Chunk, DataState, Tab) -> receive {NewPid, more} -> - case send_packet(N - 1, NewPid, Chunk, DataState, OldNode) of - New when is_integer(New) -> + case send_packet(N - 1, NewPid, Chunk, DataState) of + New when is_integer(New) -> New - 1; NewData -> - send_more(NewPid, ?MAX_NOPACKETS, Chunk, NewData, Tab, OldNode) + send_more(NewPid, ?MAX_NOPACKETS, Chunk, NewData, Tab) end; {_NewPid, {old_protocol, Tab}} -> Storage = val({Tab, storage_type}), - {Init, NewChunk} = + {Init, NewChunk} = reader_funcs(false, Tab, Storage, calc_nokeys(Storage, Tab)), - send_more(Pid, 1, NewChunk, Init(), Tab, OldNode); + send_more(Pid, 1, NewChunk, Init(), Tab); {copier_done, Node} when Node == node(Pid)-> verbose("Receiver of table ~p crashed on ~p (more)~n", [Tab, Node]), @@ -770,7 +724,7 @@ dets_bchunk(Tab, Chunk) -> %% Arrg case dets:bchunk(Tab, Chunk) of {Cont, Data} -> {Data, Cont}; Else -> Else - end. + end. zlib_compress(Data, Level) -> BinData = term_to_binary(Data), @@ -793,28 +747,20 @@ compression_level() -> Val -> Val end. -send_packet(N, Pid, _Chunk, '$end_of_table', OldNode) -> - case OldNode of - true -> ignore; %% Old nodes can't handle the new no_more - false -> Pid ! {self(), no_more} - end, +send_packet(N, Pid, _Chunk, '$end_of_table') -> + Pid ! {self(), no_more}, N; -send_packet(N, Pid, Chunk, {[], Cont}, OldNode) -> - send_packet(N, Pid, Chunk, Chunk(Cont), OldNode); -send_packet(N, Pid, Chunk, {Recs, Cont}, OldNode) when N < ?MAX_NOPACKETS -> - case OldNode of - true -> - Pid ! {self(), {more, [Recs]}}; %% Old need's wrapping list - false -> - case compression_level() of - 0 -> - Pid ! {self(), {more, Recs}}; - Level -> - Pid ! {self(), {more_z, zlib_compress(Recs, Level)}} - end +send_packet(N, Pid, Chunk, {[], Cont}) -> + send_packet(N, Pid, Chunk, Chunk(Cont)); +send_packet(N, Pid, Chunk, {Recs, Cont}) when N < ?MAX_NOPACKETS -> + case compression_level() of + 0 -> + Pid ! {self(), {more, Recs}}; + Level -> + Pid ! {self(), {more_z, zlib_compress(Recs, Level)}} end, - send_packet(N+1, Pid, Chunk, Chunk(Cont), OldNode); -send_packet(_N, _Pid, _Chunk, DataState, _OldNode) -> + send_packet(N+1, Pid, Chunk, Chunk(Cont)); +send_packet(_N, _Pid, _Chunk, DataState) -> DataState. finish_copy(Pid, Tab, Storage, RemoteS) -> @@ -855,5 +801,5 @@ dat2bin(_Tab, _LocalS, _RemoteS) -> handle_exit(Pid, Reason) when node(Pid) == node() -> exit(Reason); -handle_exit(_Pid, _Reason) -> %% Not from our node, this will be handled by +handle_exit(_Pid, _Reason) -> %% Not from our node, this will be handled by ignore. %% mnesia_down soon. diff --git a/lib/mnesia/src/mnesia_monitor.erl b/lib/mnesia/src/mnesia_monitor.erl index b6eda9ad3a..e110ad3241 100644 --- a/lib/mnesia/src/mnesia_monitor.erl +++ b/lib/mnesia/src/mnesia_monitor.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% Copyright Ericsson AB 1996-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -76,13 +76,13 @@ -include("mnesia.hrl"). --record(state, {supervisor, pending_negotiators = [], +-record(state, {supervisor, pending_negotiators = [], going_down = [], tm_started = false, early_connects = [], connecting, mq = []}). --define(current_protocol_version, {7,6}). +-define(current_protocol_version, {8,0}). --define(previous_protocol_version, {7,5}). +-define(previous_protocol_version, {7,6}). start() -> gen_server:start_link({local, ?MODULE}, ?MODULE, @@ -151,12 +151,12 @@ check_protocol([{Node, {accept, Mon, Version, Protocol}} | Tail], Protocols) -> case lists:member(Protocol, Protocols) of true -> case Protocol == protocol_version() of - true -> + true -> set({protocol, Node}, {Protocol, false}); false -> set({protocol, Node}, {Protocol, true}) end, - [node(Mon) | check_protocol(Tail, Protocols)]; + [node(Mon) | check_protocol(Tail, Protocols)]; false -> verbose("Failed to connect with ~p. ~p protocols rejected. " "expected version = ~p, expected protocol = ~p~n", @@ -179,7 +179,7 @@ check_protocol([], [Protocol | _Protocols]) -> set(protocol_version, Protocol), []. -protocol_version() -> +protocol_version() -> case ?catch_val(protocol_version) of {'EXIT', _} -> ?current_protocol_version; Version -> Version @@ -189,14 +189,14 @@ protocol_version() -> %% preferred protocols are first in the list acceptable_protocol_versions() -> [protocol_version(), ?previous_protocol_version]. - + needs_protocol_conversion(Node) -> case {?catch_val({protocol, Node}), protocol_version()} of {{'EXIT', _}, _} -> false; - {{_, Bool}, ?current_protocol_version} -> + {{_, Bool}, ?current_protocol_version} -> Bool; - {{_, Bool}, _} -> + {{_, Bool}, _} -> not Bool end. @@ -255,15 +255,15 @@ terminate_proc(Who, Reason, _State) -> %%---------------------------------------------------------------------- init([Parent]) -> process_flag(trap_exit, true), - ?ets_new_table(mnesia_gvar, [set, public, named_table]), - ?ets_new_table(mnesia_stats, [set, public, named_table]), + ?ets_new_table(mnesia_gvar, [set, public, named_table]), + ?ets_new_table(mnesia_stats, [set, public, named_table]), set(subscribers, []), set(activity_subscribers, []), mnesia_lib:verbose("~p starting: ~p~n", [?MODULE, self()]), Version = mnesia:system_info(version), set(version, Version), dbg_out("Version: ~p~n", [Version]), - + case catch process_config_args(env()) of ok -> mnesia_lib:set({'$$$_report', current_pos}, 0), @@ -283,7 +283,7 @@ init([Parent]) -> set(checkpoints, []), set(pending_checkpoints, []), set(pending_checkpoint_pids, []), - + {ok, #state{supervisor = Parent}}; {'EXIT', Reason} -> mnesia_lib:report_fatal("Bad configuration: ~p~n", [Reason]), @@ -398,9 +398,9 @@ handle_call({unsafe_close_log, Name}, _From, State) -> disk_log:close(Name), {reply, ok, State}; -handle_call({negotiate_protocol, Mon, _Version, _Protocols}, _From, State) +handle_call({negotiate_protocol, Mon, _Version, _Protocols}, _From, State) when State#state.tm_started == false -> - State2 = State#state{early_connects = [node(Mon) | State#state.early_connects]}, + State2 = State#state{early_connects = [node(Mon) | State#state.early_connects]}, {reply, {node(), {reject, self(), uninitialized, uninitialized}}, State2}; %% From remote monitor.. @@ -412,7 +412,7 @@ handle_call({negotiate_protocol, Mon, Version, Protocols}, From, State) true -> accept_protocol(Mon, MyVersion, Protocol, From, State); false -> - %% in this release we should be able to handle the previous + %% in this release we should be able to handle the previous %% protocol case hd(Protocols) of ?previous_protocol_version -> @@ -427,7 +427,7 @@ handle_call({negotiate_protocol, Mon, Version, Protocols}, From, State) end; %% Local request to negotiate with other monitors (nodes). -handle_call({negotiate_protocol, Nodes}, From, State) -> +handle_call({negotiate_protocol, Nodes}, From, State) -> case mnesia_lib:intersect(State#state.going_down, Nodes) of [] -> spawn_link(?MODULE, negotiate_protocol_impl, [Nodes, From]), @@ -461,7 +461,7 @@ accept_protocol(Mon, Version, Protocol, From, State) -> %% No need for wait link(Mon), %% link to remote Monitor case Protocol == protocol_version() of - true -> + true -> set({protocol, Node}, {Protocol, false}); false -> set({protocol, Node}, {Protocol, true}) @@ -509,7 +509,7 @@ handle_cast({disconnect, Node}, State) -> ignore; undefined -> ignore; - RemoteMon when is_pid(RemoteMon) -> + RemoteMon when is_pid(RemoteMon) -> unlink(RemoteMon) end, {noreply, State}; @@ -534,7 +534,7 @@ handle_info({'EXIT', Pid, R}, State) when Pid == State#state.supervisor -> dbg_out("~p was ~p by supervisor~n",[?MODULE, R]), {stop, R, State}; -handle_info({'EXIT', Pid, fatal}, State) when node(Pid) == node() -> +handle_info({'EXIT', Pid, fatal}, State) when node(Pid) == node() -> dbg_out("~p got FATAL ERROR from: ~p~n",[?MODULE, Pid]), exit(State#state.supervisor, shutdown), {noreply, State}; @@ -550,7 +550,7 @@ handle_info(Msg = {'EXIT',Pid,_}, State) -> Node /= node() -> {noreply, State#state{mq = State#state.mq ++ [{info, Msg}]}}; true -> - %% We have probably got an exit signal from + %% We have probably got an exit signal from %% disk_log or dets Hint = "Hint: check that the disk still is writable", fatal("~p got unexpected info: ~p; ~p~n", @@ -567,10 +567,10 @@ handle_info({nodeup, Node}, State) -> %% Let's check if Mnesia is running there in order %% to detect if the network has been partitioned %% due to communication failure. - + HasDown = mnesia_recover:has_mnesia_down(Node), ImRunning = mnesia_lib:is_running(), - + if %% If I'm not running the test will be made later. HasDown == true, ImRunning == yes -> @@ -589,7 +589,7 @@ handle_info({disk_log, _Node, Log, Info}, State) -> {truncated, _No} -> ok; _ -> - mnesia_lib:important("Warning Log file ~p error reason ~s~n", + mnesia_lib:important("Warning Log file ~p error reason ~s~n", [Log, disk_log:format_error(Info)]) end, {noreply, State}; @@ -681,38 +681,38 @@ env() -> send_compressed ]. -default_env(access_module) -> +default_env(access_module) -> mnesia; -default_env(auto_repair) -> +default_env(auto_repair) -> true; -default_env(backup_module) -> +default_env(backup_module) -> mnesia_backup; -default_env(debug) -> +default_env(debug) -> none; default_env(dir) -> Name = lists:concat(["Mnesia.", node()]), filename:absname(Name); -default_env(dump_log_load_regulation) -> +default_env(dump_log_load_regulation) -> false; -default_env(dump_log_time_threshold) -> +default_env(dump_log_time_threshold) -> timer:minutes(3); -default_env(dump_log_update_in_place) -> +default_env(dump_log_update_in_place) -> true; default_env(dump_log_write_threshold) -> 1000; -default_env(embedded_mnemosyne) -> +default_env(embedded_mnemosyne) -> false; -default_env(event_module) -> +default_env(event_module) -> mnesia_event; -default_env(extra_db_nodes) -> +default_env(extra_db_nodes) -> []; -default_env(ignore_fallback_at_startup) -> +default_env(ignore_fallback_at_startup) -> false; default_env(fallback_error_function) -> {mnesia, lkill}; -default_env(max_wait_for_decision) -> +default_env(max_wait_for_decision) -> infinity; -default_env(schema_location) -> +default_env(schema_location) -> opt_disc; default_env(core_dir) -> false; @@ -732,7 +732,7 @@ check_type(Env, Val) -> NewVal -> NewVal end. - + do_check_type(access_module, A) when is_atom(A) -> A; do_check_type(auto_repair, B) -> bool(B); do_check_type(backup_module, B) when is_atom(B) -> B; @@ -749,7 +749,7 @@ do_check_type(dump_log_update_in_place, B) -> bool(B); do_check_type(dump_log_write_threshold, I) when is_integer(I), I > 0 -> I; do_check_type(event_module, A) when is_atom(A) -> A; do_check_type(ignore_fallback_at_startup, B) -> bool(B); -do_check_type(fallback_error_function, {Mod, Func}) +do_check_type(fallback_error_function, {Mod, Func}) when is_atom(Mod), is_atom(Func) -> {Mod, Func}; do_check_type(embedded_mnemosyne, B) -> bool(B); do_check_type(extra_db_nodes, L) when is_list(L) -> @@ -804,8 +804,8 @@ detect_inconcistency(Nodes, Context) -> has_remote_mnesia_down(Node) -> HasDown = mnesia_recover:has_mnesia_down(Node), Master = mnesia_recover:get_master_nodes(schema), - if - HasDown == true, Master == [] -> + if + HasDown == true, Master == [] -> {true, node()}; true -> {false, node()} diff --git a/lib/mnesia/src/mnesia_schema.erl b/lib/mnesia/src/mnesia_schema.erl index fef72ad39c..05be474aea 100644 --- a/lib/mnesia/src/mnesia_schema.erl +++ b/lib/mnesia/src/mnesia_schema.erl @@ -100,7 +100,7 @@ ]). %% Needed outside to be able to use/set table_properties -%% from user (not supported) +%% from user (not supported) -export([schema_transaction/1, insert_schema_ops/2, do_create_table/1, @@ -118,9 +118,9 @@ %% Here comes the init function which also resides in %% this module, it is called upon by the trans server %% at startup of the system -%% +%% %% We have a meta table which looks like -%% {table, schema, +%% {table, schema, %% {type, set}, %% {disc_copies, all}, %% {arity, 2} @@ -149,14 +149,14 @@ exit_on_error(GoodRes) -> val(Var) -> case ?catch_val(Var) of - {'EXIT', Reason} -> mnesia_lib:other_val(Var, Reason); - Value -> Value + {'EXIT', Reason} -> mnesia_lib:other_val(Var, Reason); + Value -> Value end. %% This function traverses all cstructs in the schema and %% sets all values in mnesia_gvar accordingly for each table/cstruct -set_schema('$end_of_table') -> +set_schema('$end_of_table') -> []; set_schema(Tab) -> do_set_schema(Tab), @@ -253,8 +253,8 @@ version() -> incr_version(Cs) -> {{Major, Minor}, _} = Cs#cstruct.version, Nodes = mnesia_lib:intersect(val({schema, disc_copies}), - mnesia_lib:cs_to_nodes(Cs)), - V = + mnesia_lib:cs_to_nodes(Cs)), + V = case Nodes -- val({Cs#cstruct.name, active_replicas}) of [] -> {Major + 1, 0}; % All replicas are active _ -> {Major, Minor + 1} % Some replicas are inactive @@ -359,7 +359,7 @@ delete_schema2() -> {error, Reason} -> {error, Reason} end. - + ensure_no_schema([H|T]) when is_atom(H) -> case rpc:call(H, ?MODULE, remote_read_schema, []) of {badrpc, Reason} -> @@ -407,7 +407,7 @@ opt_create_dir(UseDir, Dir) when UseDir == true-> check_can_write(Dir); false -> case file:make_dir(Dir) of - ok -> + ok -> verbose("Create Directory ~p~n", [Dir]), ok; {error, Reason} -> @@ -417,7 +417,7 @@ opt_create_dir(UseDir, Dir) when UseDir == true-> end; opt_create_dir(false, _) -> {error, {has_no_disc, node()}}. - + check_can_write(Dir) -> case file:read_file_info(Dir) of {ok, FI} when FI#file_info.type == directory, @@ -450,7 +450,7 @@ read_schema(Keep) -> read_schema(Keep, IgnoreFallback) -> lock_schema(), - Res = + Res = case mnesia:system_info(is_running) of yes -> {ok, ram, get_create_list(schema)}; @@ -477,7 +477,7 @@ read_disc_schema(Keep, IgnoreFallback) -> case mnesia_bup:fallback_exists() of true when IgnoreFallback == false, Running /= yes -> mnesia_bup:fallback_to_schema(); - _ -> + _ -> %% If we're running, we read the schema file even %% if fallback exists Dat = mnesia_lib:tab2dat(schema), @@ -499,7 +499,7 @@ read_disc_schema(Keep, IgnoreFallback) -> end. do_read_disc_schema(Fname, Keep) -> - T = + T = case Keep of false -> Args = [{keypos, 2}, public, set], @@ -523,7 +523,7 @@ do_read_disc_schema(Fname, Keep) -> get_initial_schema(SchemaStorage, Nodes) -> Cs = #cstruct{name = schema, record_name = schema, - attributes = [table, cstruct]}, + attributes = [table, cstruct]}, Cs2 = case SchemaStorage of ram_copies -> Cs#cstruct{ram_copies = Nodes}; @@ -532,7 +532,7 @@ get_initial_schema(SchemaStorage, Nodes) -> cs2list(Cs2). read_cstructs_from_disc() -> - %% Assumptions: + %% Assumptions: %% - local schema lock in global %% - use_dir is true %% - Mnesia is not running @@ -552,14 +552,14 @@ read_cstructs_from_disc() -> end, Cstructs = dets:traverse(Tab, Fun), dets:close(Tab), - {ok, Cstructs}; + {ok, Cstructs}; {error, Reason} -> {error, Reason} end; false -> {error, "No schema file exists"} end. - + %% We run a very special type of transactions when we %% we want to manipulate the schema. @@ -593,20 +593,20 @@ schema_transaction(Fun) -> %% This process may dump the transaction log, and should %% therefore not be run in an application process -%% +%% schema_coordinator(Client, _Fun, undefined) -> Res = {aborted, {node_not_running, node()}}, Client ! {transaction_done, Res, self()}, unlink(Client); - + schema_coordinator(Client, Fun, Controller) when is_pid(Controller) -> %% Do not trap exit in order to automatically die %% when the controller dies link(Controller), unlink(Client), - - %% Fulfull the transaction even if the client dies + + %% Fulfull the transaction even if the client dies Res = mnesia:transaction(Fun), Client ! {transaction_done, Res, self()}, unlink(Controller), % Avoids spurious exit message @@ -619,7 +619,7 @@ schema_coordinator(Client, Fun, Controller) when is_pid(Controller) -> insert_schema_ops({_Mod, _Tid, Ts}, SchemaIOps) -> do_insert_schema_ops(Ts#tidstore.store, SchemaIOps). - + do_insert_schema_ops(Store, [Head | Tail]) -> ?ets_insert(Store, Head), do_insert_schema_ops(Store, Tail); @@ -628,15 +628,56 @@ do_insert_schema_ops(_Store, []) -> cs2list(Cs) when is_record(Cs, cstruct) -> Tags = record_info(fields, cstruct), - rec2list(Tags, 2, Cs); + rec2list(Tags, Tags, 2, Cs); cs2list(CreateList) when is_list(CreateList) -> - CreateList. - -rec2list([Tag | Tags], Pos, Rec) -> + CreateList; +%% 4.4.19 +cs2list(Cs) when element(1, Cs) == cstruct, tuple_size(Cs) == 18 -> + Tags = [name,type,ram_copies,disc_copies,disc_only_copies, + load_order,access_mode,majority,index,snmp,local_content, + record_name,attributes,user_properties,frag_properties, + cookie,version], + rec2list(Tags, Tags, 2, Cs); +%% 4.4.18 and earlier +cs2list(Cs) when element(1, Cs) == cstruct, tuple_size(Cs) == 17 -> + Tags = [name,type,ram_copies,disc_copies,disc_only_copies, + load_order,access_mode,index,snmp,local_content, + record_name,attributes,user_properties,frag_properties, + cookie,version], + rec2list(Tags, Tags, 2, Cs). + +cs2list(false, Cs) -> + cs2list(Cs); +cs2list(ver4_4_18, Cs) -> + Orig = record_info(fields, cstruct), + Tags = [name,type,ram_copies,disc_copies,disc_only_copies, + load_order,access_mode,index,snmp,local_content, + record_name,attributes,user_properties,frag_properties, + cookie,version], + rec2list(Tags, Orig, 2, Cs); +cs2list(ver4_4_19, Cs) -> + Orig = record_info(fields, cstruct), + Tags = [name,type,ram_copies,disc_copies,disc_only_copies, + load_order,access_mode,majority,index,snmp,local_content, + record_name,attributes,user_properties,frag_properties, + cookie,version], + rec2list(Tags, Orig, 2, Cs). + +rec2list([Tag | Tags], [Tag | Orig], Pos, Rec) -> Val = element(Pos, Rec), - [{Tag, Val} | rec2list(Tags, Pos + 1, Rec)]; -rec2list([], _Pos, _Rec) -> - []. + [{Tag, Val} | rec2list(Tags, Orig, Pos + 1, Rec)]; +rec2list([], _, _Pos, _Rec) -> + []; +rec2list(Tags, [_|Orig], Pos, Rec) -> + rec2list(Tags, Orig, Pos+1, Rec). + +api_list2cs(List) when is_list(List) -> + Name = pick(unknown, name, List, must), + Keys = check_keys(Name, List, record_info(fields, cstruct)), + check_duplicates(Name, Keys), + list2cs(List); +api_list2cs(Other) -> + mnesia:abort({badarg, Other}). list2cs(List) when is_list(List) -> Name = pick(unknown, name, List, must), @@ -667,10 +708,7 @@ list2cs(List) when is_list(List) -> Frag = pick(Name, frag_properties, List, []), verify({alt, [nil, list]}, mnesia_lib:etype(Frag), - {badarg, Name, {frag_properties, Frag}}), - - Keys = check_keys(Name, List, record_info(fields, cstruct)), - check_duplicates(Name, Keys), + {badarg, Name, {frag_properties, Frag}}), #cstruct{name = Name, ram_copies = Rc, disc_copies = Dc, @@ -687,9 +725,7 @@ list2cs(List) when is_list(List) -> user_properties = lists:sort(UserProps), frag_properties = lists:sort(Frag), cookie = Cookie, - version = Version}; -list2cs(Other) -> - mnesia:abort({badarg, Other}). + version = Version}. pick(Tab, Key, List, Default) -> case lists:keysearch(Key, 1, List) of @@ -708,7 +744,7 @@ attr_tab_to_pos(_Tab, Pos) when is_integer(Pos) -> Pos; attr_tab_to_pos(Tab, Attr) -> attr_to_pos(Attr, val({Tab, attributes})). - + %% Convert attribute name to integer if neccessary attr_to_pos(Pos, _Attrs) when is_integer(Pos) -> Pos; @@ -723,7 +759,7 @@ attr_to_pos(Attr, [_ | Attrs], Pos) -> attr_to_pos(Attr, Attrs, Pos + 1); attr_to_pos(Attr, _, _) -> mnesia:abort({bad_type, Attr}). - + check_keys(Tab, [{Key, _Val} | Tail], Items) -> case lists:member(Key, Items) of true -> [Key | check_keys(Tab, Tail, Items)]; @@ -759,7 +795,7 @@ verify_cstruct(Cs) when is_record(Cs, cstruct) -> {bad_type, Tab, {type, Type}}), %% Currently ordered_set is not supported for disk_only_copies. - if + if Type == ordered_set, Cs#cstruct.disc_only_copies /= [] -> mnesia:abort({bad_type, Tab, {not_supported, Type, disc_only_copies}}); true -> @@ -776,10 +812,10 @@ verify_cstruct(Cs) when is_record(Cs, cstruct) -> Arity = length(Attrs) + 1, verify(true, Arity > 2, {bad_type, Tab, {attributes, Attrs}}), - + lists:foldl(fun(Attr,_Other) when Attr == snmp -> mnesia:abort({bad_type, Tab, {attributes, [Attr]}}); - (Attr,Other) -> + (Attr,Other) -> verify(atom, mnesia_lib:etype(Attr), {bad_type, Tab, {attributes, [Attr]}}), verify(false, lists:member(Attr, Other), @@ -792,7 +828,7 @@ verify_cstruct(Cs) when is_record(Cs, cstruct) -> Index = Cs#cstruct.index, verify({alt, [nil, list]}, mnesia_lib:etype(Index), {bad_type, Tab, {index, Index}}), - + IxFun = fun(Pos) -> verify(true, fun() -> @@ -807,7 +843,7 @@ verify_cstruct(Cs) when is_record(Cs, cstruct) -> {bad_type, Tab, {index, [Pos]}}) end, lists:foreach(IxFun, Index), - + LC = Cs#cstruct.local_content, verify({alt, [true, false]}, LC, {bad_type, Tab, {local_content, LC}}), @@ -834,7 +870,7 @@ verify_cstruct(Cs) when is_record(Cs, cstruct) -> lists:foreach(CheckProp, Cs#cstruct.user_properties), case Cs#cstruct.cookie of - {{MegaSecs, Secs, MicroSecs}, _Node} + {{MegaSecs, Secs, MicroSecs}, _Node} when is_integer(MegaSecs), is_integer(Secs), is_integer(MicroSecs), is_atom(node) -> ok; @@ -870,15 +906,15 @@ verify_nodes(Cs) -> end, verify(integer, mnesia_lib:etype(LoadOrder), {bad_type, Tab, {load_order, LoadOrder}}), - + Nodes = Ram ++ Disc ++ DiscOnly, verify(list, mnesia_lib:etype(Nodes), {combine_error, Tab, [{ram_copies, []}, {disc_copies, []}, {disc_only_copies, []}]}), verify(false, has_duplicates(Nodes), {combine_error, Tab, Nodes}), - AtomCheck = fun(N) -> verify(atom, mnesia_lib:etype(N), {bad_type, Tab, N}) end, + AtomCheck = fun(N) -> verify(atom, mnesia_lib:etype(N), {bad_type, Tab, N}) end, lists:foreach(AtomCheck, Nodes). - + verify(Expected, Fun, Error) when is_function(Fun) -> do_verify(Expected, catch Fun(), Error); verify(Expected, Actual, Error) -> @@ -909,7 +945,7 @@ ensure_active(Cs, What) -> W = {Tab, What}, ensure_non_empty(W), Nodes = mnesia_lib:intersect(val({schema, disc_copies}), - mnesia_lib:cs_to_nodes(Cs)), + mnesia_lib:cs_to_nodes(Cs)), case Nodes -- val(W) of [] -> ok; @@ -936,7 +972,7 @@ ensure_non_empty({Tab, Vhat}) -> ensure_not_active(Tab = schema, Node) -> Active = val({Tab, active_replicas}), - case lists:member(Node, Active) of + case lists:member(Node, Active) of false when Active =/= [] -> ok; false -> @@ -970,7 +1006,7 @@ create_table(TabDef) -> do_multi_create_table(TabDef) -> get_tid_ts_and_lock(schema, write), ensure_writable(schema), - Cs = list2cs(TabDef), + Cs = api_list2cs(TabDef), case Cs#cstruct.frag_properties of [] -> do_create_table(Cs); @@ -999,7 +1035,7 @@ unsafe_make_create_table(Cs) -> {_Mod, Tid, Ts} = get_tid_ts_and_lock(schema, none), verify_cstruct(Cs), Tab = Cs#cstruct.name, - + %% Check that we have all disc replica nodes running DiscNodes = Cs#cstruct.disc_copies ++ Cs#cstruct.disc_only_copies, RunningNodes = val({current, db_nodes}), @@ -1017,7 +1053,7 @@ unsafe_make_create_table(Cs) -> check_if_exists(Tab) -> TidTs = get_tid_ts_and_lock(schema, write), {_, _, Ts} = TidTs, - Store = Ts#tidstore.store, + Store = Ts#tidstore.store, ets:foldl( fun({op, create_table, [{name, T}|_]}, _Acc) when T==Tab -> true; @@ -1054,7 +1090,7 @@ make_delete_table(Tab, Mode) -> %% nodes etc. TidTs = get_tid_ts_and_lock(schema, write), {_, _, Ts} = TidTs, - Store = Ts#tidstore.store, + Store = Ts#tidstore.store, Deleted = ets:select_delete( Store, [{{op,'$1',[{name,Tab}|'_']}, [{'or', @@ -1077,9 +1113,9 @@ make_delete_table(Tab, Mode) -> [] -> [make_delete_table2(Tab)]; _Props -> - %% Check if it is a base table - mnesia_frag:lookup_frag_hash(Tab), - + %% Check if it is a base table + mnesia_frag:lookup_frag_hash(Tab), + %% Check for foreigners F = mnesia_frag:lookup_foreigners(Tab), verify([], F, {combine_error, @@ -1101,7 +1137,7 @@ make_delete_table2(Tab) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Change fragmentation of a table - + change_table_frag(Tab, Change) -> schema_transaction(fun() -> do_change_table_frag(Tab, Change) end). @@ -1112,7 +1148,7 @@ do_change_table_frag(Tab, Change) when is_atom(Tab), Tab /= schema -> ok; do_change_table_frag(Tab, _Change) -> mnesia:abort({bad_type, Tab}). - + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Clear a table @@ -1150,7 +1186,7 @@ make_add_table_copy(Tab, Node, Storage) -> verify(false, lists:member(Node, Ns), {already_exists, Tab, Node}), Cs2 = new_cs(Cs, Node, Storage, add), verify_cstruct(Cs2), - + %% Check storage and if node is running IsRunning = lists:member(Node, val({current, db_nodes})), if @@ -1177,21 +1213,21 @@ del_table_copy(Tab, Node) -> do_del_table_copy(Tab, Node) when is_atom(Node) -> TidTs = get_tid_ts_and_lock(schema, write), -%% get_tid_ts_and_lock(Tab, write), +%% get_tid_ts_and_lock(Tab, write), insert_schema_ops(TidTs, make_del_table_copy(Tab, Node)); do_del_table_copy(Tab, Node) -> mnesia:abort({badarg, Tab, Node}). - + make_del_table_copy(Tab, Node) -> ensure_writable(schema), Cs = incr_version(val({Tab, cstruct})), Storage = mnesia_lib:schema_cs_to_storage_type(Node, Cs), - Cs2 = new_cs(Cs, Node, Storage, del), + Cs2 = new_cs(Cs, Node, Storage, del), case mnesia_lib:cs_to_nodes(Cs2) of [] when Tab == schema -> mnesia:abort({combine_error, Tab, "Last replica"}); [] -> - ensure_active(Cs), + ensure_active(Cs), dbg_out("Last replica deleted in table ~p~n", [Tab]), make_delete_table(Tab, whole_table); _ when Tab == schema -> @@ -1210,14 +1246,14 @@ remove_node_from_tabs([], _Node) -> []; remove_node_from_tabs([schema|Rest], Node) -> remove_node_from_tabs(Rest, Node); -remove_node_from_tabs([Tab|Rest], Node) -> - {Cs, IsFragModified} = +remove_node_from_tabs([Tab|Rest], Node) -> + {Cs, IsFragModified} = mnesia_frag:remove_node(Node, incr_version(val({Tab, cstruct}))), case mnesia_lib:schema_cs_to_storage_type(Node, Cs) of unknown -> case IsFragModified of true -> - [{op, change_table_frag, {del_node, Node}, cs2list(Cs)} | + [{op, change_table_frag, {del_node, Node}, cs2list(Cs)} | remove_node_from_tabs(Rest, Node)]; false -> remove_node_from_tabs(Rest, Node) @@ -1246,7 +1282,7 @@ new_cs(Cs, Node, ram_copies, del) -> new_cs(Cs, Node, disc_copies, del) -> Cs#cstruct{disc_copies = lists:delete(Node , Cs#cstruct.disc_copies)}; new_cs(Cs, Node, disc_only_copies, del) -> - Cs#cstruct{disc_only_copies = + Cs#cstruct{disc_only_copies = lists:delete(Node , Cs#cstruct.disc_only_copies)}; new_cs(Cs, _Node, Storage, _Op) -> mnesia:abort({badarg, Cs#cstruct.name, Storage}). @@ -1278,7 +1314,7 @@ make_move_table(Tab, FromNode, ToNode) -> Running = val({current, db_nodes}), Storage = mnesia_lib:schema_cs_to_storage_type(FromNode, Cs), verify(true, lists:member(ToNode, Running), {not_active, schema, ToNode}), - + Cs2 = new_cs(Cs, ToNode, Storage, add), Cs3 = new_cs(Cs2, FromNode, Storage, del), verify_cstruct(Cs3), @@ -1306,7 +1342,7 @@ make_change_table_copy_type(Tab, Node, unknown) -> make_change_table_copy_type(Tab, Node, ToS) -> ensure_writable(schema), Cs = incr_version(val({Tab, cstruct})), - FromS = mnesia_lib:storage_type_at_node(Node, Tab), + FromS = mnesia_lib:storage_type_at_node(Node, Tab), case compare_storage_type(false, FromS, ToS) of {same, _} -> @@ -1320,12 +1356,12 @@ make_change_table_copy_type(Tab, Node, ToS) -> Cs2 = new_cs(Cs, Node, FromS, del), Cs3 = new_cs(Cs2, Node, ToS, add), verify_cstruct(Cs3), - + [{op, change_table_copy_type, Node, FromS, ToS, cs2list(Cs3)}]. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% change index functions .... -%% Pos is allready added by 1 in both of these functions +%% Pos is allready added by 1 in both of these functions add_table_index(Tab, Pos) -> schema_transaction(fun() -> do_add_table_index(Tab, Pos) end). @@ -1412,14 +1448,14 @@ make_del_snmp(Tab) -> [{op, del_snmp, cs2list(Cs2)}]. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% +%% -transform_table(Tab, Fun, NewAttrs, NewRecName) - when is_function(Fun), is_list(NewAttrs), is_atom(NewRecName) -> +transform_table(Tab, Fun, NewAttrs, NewRecName) + when is_function(Fun), is_list(NewAttrs), is_atom(NewRecName) -> schema_transaction(fun() -> do_transform_table(Tab, Fun, NewAttrs, NewRecName) end); -transform_table(Tab, ignore, NewAttrs, NewRecName) - when is_list(NewAttrs), is_atom(NewRecName) -> +transform_table(Tab, ignore, NewAttrs, NewRecName) + when is_list(NewAttrs), is_atom(NewRecName) -> schema_transaction(fun() -> do_transform_table(Tab, ignore, NewAttrs, NewRecName) end); transform_table(Tab, Fun, NewAttrs, NewRecName) -> @@ -1438,7 +1474,7 @@ make_transform(Tab, Fun, NewAttrs, NewRecName) -> ensure_active(Cs), ensure_writable(Tab), case mnesia_lib:val({Tab, index}) of - [] -> + [] -> Cs2 = Cs#cstruct{attributes = NewAttrs, record_name = NewRecName}, verify_cstruct(Cs2), [{op, transform, Fun, cs2list(Cs2)}]; @@ -1464,7 +1500,7 @@ make_transform(Tab, Fun, NewAttrs, NewRecName) -> end. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% +%% change_table_access_mode(Tab, Mode) -> schema_transaction(fun() -> do_change_table_access_mode(Tab, Mode) end). @@ -1598,9 +1634,9 @@ change_prop_in_existing_op(Tab, Prop, How, Store) -> false -> false end. - -update_existing_op([{op, Op, L = [{name,Tab}|_], _OldProp}|Ops], - Tab, Prop, How, Acc) when Op == write_property; + +update_existing_op([{op, Op, L = [{name,Tab}|_], _OldProp}|Ops], + Tab, Prop, How, Acc) when Op == write_property; Op == delete_property -> %% Apparently, mnesia_dumper doesn't care about OldProp here -- just L, %% so we will throw away OldProp (not that it matters...) and insert Prop. @@ -1625,7 +1661,7 @@ update_existing_op([], _, _, _, _) -> do_read_table_property(Tab, Key) -> TidTs = get_tid_ts_and_lock(schema, read), {_, _, Ts} = TidTs, - Store = Ts#tidstore.store, + Store = Ts#tidstore.store, Props = ets:foldl( fun({op, create_table, [{name, T}|Opts]}, _Acc) when T==Tab -> @@ -1689,7 +1725,7 @@ do_delete_table_property(Tab, PropKey) -> [Tab,PropKey]), %% this must be an existing table get_tid_ts_and_lock(Tab, none), - insert_schema_ops(TidTs, + insert_schema_ops(TidTs, make_delete_table_properties(Tab, [PropKey])) end. @@ -1711,17 +1747,17 @@ make_delete_table_properties(_Tab, [], _Cs) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Ensure that the transaction can be committed even +%% Ensure that the transaction can be committed even %% if the node crashes and Mnesia is restarted prepare_commit(Tid, Commit, WaitFor) -> case Commit#commit.schema_ops of [] -> {false, Commit, optional}; OrigOps -> - {Modified, Ops, DumperMode} = + {Modified, Ops, DumperMode} = prepare_ops(Tid, OrigOps, WaitFor, false, [], optional), InitBy = schema_prepare, - GoodRes = {Modified, + GoodRes = {Modified, Commit#commit{schema_ops = lists:reverse(Ops)}, DumperMode}, case DumperMode of @@ -1737,7 +1773,7 @@ prepare_commit(Tid, Commit, WaitFor) -> end end, case Ops of - [] -> + [] -> ignore; _ -> %% We need to grab a dumper lock here, the log may not @@ -1749,20 +1785,20 @@ prepare_commit(Tid, Commit, WaitFor) -> prepare_ops(Tid, [Op | Ops], WaitFor, Changed, Acc, DumperMode) -> case prepare_op(Tid, Op, WaitFor) of - {true, mandatory} -> + {true, mandatory} -> prepare_ops(Tid, Ops, WaitFor, Changed, [Op | Acc], mandatory); - {true, optional} -> + {true, optional} -> prepare_ops(Tid, Ops, WaitFor, Changed, [Op | Acc], DumperMode); - {true, Ops2, mandatory} -> + {true, Ops2, mandatory} -> prepare_ops(Tid, Ops, WaitFor, true, Ops2 ++ Acc, mandatory); - {true, Ops2, optional} -> + {true, Ops2, optional} -> prepare_ops(Tid, Ops, WaitFor, true, Ops2 ++ Acc, DumperMode); - {false, optional} -> + {false, optional} -> prepare_ops(Tid, Ops, WaitFor, true, Acc, DumperMode) end; prepare_ops(_Tid, [], _WaitFor, Changed, Acc, DumperMode) -> {Changed, Acc, DumperMode}. - + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Prepare for commit %% returns true if Op should be included, i.e. unmodified @@ -1781,8 +1817,8 @@ prepare_op(_Tid, {op, rec, unknown, Rec}, _WaitFor) -> prepare_op(_Tid, {op, announce_im_running, Node, SchemaDef, Running, RemoteRunning}, _WaitFor) -> SchemaCs = list2cs(SchemaDef), - if - Node == node() -> %% Announce has already run on local node + if + Node == node() -> %% Announce has already run on local node ignore; %% from do_merge_schema true -> %% If a node has restarted it may still linger in db_nodes, @@ -1794,9 +1830,9 @@ prepare_op(_Tid, {op, announce_im_running, Node, SchemaDef, Running, RemoteRunni end, {false, optional}; -prepare_op(_Tid, {op, sync_trans}, {part, CoordPid}) -> +prepare_op(_Tid, {op, sync_trans}, {part, CoordPid}) -> CoordPid ! {sync_trans, self()}, - receive + receive {sync_trans, CoordPid} -> {false, optional}; {mnesia_down, _Node} = Else -> @@ -1807,7 +1843,7 @@ prepare_op(_Tid, {op, sync_trans}, {part, CoordPid}) -> mnesia:abort(Else) end; -prepare_op(_Tid, {op, sync_trans}, {coord, Nodes}) -> +prepare_op(_Tid, {op, sync_trans}, {coord, Nodes}) -> case receive_sync(Nodes, []) of {abort, Reason} -> mnesia_lib:verbose("sync_op terminated due to ~p~n", [Reason]), @@ -1838,7 +1874,7 @@ prepare_op(Tid, {op, create_table, TabDef}, _WaitFor) -> create_ram_table(Tab, Cs#cstruct.type), create_disc_table(Tab), insert_cstruct(Tid, Cs, false), - {true, optional}; + {true, optional}; disc_only_copies -> mnesia_lib:set({Tab, create_table},true), create_disc_only_table(Tab,Cs#cstruct.type), @@ -1857,15 +1893,15 @@ prepare_op(Tid, {op, add_table_copy, Storage, Node, TabDef}, _WaitFor) -> if Tab == schema -> {true, optional}; - + Node == node() -> - case mnesia_lib:val({schema, storage_type}) of - ram_copies when Storage /= ram_copies -> + case mnesia_lib:val({schema, storage_type}) of + ram_copies when Storage /= ram_copies -> Error = {combine_error, Tab, "has no disc", Node}, mnesia:abort(Error); _ -> ok - end, + end, %% Tables are created by mnesia_loader get_network code insert_cstruct(Tid, Cs, true), case mnesia_controller:get_network_copy(Tab, Cs) of @@ -1902,22 +1938,22 @@ prepare_op(Tid, {op, add_table_copy, Storage, Node, TabDef}, _WaitFor) -> prepare_op(Tid, {op, del_table_copy, _Storage, Node, TabDef}, _WaitFor) -> Cs = list2cs(TabDef), Tab = Cs#cstruct.name, - + if %% Schema table lock is always required to run a schema op. %% No need to look it. - node(Tid#tid.pid) == node(), Tab /= schema -> + node(Tid#tid.pid) == node(), Tab /= schema -> Self = self(), Pid = spawn_link(fun() -> lock_del_table(Tab, Node, Cs, Self) end), put(mnesia_lock, Pid), - receive - {Pid, updated} -> + receive + {Pid, updated} -> {true, optional}; {Pid, FailReason} -> mnesia:abort(FailReason); {'EXIT', Pid, Reason} -> mnesia:abort(Reason) - end; + end; true -> {true, optional} end; @@ -1928,12 +1964,12 @@ prepare_op(_Tid, {op, change_table_copy_type, N, FromS, ToS, TabDef}, _WaitFor) Tab = Cs#cstruct.name, NotActive = mnesia_lib:not_active_here(Tab), - - if + + if NotActive == true -> mnesia:abort({not_active, Tab, node()}); - - Tab == schema -> + + Tab == schema -> case {FromS, ToS} of {ram_copies, disc_copies} -> case mnesia:system_info(schema_location) of @@ -1943,7 +1979,7 @@ prepare_op(_Tid, {op, change_table_copy_type, N, FromS, ToS, TabDef}, _WaitFor) mnesia:abort({combine_error, Tab, node(), "schema_location must be opt_disc"}) end, - Dir = mnesia_lib:dir(), + Dir = mnesia_lib:dir(), case opt_create_dir(true, Dir) of ok -> purge_dir(Dir, []), @@ -1967,18 +2003,18 @@ prepare_op(_Tid, {op, change_table_copy_type, N, FromS, ToS, TabDef}, _WaitFor) _ -> mnesia:abort({combine_error, Tab, ToS}) end; - - FromS == ram_copies -> + + FromS == ram_copies -> case mnesia_monitor:use_dir() of - true -> + true -> Dat = mnesia_lib:tab2dcd(Tab), case mnesia_lib:exists(Dat) of true -> mnesia:abort({combine_error, Tab, node(), "Table dump exists"}); false -> - case ToS of - disc_copies -> + case ToS of + disc_copies -> mnesia_log:ets2dcd(Tab, dmp); disc_only_copies -> mnesia_dumper:raw_named_dump_table(Tab, dmp) @@ -1988,7 +2024,7 @@ prepare_op(_Tid, {op, change_table_copy_type, N, FromS, ToS, TabDef}, _WaitFor) false -> mnesia:abort({has_no_disc, node()}) end; - + FromS == disc_copies, ToS == disc_only_copies -> mnesia_dumper:raw_named_dump_table(Tab, dmp); FromS == disc_only_copies -> @@ -2020,7 +2056,7 @@ prepare_op(_Tid, {op, dump_table, unknown, TabDef}, _WaitFor) -> case lists:member(node(), Cs#cstruct.ram_copies) of true -> case mnesia_monitor:use_dir() of - true -> + true -> mnesia_log:ets2dcd(Tab, dmp), Size = mnesia:table_info(Tab, size), {true, [{op, dump_table, Size, TabDef}], optional}; @@ -2058,7 +2094,7 @@ prepare_op(_Tid, {op, transform, Fun, TabDef}, _WaitFor) -> mnesia_lib:db_fixtable(Storage, Tab, true), Key = mnesia_lib:db_first(Tab), Op = {op, transform, Fun, TabDef}, - case catch transform_objs(Fun, Tab, RecName, + case catch transform_objs(Fun, Tab, RecName, Key, NewArity, Storage, Type, [Op]) of {'EXIT', Reason} -> mnesia_lib:db_fixtable(Storage, Tab, false), @@ -2072,7 +2108,7 @@ prepare_op(_Tid, {op, transform, Fun, TabDef}, _WaitFor) -> prepare_op(_Tid, {op, merge_schema, TabDef}, _WaitFor) -> Cs = list2cs(TabDef), case verify_merge(Cs) of - ok -> + ok -> {true, optional}; Error -> verbose("Merge_Schema ~p failed on ~p: ~p~n", [_Tid,node(),Error]), @@ -2093,7 +2129,7 @@ create_ram_table(Tab, Type) -> create_disc_table(Tab) -> File = mnesia_lib:tab2dcd(Tab), file:delete(File), - FArg = [{file, File}, {name, {mnesia,create}}, + FArg = [{file, File}, {name, {mnesia,create}}, {repair, false}, {mode, read_write}], case mnesia_monitor:open_log(FArg) of {ok,Log} -> @@ -2124,7 +2160,7 @@ receive_sync([], Pids) -> receive_sync(Nodes, Pids) -> receive {sync_trans, Pid} -> - Node = node(Pid), + Node = node(Pid), receive_sync(lists:delete(Node, Nodes), [Pid | Pids]); Else -> {abort, Else} @@ -2140,16 +2176,16 @@ lock_del_table(Tab, Node, Cs, Father) -> false; ({badrpc, {'EXIT', {undef, _}}}) -> %% This will be the case we talks with elder nodes - %% than 3.8.2, they will set where_to_read without - %% getting a lock. + %% than 3.8.2, they will set where_to_read without + %% getting a lock. false; (_) -> true end, case lists:filter(Filter, Res) of - [] -> + [] -> Father ! {self(), updated}, - %% When transaction is commited the process dies + %% When transaction is commited the process dies %% and the lock is released. receive _ -> ok end; Err -> @@ -2166,7 +2202,7 @@ lock_del_table(Tab, Node, Cs, Father) -> exit(normal). set_where_to_read(Tab, Node, Cs) -> - case mnesia_lib:val({Tab, where_to_read}) of + case mnesia_lib:val({Tab, where_to_read}) of Node -> case Cs#cstruct.local_content of true -> @@ -2185,16 +2221,16 @@ transform_objs(_Fun, _Tab, _RT, '$end_of_table', _NewArity, _Storage, _Type, Acc transform_objs(Fun, Tab, RecName, Key, A, Storage, Type, Acc) -> Objs = mnesia_lib:db_get(Tab, Key), NextKey = mnesia_lib:db_next_key(Tab, Key), - Oid = {Tab, Key}, + Oid = {Tab, Key}, NewObjs = {Ws, Ds} = transform_obj(Tab, RecName, Key, Fun, Objs, A, Type, [], []), - if - NewObjs == {[], []} -> + if + NewObjs == {[], []} -> transform_objs(Fun, Tab, RecName, NextKey, A, Storage, Type, Acc); - Type == bag -> + Type == bag -> transform_objs(Fun, Tab, RecName, NextKey, A, Storage, Type, [{op, rec, Storage, {Oid, Ws, write}}, {op, rec, Storage, {Oid, [Oid], delete}} | Acc]); - Ds == [] -> + Ds == [] -> %% Type is set or ordered_set, no need to delete the record first transform_objs(Fun, Tab, RecName, NextKey, A, Storage, Type, [{op, rec, Storage, {Oid, Ws, write}} | Acc]); @@ -2215,15 +2251,15 @@ transform_obj(Tab, RecName, Key, Fun, [Obj|Rest], NewArity, Type, Ws, Ds) -> NewObj == Obj -> transform_obj(Tab, RecName, Key, Fun, Rest, NewArity, Type, Ws, Ds); RecName == element(1, NewObj), Key == element(2, NewObj) -> - transform_obj(Tab, RecName, Key, Fun, Rest, NewArity, + transform_obj(Tab, RecName, Key, Fun, Rest, NewArity, Type, [NewObj | Ws], Ds); - NewObj == delete -> - case Type of + NewObj == delete -> + case Type of bag -> %% Just don't write that object - transform_obj(Tab, RecName, Key, Fun, Rest, - NewArity, Type, Ws, Ds); + transform_obj(Tab, RecName, Key, Fun, Rest, + NewArity, Type, Ws, Ds); _ -> - transform_obj(Tab, RecName, Key, Fun, Rest, NewArity, + transform_obj(Tab, RecName, Key, Fun, Rest, NewArity, Type, Ws, [NewObj | Ds]) end; true -> @@ -2247,7 +2283,7 @@ undo_prepare_commit(Tid, Commit) -> %% Undo in reverse order undo_prepare_ops(Tid, [Op | Ops]) -> - case element(1, Op) of + case element(1, Op) of TheOp when TheOp /= op, TheOp /= restore_op -> undo_prepare_ops(Tid, Ops); _ -> @@ -2274,7 +2310,7 @@ undo_prepare_op(Tid, {op, create_table, TabDef}) -> mnesia_lib:unset({Tab, create_table}), delete_cstruct(Tid, Cs), case mnesia_lib:cs_to_storage_type(node(), Cs) of - unknown -> + unknown -> ok; ram_copies -> ram_delete_table(Tab, ram_copies); @@ -2289,7 +2325,7 @@ undo_prepare_op(Tid, {op, create_table, TabDef}) -> %% disc_delete_table(Tab, Storage), file:delete(Dat) end; - + undo_prepare_op(Tid, {op, add_table_copy, Storage, Node, TabDef}) -> Cs = list2cs(TabDef), Tab = Cs#cstruct.name, @@ -2314,21 +2350,21 @@ undo_prepare_op(Tid, {op, add_table_copy, Storage, Node, TabDef}) -> Cs2 = new_cs(Cs, Node, Storage, del), insert_cstruct(Tid, Cs2, true) % Don't care about the version end; - -undo_prepare_op(_Tid, {op, del_table_copy, _, Node, TabDef}) + +undo_prepare_op(_Tid, {op, del_table_copy, _, Node, TabDef}) when Node == node() -> Cs = list2cs(TabDef), Tab = Cs#cstruct.name, mnesia_lib:set({Tab, where_to_read}, Node); -undo_prepare_op(_Tid, {op, change_table_copy_type, N, FromS, ToS, TabDef}) +undo_prepare_op(_Tid, {op, change_table_copy_type, N, FromS, ToS, TabDef}) when N == node() -> Cs = list2cs(TabDef), Tab = Cs#cstruct.name, mnesia_checkpoint:tm_change_table_copy_type(Tab, ToS, FromS), Dmp = mnesia_lib:tab2dmp(Tab), - + case {FromS, ToS} of {ram_copies, disc_copies} when Tab == schema -> file:delete(Dmp), @@ -2382,9 +2418,9 @@ ram_delete_table(Tab, Storage) -> ignore; disc_only_copies -> ignore; - _Else -> + _Else -> %% delete possible index files and data ..... - %% Got to catch this since if no info has been set in the + %% Got to catch this since if no info has been set in the %% mnesia_gvar it will crash catch mnesia_index:del_transient(Tab, Storage), case ?catch_val({Tab, {index, snmp}}) of @@ -2454,7 +2490,7 @@ has_known_suffix(File, [Suffix | Tail], false) -> has_known_suffix(File, Tail, lists:suffix(Suffix, File)); has_known_suffix(_File, [], Bool) -> Bool. - + known_suffixes() -> real_suffixes() ++ tmp_suffixes(). real_suffixes() -> [".DAT", ".LOG", ".BUP", ".DCL", ".DCD"]. @@ -2477,11 +2513,11 @@ info2(Tab, [{frag_hash, _V} | Tail]) -> % Ignore frag_hash info2(Tab, [{P, V} | Tail]) -> io:format("~-20w -> ~p~n",[P,V]), info2(Tab, Tail); -info2(_, []) -> +info2(_, []) -> io:format("~n", []). get_table_properties(Tab) -> - case catch mnesia_lib:db_match_object(ram_copies, + case catch mnesia_lib:db_match_object(ram_copies, mnesia_gvar, {{Tab, '_'}, '_'}) of {'EXIT', _} -> mnesia:abort({no_exists, Tab, all}); @@ -2509,9 +2545,9 @@ get_table_properties(Tab) -> recs = error_recs }). -restore(Opaque) -> +restore(Opaque) -> restore(Opaque, [], mnesia_monitor:get_env(backup_module)). -restore(Opaque, Args) when is_list(Args) -> +restore(Opaque, Args) when is_list(Args) -> restore(Opaque, Args, mnesia_monitor:get_env(backup_module)); restore(_Opaque, BadArg) -> {aborted, {badarg, BadArg}}. @@ -2522,7 +2558,7 @@ restore(Opaque, Args, Module) when is_list(Args), is_atom(Module) -> case mnesia_bup:read_schema(R#r.module, Opaque) of {error, Reason} -> {aborted, Reason}; - BupSchema -> + BupSchema -> schema_transaction(fun() -> do_restore(R, BupSchema) end) end; {'EXIT', Reason} -> @@ -2556,8 +2592,8 @@ check_restore_arg({keep_tables, List}, R) when is_list(List) -> check_restore_arg({skip_tables, List}, R) when is_list(List) -> TableList = [{Tab, skip_tables} || Tab <- List], R#r{table_options = R#r.table_options ++ TableList}; -check_restore_arg({default_op, Op}, R) -> - case Op of +check_restore_arg({default_op, Op}, R) -> + case Op of clear_tables -> ok; recreate_tables -> ok; keep_tables -> ok; @@ -2588,12 +2624,12 @@ restore_items([Rec | Recs], Header, Schema, R) -> case lists:keysearch(Tab, 1, R#r.tables) of {value, {Tab, Where0, Snmp, RecName}} -> Where = case Where0 of - undefined -> + undefined -> val({Tab, where_to_commit}); _ -> Where0 end, - {Rest, NRecs} = restore_tab_items([Rec | Recs], Tab, + {Rest, NRecs} = restore_tab_items([Rec | Recs], Tab, RecName, Where, Snmp, R#r.recs, R#r.insert_op), restore_items(Rest, Header, Schema, R#r{recs = NRecs}); @@ -2601,12 +2637,12 @@ restore_items([Rec | Recs], Header, Schema, R) -> Rest = skip_tab_items(Recs, Tab), restore_items(Rest, Header, Schema, R) end; - + restore_items([], _Header, _Schema, R) -> R. restore_func(Tab, R) -> - case lists:keysearch(Tab, 1, R#r.table_options) of + case lists:keysearch(Tab, 1, R#r.table_options) of {value, {Tab, OP}} -> OP; false -> @@ -2618,24 +2654,24 @@ where_to_commit(Tab, CsList) -> Disc = [{N, disc_copies} || N <- pick(Tab, disc_copies, CsList, [])], DiscO = [{N, disc_only_copies} || N <- pick(Tab, disc_only_copies, CsList, [])], Ram ++ Disc ++ DiscO. - + %% Changes of the Meta info of schema itself is not allowed restore_schema([{schema, schema, _List} | Schema], R) -> restore_schema(Schema, R); restore_schema([{schema, Tab, List} | Schema], R) -> case restore_func(Tab, R) of - clear_tables -> + clear_tables -> do_clear_table(Tab), - Snmp = val({Tab, snmp}), - RecName = val({Tab, record_name}), + Snmp = val({Tab, snmp}), + RecName = val({Tab, record_name}), R2 = R#r{tables = [{Tab, undefined, Snmp, RecName} | R#r.tables]}, restore_schema(Schema, R2); - recreate_tables -> + recreate_tables -> case ?catch_val({Tab, cstruct}) of - {'EXIT', _} -> + {'EXIT', _} -> TidTs = {_Mod, Tid, Ts} = get(mnesia_activity_state), RunningNodes = val({current, db_nodes}), - Nodes = mnesia_lib:intersect(mnesia_lib:cs_to_nodes(list2cs(List)), + Nodes = mnesia_lib:intersect(mnesia_lib:cs_to_nodes(list2cs(List)), RunningNodes), mnesia_locker:wlock_no_exist(Tid, Ts#tidstore.store, Tab, Nodes), TidTs; @@ -2643,20 +2679,20 @@ restore_schema([{schema, Tab, List} | Schema], R) -> TidTs = get_tid_ts_and_lock(Tab, write) end, NC = {cookie, ?unique_cookie}, - List2 = lists:keyreplace(cookie, 1, List, NC), + List2 = lists:keyreplace(cookie, 1, List, NC), Where = where_to_commit(Tab, List2), Snmp = pick(Tab, snmp, List2, []), RecName = pick(Tab, record_name, List2, Tab), insert_schema_ops(TidTs, [{op, restore_recreate, List2}]), R2 = R#r{tables = [{Tab, Where, Snmp, RecName} | R#r.tables]}, restore_schema(Schema, R2); - keep_tables -> + keep_tables -> get_tid_ts_and_lock(Tab, write), Snmp = val({Tab, snmp}), - RecName = val({Tab, record_name}), + RecName = val({Tab, record_name}), R2 = R#r{tables = [{Tab, undefined, Snmp, RecName} | R#r.tables]}, restore_schema(Schema, R2); - skip_tables -> + skip_tables -> restore_schema(Schema, R) end; @@ -2667,7 +2703,7 @@ restore_schema([{schema, Tab} | Schema], R) -> restore_schema([], R) -> R. -restore_tab_items([Rec | Rest], Tab, RecName, Where, Snmp, Recs, Op) +restore_tab_items([Rec | Rest], Tab, RecName, Where, Snmp, Recs, Op) when element(1, Rec) == Tab -> NewRecs = Op(Rec, Recs, RecName, Where, Snmp), restore_tab_items(Rest, Tab, RecName, Where, Snmp, NewRecs, Op); @@ -2675,7 +2711,7 @@ restore_tab_items([Rec | Rest], Tab, RecName, Where, Snmp, Recs, Op) restore_tab_items(Rest, _Tab, _RecName, _Where, _Snmp, Recs, _Op) -> {Rest, Recs}. -skip_tab_items([Rec| Rest], Tab) +skip_tab_items([Rec| Rest], Tab) when element(1, Rec) == Tab -> skip_tab_items(Rest, Tab); skip_tab_items(Recs, _) -> @@ -2710,7 +2746,6 @@ merge_schema() -> merge_schema(UserFun) -> schema_transaction(fun() -> UserFun(fun(Arg) -> do_merge_schema(Arg) end) end). - do_merge_schema(LockTabs0) -> {_Mod, Tid, Ts} = get_tid_ts_and_lock(schema, write), LockTabs = [{T, tab_to_nodes(T)} || T <- LockTabs0], @@ -2732,14 +2767,14 @@ do_merge_schema(LockTabs0) -> [mnesia_locker:wlock_no_exist( Tid, Store, T, mnesia_lib:intersect(Ns, OtherNodes)) || {T,Ns} <- LockTabs], - case rpc:call(Node, mnesia_controller, get_cstructs, []) of + case fetch_cstructs(Node) of {cstructs, Cstructs, RemoteRunning1} -> LockedAlready = Running ++ [Node], {New, Old} = mnesia_recover:connect_nodes(RemoteRunning1), RemoteRunning = mnesia_lib:intersect(New ++ Old, RemoteRunning1), - if + if RemoteRunning /= RemoteRunning1 -> - mnesia_lib:error("Mnesia on ~p could not connect to node(s) ~p~n", + mnesia_lib:error("Mnesia on ~p could not connect to node(s) ~p~n", [node(), RemoteRunning1 -- RemoteRunning]), mnesia:abort({node_not_running, RemoteRunning1 -- RemoteRunning}); true -> ok @@ -2749,24 +2784,24 @@ do_merge_schema(LockTabs0) -> [mnesia_locker:wlock_no_exist(Tid, Store, T, mnesia_lib:intersect(Ns,NeedsLock)) || {T,Ns} <- LockTabs], - {value, SchemaCs} = - lists:keysearch(schema, #cstruct.name, Cstructs), + NeedsConversion = need_old_cstructs(NeedsLock ++ LockedAlready), + {value, SchemaCs} = lists:keysearch(schema, #cstruct.name, Cstructs), + SchemaDef = cs2list(NeedsConversion, SchemaCs), %% Announce that Node is running - A = [{op, announce_im_running, node(), - cs2list(SchemaCs), Running, RemoteRunning}], + A = [{op, announce_im_running, node(), SchemaDef, Running, RemoteRunning}], do_insert_schema_ops(Store, A), - + %% Introduce remote tables to local node - do_insert_schema_ops(Store, make_merge_schema(Node, Cstructs)), - + do_insert_schema_ops(Store, make_merge_schema(Node, NeedsConversion, Cstructs)), + %% Introduce local tables to remote nodes Tabs = val({schema, tables}), Ops = [{op, merge_schema, get_create_list(T)} || T <- Tabs, not lists:keymember(T, #cstruct.name, Cstructs)], do_insert_schema_ops(Store, Ops), - + %% Ensure that the txn will be committed on all nodes NewNodes = RemoteRunning -- Running, mnesia_lib:set(prepare_op, {announce_im_running,NewNodes}), @@ -2782,19 +2817,49 @@ do_merge_schema(LockTabs0) -> not_merged end. +fetch_cstructs(Node) -> + case mnesia_monitor:needs_protocol_conversion(Node) of + true -> + case rpc:call(Node, mnesia_controller, get_cstructs, []) of + {cstructs, Cs0, RR} -> + {cstructs, [list2cs(cs2list(Cs)) || Cs <- Cs0], RR}; + Err -> Err + end; + false -> + rpc:call(Node, mnesia_controller, get_remote_cstructs, []) + end. + +need_old_cstructs(Nodes) -> + Filter = fun(Node) -> not mnesia_monitor:needs_protocol_conversion(Node) end, + case lists:dropwhile(Filter, Nodes) of + [] -> false; + [Node|_] -> + case rpc:call(Node, mnesia_lib, val, [{schema,cstruct}]) of + #cstruct{} -> + %% mnesia_lib:warning("Mnesia on ~p do not need to convert cstruct (~p)~n", + %% [node(), Node]), + false; + {badrpc, _} -> + need_old_cstructs(lists:delete(Node,Nodes)); + Cs when element(1, Cs) == cstruct, tuple_size(Cs) == 17 -> + ver4_4_18; % Without majority + Cs when element(1, Cs) == cstruct, tuple_size(Cs) == 18 -> + ver4_4_19 % With majority + end + end. + tab_to_nodes(Tab) when is_atom(Tab) -> Cs = val({Tab, cstruct}), mnesia_lib:cs_to_nodes(Cs). -make_merge_schema(Node, [Cs | Cstructs]) -> - Ops = do_make_merge_schema(Node, Cs), - Ops ++ make_merge_schema(Node, Cstructs); -make_merge_schema(_Node, []) -> +make_merge_schema(Node, NeedsConv, [Cs | Cstructs]) -> + Ops = do_make_merge_schema(Node, NeedsConv, Cs), + Ops ++ make_merge_schema(Node, NeedsConv, Cstructs); +make_merge_schema(_Node, _, []) -> []. %% Merge definitions of schema table -do_make_merge_schema(Node, RemoteCs) - when RemoteCs#cstruct.name == schema -> +do_make_merge_schema(Node, NeedsConv, RemoteCs = #cstruct{name = schema}) -> Cs = val({schema, cstruct}), Masters = mnesia_recover:get_master_nodes(schema), HasRemoteMaster = lists:member(Node, Masters), @@ -2804,15 +2869,15 @@ do_make_merge_schema(Node, RemoteCs) StCsLocal = mnesia_lib:cs_to_storage_type(node(), Cs), StRcsLocal = mnesia_lib:cs_to_storage_type(node(), RemoteCs), StCsRemote = mnesia_lib:cs_to_storage_type(Node, Cs), - StRcsRemote = mnesia_lib:cs_to_storage_type(Node, RemoteCs), - + StRcsRemote = mnesia_lib:cs_to_storage_type(Node, RemoteCs), + if Cs#cstruct.cookie == RemoteCs#cstruct.cookie, Cs#cstruct.version == RemoteCs#cstruct.version -> %% Great, we have the same cookie and version %% and do not need to merge cstructs []; - + Cs#cstruct.cookie /= RemoteCs#cstruct.cookie, Cs#cstruct.disc_copies /= [], RemoteCs#cstruct.disc_copies /= [] -> @@ -2823,14 +2888,14 @@ do_make_merge_schema(Node, RemoteCs) HasRemoteMaster == false -> %% Choose local cstruct, %% since it's the master - [{op, merge_schema, cs2list(Cs)}]; + [{op, merge_schema, cs2list(NeedsConv, Cs)}]; HasRemoteMaster == true, HasLocalMaster == false -> %% Choose remote cstruct, %% since it's the master - [{op, merge_schema, cs2list(RemoteCs)}]; - + [{op, merge_schema, cs2list(NeedsConv, RemoteCs)}]; + true -> Str = io_lib:format("Incompatible schema cookies. " "Please, restart from old backup." @@ -2838,12 +2903,12 @@ do_make_merge_schema(Node, RemoteCs) [Node, cs2list(RemoteCs), node(), cs2list(Cs)]), throw(Str) end; - + StCsLocal /= StRcsLocal, StRcsLocal /= unknown, StCsLocal /= ram_copies -> Str = io_lib:format("Incompatible schema storage types (local). " "on ~w storage ~w, on ~w storage ~w~n", [node(), StCsLocal, Node, StRcsLocal]), - throw(Str); + throw(Str); StCsRemote /= StRcsRemote, StCsRemote /= unknown, StRcsRemote /= ram_copies -> Str = io_lib:format("Incompatible schema storage types (remote). " "on ~w cs ~w, on ~w rcs ~w~n", @@ -2854,27 +2919,27 @@ do_make_merge_schema(Node, RemoteCs) %% Choose local cstruct, %% since it involves disc nodes MergedCs = merge_cstructs(Cs, RemoteCs, Force), - [{op, merge_schema, cs2list(MergedCs)}]; - + [{op, merge_schema, cs2list(NeedsConv, MergedCs)}]; + RemoteCs#cstruct.disc_copies /= [] -> %% Choose remote cstruct, %% since it involves disc nodes MergedCs = merge_cstructs(RemoteCs, Cs, Force), - [{op, merge_schema, cs2list(MergedCs)}]; + [{op, merge_schema, cs2list(NeedsConv, MergedCs)}]; Cs > RemoteCs -> %% Choose remote cstruct MergedCs = merge_cstructs(RemoteCs, Cs, Force), - [{op, merge_schema, cs2list(MergedCs)}]; - + [{op, merge_schema, cs2list(NeedsConv, MergedCs)}]; + true -> %% Choose local cstruct MergedCs = merge_cstructs(Cs, RemoteCs, Force), - [{op, merge_schema, cs2list(MergedCs)}] + [{op, merge_schema, cs2list(NeedsConv, MergedCs)}] end; %% Merge definitions of normal table -do_make_merge_schema(Node, RemoteCs) -> +do_make_merge_schema(Node, NeedsConv, RemoteCs = #cstruct{}) -> Tab = RemoteCs#cstruct.name, Masters = mnesia_recover:get_master_nodes(schema), HasRemoteMaster = lists:member(Node, Masters), @@ -2883,27 +2948,27 @@ do_make_merge_schema(Node, RemoteCs) -> case ?catch_val({Tab, cstruct}) of {'EXIT', _} -> %% A completely new table, created while Node was down - [{op, merge_schema, cs2list(RemoteCs)}]; + [{op, merge_schema, cs2list(NeedsConv, RemoteCs)}]; Cs when Cs#cstruct.cookie == RemoteCs#cstruct.cookie -> if Cs#cstruct.version == RemoteCs#cstruct.version -> %% We have exactly the same version of the %% table def []; - + Cs#cstruct.version > RemoteCs#cstruct.version -> %% Oops, we have different versions %% of the table def, lets merge them. %% The only changes that may have occurred %% is that new replicas may have been added. MergedCs = merge_cstructs(Cs, RemoteCs, Force), - [{op, merge_schema, cs2list(MergedCs)}]; - + [{op, merge_schema, cs2list(NeedsConv, MergedCs)}]; + Cs#cstruct.version < RemoteCs#cstruct.version -> %% Oops, we have different versions %% of the table def, lets merge them MergedCs = merge_cstructs(RemoteCs, Cs, Force), - [{op, merge_schema, cs2list(MergedCs)}] + [{op, merge_schema, cs2list(NeedsConv, MergedCs)}] end; Cs -> %% Different cookies, not possible to merge @@ -2912,14 +2977,14 @@ do_make_merge_schema(Node, RemoteCs) -> HasRemoteMaster == false -> %% Choose local cstruct, %% since it's the master - [{op, merge_schema, cs2list(Cs)}]; + [{op, merge_schema, cs2list(NeedsConv, Cs)}]; HasRemoteMaster == true, HasLocalMaster == false -> %% Choose remote cstruct, %% since it's the master - [{op, merge_schema, cs2list(RemoteCs)}]; - + [{op, merge_schema, cs2list(NeedsConv, RemoteCs)}]; + true -> Str = io_lib:format("Bad cookie in table definition" " ~w: ~w = ~w, ~w = ~w~n", @@ -2989,7 +3054,7 @@ compare_storage_type(true, One, Another) -> compare_storage_type(false, Another, One); compare_storage_type(false, _One, _Another) -> incompatible. - + change_storage_type(N, ram_copies, Cs) -> Nodes = [N | Cs#cstruct.ram_copies], Cs#cstruct{ram_copies = mnesia_lib:uniq(Nodes)}; @@ -3071,14 +3136,14 @@ verify_merge(RemoteCs) -> if StCsLocal == StRcsLocal -> ok; StCsLocal == unknown -> ok; - (StRcsLocal == unknown), (HasRemoteMaster == false) -> + (StRcsLocal == unknown), (HasRemoteMaster == false) -> {merge_error, Cs, RemoteCs}; %% Trust the merger true -> ok end end. -announce_im_running([N | Ns], SchemaCs) -> +announce_im_running([N | Ns], SchemaCs) -> {L1, L2} = mnesia_recover:connect_nodes([N]), case lists:member(N, L1) or lists:member(N, L2) of true -> @@ -3095,7 +3160,7 @@ announce_im_running([], _) -> unannounce_im_running([N | Ns]) -> mnesia_lib:del({current, db_nodes}, N), - mnesia_controller:del_active_replica(schema, N), + mnesia_controller:del_active_replica(schema, N), unannounce_im_running(Ns); unannounce_im_running([]) -> ok. diff --git a/lib/observer/src/Makefile b/lib/observer/src/Makefile index 2d06cb6bc4..3875b62101 100644 --- a/lib/observer/src/Makefile +++ b/lib/observer/src/Makefile @@ -56,13 +56,16 @@ TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) $(APP_TARGET) $(APPUP_TARGET) PRIVDIR= ../priv WEBTOOLFILES= $(PRIVDIR)/crashdump_viewer.tool BINDIR= $(PRIVDIR)/bin +ifeq ($(findstring win32,$(TARGET)),win32) +WIN32_EXECUTABLES= $(BINDIR)/etop.bat $(BINDIR)/getop.bat $(BINDIR)/cdv.bat +else +WIN32_EXECUTABLES= +endif EXECUTABLES= \ $(BINDIR)/etop \ $(BINDIR)/getop \ $(BINDIR)/cdv \ - $(BINDIR)/etop.bat \ - $(BINDIR)/getop.bat \ - $(BINDIR)/cdv.bat + $(WIN32_EXECUTABLES) CDVDIR= $(PRIVDIR)/crashdump_viewer GIF_FILES= \ $(CDVDIR)/collapsd.gif \ diff --git a/lib/odbc/c_src/odbcserver.c b/lib/odbc/c_src/odbcserver.c index d61ce940c3..ab2d7fe210 100644 --- a/lib/odbc/c_src/odbcserver.c +++ b/lib/odbc/c_src/odbcserver.c @@ -90,7 +90,7 @@ Datatype - USER_INT | USER_SMALL_INT | {USER_DECIMAL, Precision, Scale} | {USER_NMERIC, Precision, Scale} | {USER_CHAR, Max} | {USER_VARCHAR, Max} | {USER_WVARCHAR, Max} | {USER_FLOAT, Precision} | USER_REAL | USER_DOUBLE | - USER_TIMESTAMP + USER_TIMESTAMP | {USER_WLONGVARCHAR, Max} Scale - integer Precision - integer Max - integer @@ -173,7 +173,7 @@ static db_result_msg encode_row_count(SQLINTEGER num_of_rows, db_state *state); static void encode_column_dyn(db_column column, int column_nr, db_state *state); -static void encode_data_type(SQLINTEGER sql_type, SQLINTEGER size, +static void encode_data_type(SQLSMALLINT sql_type, SQLINTEGER size, SQLSMALLINT decimal_digits, db_state *state); static Boolean decode_params(db_state *state, byte *buffer, int *index, param_array **params, int i, int j); @@ -221,7 +221,7 @@ static void init_param_column(param_array *params, byte *buffer, int *index, int num_param_values, db_state* state); static void init_param_statement(int cols, - int num_param_values, + SQLLEN num_param_values, db_state *state, param_status *status); @@ -435,7 +435,7 @@ static db_result_msg db_connect(byte *args, db_state *state) diagnos diagnos; byte *connStrIn; int erl_auto_commit_mode, erl_trace_driver, - use_srollable_cursors, tuple_row_state, binary_strings; + use_srollable_cursors, tuple_row_state, binary_strings; erl_auto_commit_mode = args[0]; erl_trace_driver = args[1]; @@ -757,8 +757,9 @@ static db_result_msg db_select(byte *args, db_state *state) static db_result_msg db_param_query(byte *buffer, db_state *state) { byte *sql; - db_result_msg msg; - int i, num_param_values, ver = 0, + db_result_msg msg; + SQLLEN num_param_values; + int i, ver = 0, erl_type = 0, index = 0, size = 0, cols = 0; long long_num_param_values; param_status param_status; @@ -771,6 +772,7 @@ static db_result_msg db_param_query(byte *buffer, db_state *state) } associated_result_set(state) = FALSE; param_query(state) = TRUE; + out_params(state) = FALSE; msg = encode_empty_message(); @@ -785,7 +787,7 @@ static db_result_msg db_param_query(byte *buffer, db_state *state) ei_decode_long(buffer, &index, &long_num_param_values); - num_param_values = (int)long_num_param_values; + num_param_values = (SQLLEN)long_num_param_values; ei_decode_list_header(buffer, &index, &cols); @@ -1002,12 +1004,16 @@ static db_result_msg encode_result(db_state *state) db_result_msg msg; int elements, update, num_of_rows = 0; char *atom; + diagnos diagnos; msg = encode_empty_message(); if(!sql_success(SQLNumResultCols(statement_handle(state), &num_of_columns))) { - DO_EXIT(EXIT_COLS); + diagnos = get_diagnos(SQL_HANDLE_STMT, statement_handle(state)); + msg = encode_error_message(diagnos.error_msg); + clean_state(state); + return msg; } if (num_of_columns == 0) { @@ -1021,7 +1027,10 @@ static db_result_msg encode_result(db_state *state) } if(!sql_success(SQLRowCount(statement_handle(state), &RowCountPtr))) { - DO_EXIT(EXIT_ROWS); + diagnos = get_diagnos(SQL_HANDLE_STMT, statement_handle(state)); + msg = encode_error_message(diagnos.error_msg); + clean_state(state); + return msg; } if(param_query(state) && update) { @@ -1220,7 +1229,7 @@ static db_result_msg encode_column_name_list(SQLSMALLINT num_of_columns, &nullable))) DO_EXIT(EXIT_DESC); - if(sql_type == SQL_LONGVARCHAR || sql_type == SQL_LONGVARBINARY) + if(sql_type == SQL_LONGVARCHAR || sql_type == SQL_LONGVARBINARY || sql_type == SQL_WLONGVARCHAR) size = MAXCOLSIZE; (columns(state)[i]).type.decimal_digits = dec_digits; @@ -1452,7 +1461,7 @@ static void encode_column_dyn(db_column column, int column_nr, } } -static void encode_data_type(SQLINTEGER sql_type, SQLINTEGER size, +static void encode_data_type(SQLSMALLINT sql_type, SQLINTEGER size, SQLSMALLINT decimal_digits, db_state *state) { switch(sql_type) { @@ -1529,6 +1538,11 @@ static void encode_data_type(SQLINTEGER sql_type, SQLINTEGER size, case SQL_LONGVARCHAR: ei_x_encode_atom(&dynamic_buffer(state), "SQL_LONGVARCHAR"); break; + case SQL_WLONGVARCHAR: + ei_x_encode_tuple_header(&dynamic_buffer(state), 2); + ei_x_encode_atom(&dynamic_buffer(state), "sql_wlongvarchar"); + ei_x_encode_long(&dynamic_buffer(state), size); + break; case SQL_VARBINARY: ei_x_encode_atom(&dynamic_buffer(state), "SQL_VARBINARY"); break; @@ -2007,7 +2021,7 @@ static void init_driver(int erl_auto_commit_mode, int erl_trace_driver, db_state *state) { - int auto_commit_mode, trace_driver; + SQLLEN auto_commit_mode, trace_driver; if(erl_auto_commit_mode == ON) { auto_commit_mode = SQL_AUTOCOMMIT_ON; @@ -2057,7 +2071,7 @@ static void init_param_column(param_array *params, byte *buffer, int *index, ei_decode_long(buffer, index, &user_type); - params->type.strlen_or_indptr = (SQLINTEGER)NULL; + params->type.strlen_or_indptr = (SQLLEN)NULL; params->type.strlen_or_indptr_array = NULL; params->type.decimal_digits = (SQLINTEGER)0; @@ -2131,10 +2145,14 @@ static void init_param_column(param_array *params, byte *buffer, int *index, break; case USER_WCHAR: case USER_WVARCHAR: - if(user_type == USER_WCHAR) { - params->type.sql = SQL_WCHAR; - } else { - params->type.sql = SQL_WVARCHAR; + case USER_WLONGVARCHAR: + switch (user_type) { + case USER_WCHAR: + params->type.sql = SQL_WCHAR; break; + case USER_WVARCHAR: + params->type.sql = SQL_WVARCHAR; break; + default: + params->type.sql = SQL_WLONGVARCHAR; break; } ei_decode_long(buffer, index, &length); /* Max string length + string terminator */ @@ -2206,7 +2224,7 @@ static void init_param_column(param_array *params, byte *buffer, int *index, } -static void init_param_statement(int cols, int num_param_values, +static void init_param_statement(int cols, SQLLEN num_param_values, db_state *state, param_status *status) { int i; @@ -2234,11 +2252,11 @@ static void init_param_statement(int cols, int num_param_values, DO_EXIT(EXIT_PARAM_ARRAY); } - /* Note the (int *) cast is correct as the API function SQLSetStmtAttr + /* Note the (SQLLEN *) cast is correct as the API function SQLSetStmtAttr takes either an interger or a pointer depending on the attribute */ if(!sql_success(SQLSetStmtAttr(statement_handle(state), SQL_ATTR_PARAMSET_SIZE, - (int *)num_param_values, + (SQLLEN *)num_param_values, 0))) { DO_EXIT(EXIT_PARAM_ARRAY); } @@ -2300,6 +2318,7 @@ static db_result_msg map_sql_2_c_column(db_column* column) break; case SQL_WCHAR: case SQL_WVARCHAR: + case SQL_WLONGVARCHAR: column -> type.len = (column -> type.col_size + 1)*sizeof(SQLWCHAR); column -> type.c = SQL_C_WCHAR; column -> type.strlen_or_indptr = SQL_NTS; @@ -2308,21 +2327,21 @@ static db_result_msg map_sql_2_c_column(db_column* column) case SQL_DECIMAL: map_dec_num_2_c_column(&(column -> type), column -> type.col_size, column -> type.decimal_digits); - column -> type.strlen_or_indptr = (SQLINTEGER)NULL; + column -> type.strlen_or_indptr = (SQLLEN)NULL; break; case SQL_TINYINT: case SQL_INTEGER: case SQL_SMALLINT: column -> type.len = sizeof(SQLINTEGER); column -> type.c = SQL_C_SLONG; - column -> type.strlen_or_indptr = (SQLINTEGER)NULL; + column -> type.strlen_or_indptr = (SQLLEN)NULL; break; case SQL_REAL: case SQL_FLOAT: case SQL_DOUBLE: column -> type.len = sizeof(double); column -> type.c = SQL_C_DOUBLE; - column -> type.strlen_or_indptr = (SQLINTEGER)NULL; + column -> type.strlen_or_indptr = (SQLLEN)NULL; break; case SQL_TYPE_DATE: case SQL_TYPE_TIME: @@ -2334,17 +2353,17 @@ static db_result_msg map_sql_2_c_column(db_column* column) case SQL_TYPE_TIMESTAMP: column -> type.len = sizeof(TIMESTAMP_STRUCT); column -> type.c = SQL_C_TYPE_TIMESTAMP; - column -> type.strlen_or_indptr = (SQLINTEGER)NULL; + column -> type.strlen_or_indptr = (SQLLEN)NULL; break; case SQL_BIGINT: column -> type.len = DEC_NUM_LENGTH; column -> type.c = SQL_C_CHAR; - column -> type.strlen_or_indptr = (SQLINTEGER)NULL; + column -> type.strlen_or_indptr = (SQLLEN)NULL; break; case SQL_BIT: column -> type.len = sizeof(byte); column -> type.c = SQL_C_BIT; - column -> type.strlen_or_indptr = (SQLINTEGER)NULL; + column -> type.strlen_or_indptr = (SQLLEN)NULL; break; case SQL_UNKNOWN_TYPE: msg = encode_error_message("Unknown column type"); diff --git a/lib/odbc/c_src/odbcserver.h b/lib/odbc/c_src/odbcserver.h index 3e2b22ab7d..314fbf32c6 100644 --- a/lib/odbc/c_src/odbcserver.h +++ b/lib/odbc/c_src/odbcserver.h @@ -115,6 +115,7 @@ #define USER_WCHAR 12 #define USER_WVARCHAR 13 #define USER_TIMESTAMP 14 +#define USER_WLONGVARCHAR 15 /*------------------------ TYPDEFS ----------------------------------*/ diff --git a/lib/odbc/doc/src/databases.xml b/lib/odbc/doc/src/databases.xml index a6ba0e5245..09f5a5af5b 100644 --- a/lib/odbc/doc/src/databases.xml +++ b/lib/odbc/doc/src/databases.xml @@ -205,6 +205,10 @@ when p >= 16 </cell> <cell align="left" valign="middle">String | Binary (configurable)</cell> </row> <row> + <cell align="left" valign="middle">SQL_WLONGVARCHAR(size) </cell> + <cell align="left" valign="middle">Unicode binary encoded as UTF16 little endian.</cell> + </row> + <row> <cell align="left" valign="middle">SQL_BINARY</cell> <cell align="left" valign="middle">String | Binary (configurable)</cell> </row> diff --git a/lib/odbc/doc/src/odbc.xml b/lib/odbc/doc/src/odbc.xml index 70d8cfbe22..11ca97f743 100644 --- a/lib/odbc/doc/src/odbc.xml +++ b/lib/odbc/doc/src/odbc.xml @@ -102,7 +102,7 @@ {sql_decimal, precision(), scale()} | {sql_numeric, precision(), scale()} | {sql_char, size()} | {sql_wchar, size()} | {sql_varchar, size()} | {sql_wvarchar, size()}| {sql_float, precision()} | - {sql_float, precision()} | sql_real | sql_double | sql_bit | atom() + {sql_wlongvarchar, size()} | {sql_float, precision()} | sql_real | sql_double | sql_bit | atom() </code> <code type="none"> precision() = integer() </code> diff --git a/lib/odbc/src/odbc.appup.src b/lib/odbc/src/odbc.appup.src index 2a6667ccd3..f3a3af8c29 100644 --- a/lib/odbc/src/odbc.appup.src +++ b/lib/odbc/src/odbc.appup.src @@ -1,8 +1,10 @@ %% -*- erlang -*- {"%VSN%", [ - {"2.10.9", [{restart_application, ssl}]} + {"2.10.10", [{restart_application, odbc}]}, + {"2.10.9", [{restart_application, odbc}]} ], [ - {"2.10.9", [{restart_application, ssl}]} + {"2.10.10", [{restart_application, odbc}]}, + {"2.10.9", [{restart_application, odbc}]} ]}. diff --git a/lib/odbc/src/odbc.erl b/lib/odbc/src/odbc.erl index 83d9f33102..68497292db 100644 --- a/lib/odbc/src/odbc.erl +++ b/lib/odbc/src/odbc.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2010. All Rights Reserved. +%% Copyright Ericsson AB 1999-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -431,7 +431,7 @@ init(Args) -> erlang:monitor(process, ClientPid), - Inet = case gen_tcp:listen(0, [inet6]) of + Inet = case gen_tcp:listen(0, [inet6, {ip, loopback}]) of {ok, Dummyport} -> gen_tcp:close(Dummyport), inet6; @@ -925,6 +925,9 @@ fix_params({{sql_wchar, Max}, InOut, Values}) -> fix_params({{sql_wvarchar, Max}, InOut, Values}) -> NewValues = string_terminate(Values), {?USER_WVARCHAR, Max, fix_inout(InOut), NewValues}; +fix_params({{sql_wlongvarchar, Max}, InOut, Values}) -> + NewValues = string_terminate(Values), + {?USER_WLONGVARCHAR, Max, fix_inout(InOut), NewValues}; fix_params({{sql_float, Precision}, InOut, Values}) -> {?USER_FLOAT, Precision, fix_inout(InOut), Values}; fix_params({sql_real, InOut, Values}) -> diff --git a/lib/odbc/src/odbc_internal.hrl b/lib/odbc/src/odbc_internal.hrl index aa60120f9a..c0e7d9657b 100644 --- a/lib/odbc/src/odbc_internal.hrl +++ b/lib/odbc/src/odbc_internal.hrl @@ -72,6 +72,7 @@ -define(USER_WCHAR, 12). -define(USER_WVARCHAR, 13). -define(USER_TIMESTAMP, 14). +-define(USER_WLONGVARCHAR, 15). %% INPUT & OUTPUT TYPE -define(IN, 0). diff --git a/lib/odbc/test/Makefile b/lib/odbc/test/Makefile index ec2bcc67b5..bc6449242e 100644 --- a/lib/odbc/test/Makefile +++ b/lib/odbc/test/Makefile @@ -34,7 +34,8 @@ MODULES= \ odbc_test_lib \ oracle \ sqlserver \ - postgres + postgres \ + mysql EBIN = . diff --git a/lib/odbc/test/mysql.erl b/lib/odbc/test/mysql.erl new file mode 100644 index 0000000000..c990793213 --- /dev/null +++ b/lib/odbc/test/mysql.erl @@ -0,0 +1,277 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2011-2011. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%% + +-module(mysql). + +%% Note: This directive should only be used in test suites. +-compile(export_all). + +%------------------------------------------------------------------------- +connection_string() -> + case test_server:os_type() of + {unix, linux} -> + "DSN=MySQL;Database=odbctest;Uid=odbctest;Pwd=gurka;CHARSET=utf8;SSTMT=SET NAMES 'utf8';"; + {unix, sunos} -> + solaris_str(); + {unix, darwin} -> + "DSN=MySQLMac;Database=odbctest;Uid=odbctest;Pwd=gurka;CHARSET=utf8;SSTMT=SET NAMES 'utf8';" + end. + +solaris_str() -> + case erlang:system_info(system_architecture) of + "sparc" ++ _ -> + "DSN=MySQLSolaris10;Database=odbctest;Uid=odbctest;Pwd=gurka;CHARSET=utf8;SSTMT=SET NAMES 'utf8';"; + "i386" ++ _ -> + "DSN=MySQLSolaris10i386;Database=odbctest;Uid=odbctest;Pwd=gurka;CHARSET=utf8;SSTMT=SET NAMES 'utf8';" + end. + +%------------------------------------------------------------------------- +insert_result() -> + {selected,["ID","DATA"],[{1,"bar"}]}. + +update_result() -> + {selected,["ID","DATA"],[{1,"foo"}]}. + +selected_ID(N, next) -> + {selected,["ID"],[{N}]}; + +selected_ID(_, _) -> + {error, driver_does_not_support_function}. + +selected_next_N(1)-> + {selected,["ID"], + [{1}, + {2}, + {3}]}; + +selected_next_N(2)-> + {selected,["ID"], + [{4}, + {5}]}. + +selected_relative_N(_)-> + {error, driver_does_not_support_function}. + +selected_absolute_N(_)-> + {error, driver_does_not_support_function}. + +selected_list_rows() -> + {selected,["ID", "DATA"],[[1, "bar"],[2,"foo"]]}. + +first_list_rows() -> + {error, driver_does_not_support_function}. +last_list_rows() -> + {error, driver_does_not_support_function}. +prev_list_rows() -> + {error, driver_does_not_support_function}. +next_list_rows() -> + {selected,["ID","DATA"],[[1,"bar"]]}. + +multiple_select()-> + [{selected,["ID", "DATA"],[{1, "bar"},{2, "foo"}]}, + {selected,["ID"],[{"foo"}]}]. + +multiple_mix()-> + [{updated, 1},{updated, 1}, + {selected,["ID", "DATA"],[{1, "foobar"},{2, "foo"}]}, + {updated, 1}, {selected,["DATA"],[{"foo"}]}]. + +%------------------------------------------------------------------------- +var_char_min() -> + 0. +var_char_max() -> + 65535. + +create_var_char_table(Size) -> + " (FIELD varchar(" ++ integer_to_list(Size) ++ "))". + +%------------------------------------------------------------------------- +text_min() -> + 1. +text_max() -> + 2147483646. % 2147483647. %% 2^31 - 1 + +create_text_table() -> + " (FIELD text)". + +%------------------------------------------------------------------------- +create_timestamp_table() -> + " (FIELD TIMESTAMP)". + +%------------------------------------------------------------------------- +tiny_int_min() -> + -128. +tiny_int_max() -> + 127. + +create_tiny_int_table() -> + " (FIELD tinyint)". + +tiny_int_min_selected() -> + {selected,["FIELD"],[{tiny_int_min()}]}. + +tiny_int_max_selected() -> + {selected,["FIELD"], [{tiny_int_max()}]}. + +%------------------------------------------------------------------------- +small_int_min() -> + -32768. +small_int_max() -> + 32767. + +create_small_int_table() -> + " (FIELD smallint)". + +small_int_min_selected() -> + {selected,["FIELD"],[{-32768}]}. + +small_int_max_selected() -> + {selected,["FIELD"], [{32767}]}. + +%------------------------------------------------------------------------- +int_min() -> + -2147483648. +int_max() -> + 2147483647. + +create_int_table() -> + " (FIELD int)". + +int_min_selected() -> + {selected,["FIELD"],[{-2147483648}]}. + +int_max_selected() -> + {selected,["FIELD"], [{2147483647}]}. + +%------------------------------------------------------------------------- +big_int_min() -> + -9223372036854775808. + +big_int_max() -> + 9223372036854775807. + +create_big_int_table() -> + " (FIELD bigint )". + +big_int_min_selected() -> + {selected,["FIELD"], [{"-9223372036854775808"}]}. + +big_int_max_selected() -> + {selected,["FIELD"], [{"9223372036854775807"}]}. + +%------------------------------------------------------------------------- +bit_false() -> + 0. +bit_true() -> + 1. + +create_bit_table() -> + " (FIELD bit)". + +bit_false_selected() -> + {selected,["FIELD"],[{"0"}]}. + +bit_true_selected() -> + {selected,["FIELD"], [{"1"}]}. + +%------------------------------------------------------------------------- + +%% Do not test float min/max as value is only theoretical defined in +%% mysql and may vary depending on hardware. + +create_float_table() -> + " (FIELD float)". + +float_zero_selected() -> + {selected,["FIELD"],[{0.00000e+0}]}. + +%------------------------------------------------------------------------- +real_min() -> + -3.40e+38. +real_max() -> + 3.40e+38. + +real_underflow() -> + "-3.41e+38". + +real_overflow() -> + "3.41e+38". + +create_real_table() -> + " (FIELD real)". + +real_zero_selected() -> + {selected,["FIELD"],[{0.00000e+0}]}. + +%------------------------------------------------------------------------- +param_select_small_int() -> + {selected,["FIELD"],[{1}, {2}]}. + +param_select_int() -> + Int = small_int_max() + 1, + {selected,["FIELD"],[{1}, {Int}]}. + +param_select_decimal() -> + {selected,["FIELD"],[{1},{2}]}. + +param_select_numeric() -> + {selected,["FIELD"],[{1},{2}]}. + +param_select_float() -> + {selected,["FIELD"],[{1.30000},{1.20000}]}. + +param_select_real() -> + {selected,["FIELD"],[{1.30000},{1.20000}]}. + +param_select_double() -> + {selected,["FIELD"],[{1.30000},{1.20000}]}. + +param_select_mix() -> + {selected,["ID","DATA"],[{1, "foo"}, {2, "bar"}]}. + +param_update() -> + {selected,["ID","DATA"],[{1, "foobar"}, {2, "foobar"}, {3, "baz"}]}. + +param_delete() -> + {selected,["ID","DATA"],[{3, "baz"}]}. + +param_select() -> + {selected,["ID","DATA"],[{1, "foo"},{3, "foo"}]}. + +%------------------------------------------------------------------------- +describe_integer() -> + {ok,[{"myint1",sql_smallint}, + {"myint2",sql_integer}, + {"myint3",sql_integer}]}. + +describe_string() -> + {ok,[{"str1",{sql_char,10}}, + {"str2",{sql_char,10}}, + {"str3",{sql_varchar,10}}, + {"str4",{sql_varchar,10}}]}. + +describe_floating() -> + {ok,[{"f",sql_real},{"r",sql_double},{"d",sql_double}]}. +describe_dec_num() -> + {ok,[{"mydec",{sql_decimal,9,3}},{"mynum",{sql_decimal,9,2}}]}. + +describe_timestamp() -> + {ok, [{"FIELD", sql_timestamp}]}. diff --git a/lib/odbc/test/odbc.dynspec b/lib/odbc/test/odbc.dynspec deleted file mode 100644 index bb15edceed..0000000000 --- a/lib/odbc/test/odbc.dynspec +++ /dev/null @@ -1,31 +0,0 @@ -%% -*- erlang -*- -%% You can test this file using this command. -%% file:script("odbc.dynspec", [{'Os',"Unix"}]). - -Exists = -fun() -> - case code:lib_dir(odbc) of - {error,bad_name} -> - false; - P -> - %% Make sure that the odbc directory really - %% contains the application (and not only documentation). - case filelib:is_file(filename:join(P, "ebin/odbc.beam")) of - false -> false; - true -> - %% We know that we don't have any odbc libraries - %% installed on this computer. - {ok,Host} = inet:gethostname(), - Host =/= "netsim200" - end - end -end, -case Exists() of - false -> - NoOdbc = "No odbc application", - [{skip, {odbc_connect_SUITE, NoOdbc}}, - {skip, {odbc_data_type_SUITE, NoOdbc}}, - {skip, {odbc_query_SUITE, NoOdbc}}]; - true -> - [] -end. diff --git a/lib/odbc/test/odbc.spec b/lib/odbc/test/odbc.spec index edaf821c91..653f1a780e 100644 --- a/lib/odbc/test/odbc.spec +++ b/lib/odbc/test/odbc.spec @@ -1,25 +1 @@ {suites,"../odbc_test",all}. -{skip_cases,"../odbc_test",odbc_data_type_SUITE, - [varchar_upper_limit], - "Known bug in database"}. -{skip_cases,"../odbc_test",odbc_data_type_SUITE, - [text_upper_limit], - "Consumes too much resources"}. -{skip_cases,"../odbc_test",odbc_data_type_SUITE, - [bit_true], - "Not supported by driver"}. -{skip_cases,"../odbc_test",odbc_data_type_SUITE, - [bit_false], - "Not supported by driver"}. -{skip_cases,"../odbc_test",odbc_query_SUITE, - [multiple_select_result_sets], - "Not supported by driver"}. -{skip_cases,"../odbc_test",odbc_query_SUITE, - [multiple_mix_result_sets], - "Not supported by driver"}. -{skip_cases,"../odbc_test",odbc_query_SUITE, - [multiple_result_sets_error], - "Not supported by driver"}. -{skip_cases,"../odbc_test",odbc_query_SUITE, - [param_insert_tiny_int], - "Not supported by driver"}. diff --git a/lib/odbc/test/odbc.spec.win b/lib/odbc/test/odbc.spec.win deleted file mode 100644 index 1fd349d2c3..0000000000 --- a/lib/odbc/test/odbc.spec.win +++ /dev/null @@ -1,5 +0,0 @@ -{topcase, {dir, "../odbc_test"}}. -{skip, {odbc_data_type_SUITE, big_int_lower_limit, "Not supported by sqlserver 7.0"}}. -{skip, {odbc_data_type_SUITE, big_int_upper_limit, "Not supported by sqlserver7.0"}}. -{skip, {odbc_data_type_SUITE, text_upper_limit, "Consumes too much resources"}}. - diff --git a/lib/odbc/test/odbc_connect_SUITE.erl b/lib/odbc/test/odbc_connect_SUITE.erl index 6a2268f40e..a076c4dfff 100644 --- a/lib/odbc/test/odbc_connect_SUITE.erl +++ b/lib/odbc/test/odbc_connect_SUITE.erl @@ -76,16 +76,26 @@ end_per_group(_GroupName, Config) -> %% Note: This function is free to add any key/value pairs to the Config %% variable, but should NOT alter/remove any existing entries. %%-------------------------------------------------------------------- -init_per_suite(Config) -> - application:start(odbc), - case catch odbc:connect(?RDBMS:connection_string(), - [{auto_commit, off}]) of - {ok, Ref} -> - odbc:disconnect(Ref), - [{tableName, odbc_test_lib:unique_table_name()} | Config]; - _ -> - {skip, "ODBC is not properly setup"} - end. +init_per_suite(Config) when is_list(Config) -> + case odbc_test_lib:skip() of + true -> + {skip, "ODBC not supported"}; + false -> + case (catch odbc:start()) of + ok -> + case catch odbc:connect(?RDBMS:connection_string(), + [{auto_commit, off}] ++ odbc_test_lib:platform_options()) of + {ok, Ref} -> + odbc:disconnect(Ref), + [{tableName, odbc_test_lib:unique_table_name()} | Config]; + _ -> + {skip, "ODBC is not properly setup"} + end; + _ -> + {skip,"ODBC not startable"} + end + end. + %%-------------------------------------------------------------------- %% Function: end_per_suite(Config) -> _ %% Config - [tuple()] @@ -93,8 +103,7 @@ init_per_suite(Config) -> %% Description: Cleanup after the whole suite %%-------------------------------------------------------------------- end_per_suite(_Config) -> - application:stop(odbc), - ok. + application:stop(odbc). %%-------------------------------------------------------------------- %% Function: init_per_testcase(Case, Config) -> Config @@ -124,15 +133,13 @@ init_per_testcase(_TestCase, Config) -> %% Description: Cleanup after each test case %%-------------------------------------------------------------------- end_per_testcase(_TestCase, Config) -> - %% Clean up if needed Table = ?config(tableName, Config), - {ok, Ref} = odbc:connect(?RDBMS:connection_string(), []), - Result = odbc:sql_query(Ref, "DROP TABLE " ++ Table), + {ok, Ref} = odbc:connect(?RDBMS:connection_string(), odbc_test_lib:platform_options()), + Result = odbc:sql_query(Ref, "DROP TABLE " ++ Table), io:format("Drop table: ~p ~p~n", [Table, Result]), odbc:disconnect(Ref), Dog = ?config(watchdog, Config), - test_server:timetrap_cancel(Dog), - ok. + test_server:timetrap_cancel(Dog). %%------------------------------------------------------------------------- %% Test cases starts here. @@ -142,13 +149,15 @@ commit(doc)-> commit(suite) -> []; commit(Config) -> {ok, Ref} = odbc:connect(?RDBMS:connection_string(), - [{auto_commit, off}]), + [{auto_commit, off}] ++ odbc_test_lib:platform_options()), Table = ?config(tableName, Config), + TransStr = transaction_support_str(?RDBMS), + {updated, _} = odbc:sql_query(Ref, "CREATE TABLE " ++ Table ++ - " (ID integer, DATA varchar(10))"), + " (ID integer, DATA varchar(10))" ++ TransStr), {updated, 1} = odbc:sql_query(Ref, "INSERT INTO " ++ Table ++" VALUES(1,'bar')"), @@ -173,50 +182,47 @@ commit(Config) -> {'EXIT', {function_clause, _}} = (catch odbc:commit(Ref, commit, -1)), - ok = odbc:disconnect(Ref), - - ok. + ok = odbc:disconnect(Ref). %%------------------------------------------------------------------------- rollback(doc)-> ["Test the use of explicit rollback"]; rollback(suite) -> []; rollback(Config) -> - {ok, Ref} = odbc:connect(?RDBMS:connection_string(), - [{auto_commit, off}]), + {ok, Ref} = odbc:connect(?RDBMS:connection_string(), + [{auto_commit, off}] ++ odbc_test_lib:platform_options()), Table = ?config(tableName, Config), - {updated, _} = - odbc:sql_query(Ref, + TransStr = transaction_support_str(?RDBMS), + + {updated, _} = + odbc:sql_query(Ref, "CREATE TABLE " ++ Table ++ - " (ID integer, DATA varchar(10))"), - {updated, 1} = + " (ID integer, DATA varchar(10))" ++ TransStr), + {updated, 1} = odbc:sql_query(Ref, "INSERT INTO " ++ Table ++ " VALUES(1,'bar')"), ok = odbc:commit(Ref, commit), - {updated, 1} = + {updated, 1} = odbc:sql_query(Ref, "UPDATE " ++ Table ++ - " SET DATA = 'foo' WHERE ID = 1"), + " SET DATA = 'foo' WHERE ID = 1"), ok = odbc:commit(Ref, rollback), InsertResult = ?RDBMS:insert_result(), - InsertResult = + InsertResult = odbc:sql_query(Ref, "SELECT * FROM " ++ Table), - - {updated, 1} = + {updated, 1} = odbc:sql_query(Ref, "UPDATE " ++ Table ++ - " SET DATA = 'foo' WHERE ID = 1"), + " SET DATA = 'foo' WHERE ID = 1"), ok = odbc:commit(Ref, rollback, ?TIMEOUT), InsertResult = ?RDBMS:insert_result(), - InsertResult = + InsertResult = odbc:sql_query(Ref, "SELECT * FROM " ++ Table), + {'EXIT', {function_clause, _}} = + (catch odbc:commit(Ref, rollback, -1)), - {'EXIT', {function_clause, _}} = - (catch odbc:commit(Ref, rollback, -1)), - - ok = odbc:disconnect(Ref), - ok. + ok = odbc:disconnect(Ref). %%------------------------------------------------------------------------- not_explicit_commit(doc) -> @@ -224,20 +230,20 @@ not_explicit_commit(doc) -> not_explicit_commit(suite) -> []; not_explicit_commit(_Config) -> {ok, Ref} = - odbc:connect(?RDBMS:connection_string(), [{auto_commit, on}]), + odbc:connect(?RDBMS:connection_string(), [{auto_commit, on}] ++ + odbc_test_lib:platform_options()), {error, _} = odbc:commit(Ref, commit), - ok = odbc:disconnect(Ref), - ok. + ok = odbc:disconnect(Ref). %%------------------------------------------------------------------------- not_exist_db(doc) -> ["Tests valid data format but invalid data in the connection parameters."]; not_exist_db(suite) -> []; not_exist_db(_Config) -> - {error, _} = odbc:connect("DSN=foo;UID=bar;PWD=foobar", []), + {error, _} = odbc:connect("DSN=foo;UID=bar;PWD=foobar", + odbc_test_lib:platform_options()), %% So that the odbc control server can be stoped "in the correct way" - test_server:sleep(100), - ok. + test_server:sleep(100). %%------------------------------------------------------------------------- no_c_node(doc) -> @@ -252,7 +258,8 @@ no_c_node(_Config) -> FileName2 = filename:nativename(filename:join(Dir, "odbcsrv")), ok = file:rename(FileName1, FileName2), Result = - case catch odbc:connect(?RDBMS:connection_string(), []) of + case catch odbc:connect(?RDBMS:connection_string(), + odbc_test_lib:platform_options()) of {error, port_program_executable_not_found} -> ok; Else -> @@ -267,7 +274,7 @@ port_dies(doc) -> "Tests what happens if the port program dies"; port_dies(suite) -> []; port_dies(_Config) -> - {ok, Ref} = odbc:connect(?RDBMS:connection_string(), []), + {ok, Ref} = odbc:connect(?RDBMS:connection_string(), odbc_test_lib:platform_options()), {status, _} = process_info(Ref, status), process_flag(trap_exit, true), Port = lists:last(erlang:ports()), @@ -275,26 +282,23 @@ port_dies(_Config) -> %% Wait for exit_status from port 5000 ms (will not get a exit %% status in this case), then wait a little longer to make sure %% the port and the controlprocess has had time to terminate. - test_server:sleep(7000), - undefined = process_info(Ref, status), - ok. + test_server:sleep(10000), + undefined = process_info(Ref, status). %%------------------------------------------------------------------------- control_process_dies(doc) -> "Tests what happens if the Erlang control process dies"; control_process_dies(suite) -> []; control_process_dies(_Config) -> - {ok, Ref} = odbc:connect(?RDBMS:connection_string(), []), + {ok, Ref} = odbc:connect(?RDBMS:connection_string(), odbc_test_lib:platform_options()), process_flag(trap_exit, true), Port = lists:last(erlang:ports()), {connected, Ref} = erlang:port_info(Port, connected), exit(Ref, kill), - test_server:sleep(100), - undefined = erlang:port_info(Port, connected), + test_server:sleep(500), + undefined = erlang:port_info(Port, connected). %% Check for c-program still running, how? - ok. -%%------------------------------------------------------------------------- %%------------------------------------------------------------------------- client_dies_normal(doc) -> @@ -319,7 +323,7 @@ client_dies_normal(Config) when is_list(Config) -> end. client_normal(Pid) -> - {ok, Ref} = odbc:connect(?RDBMS:connection_string(), []), + {ok, Ref} = odbc:connect(?RDBMS:connection_string(), odbc_test_lib:platform_options()), Pid ! {dbRef, Ref}, receive continue -> @@ -351,7 +355,7 @@ client_dies_timeout(Config) when is_list(Config) -> end. client_timeout(Pid) -> - {ok, Ref} = odbc:connect(?RDBMS:connection_string(), []), + {ok, Ref} = odbc:connect(?RDBMS:connection_string(), odbc_test_lib:platform_options()), Pid ! {dbRef, Ref}, receive continue -> @@ -383,7 +387,7 @@ client_dies_error(Config) when is_list(Config) -> end. client_error(Pid) -> - {ok, Ref} = odbc:connect(?RDBMS:connection_string(), []), + {ok, Ref} = odbc:connect(?RDBMS:connection_string(), odbc_test_lib:platform_options()), Pid ! {dbRef, Ref}, receive continue -> @@ -398,7 +402,10 @@ connect_timeout(doc) -> connect_timeout(suite) -> []; connect_timeout(Config) when is_list(Config) -> {'EXIT',timeout} = (catch odbc:connect(?RDBMS:connection_string(), - [{timeout, 0}])), + [{timeout, 0}] ++ + odbc_test_lib:platform_options())), + %% Need to return ok here "{'EXIT',timeout} return value" will + %% be interpreted as that the testcase has timed out. ok. %%------------------------------------------------------------------------- timeout(doc) -> @@ -411,10 +418,12 @@ timeout(Config) when is_list(Config) -> [{auto_commit, off}]), Table = ?config(tableName, Config), + TransStr = transaction_support_str(?RDBMS), + {updated, _} = odbc:sql_query(Ref, "CREATE TABLE " ++ Table ++ - " (ID integer, DATA varchar(10), PRIMARY KEY(ID))"), + " (ID integer, DATA varchar(10), PRIMARY KEY(ID))" ++ TransStr), {updated, 1} = odbc:sql_query(Ref, "INSERT INTO " ++ Table ++ " VALUES(1,'bar')"), @@ -446,14 +455,12 @@ timeout(Config) when is_list(Config) -> ["DATA"] = odbc_test_lib:to_upper(Fields), ok = odbc:commit(Ref, commit), - ok = odbc:disconnect(Ref), - ok. - + ok = odbc:disconnect(Ref). update_table_timeout(Table, TimeOut, Pid) -> {ok, Ref} = odbc:connect(?RDBMS:connection_string(), - [{auto_commit, off}]), + [{auto_commit, off}] ++ odbc_test_lib:platform_options()), UpdateQuery = "UPDATE " ++ Table ++ " SET DATA = 'foobar' WHERE ID = 1", case catch odbc:sql_query(Ref, UpdateQuery, TimeOut) of @@ -474,15 +481,16 @@ update_table_timeout(Table, TimeOut, Pid) -> odbc:sql_query(Ref, "SELECT DATA FROM " ++ Table ++ " WHERE ID = 2"), ["DATA"] = odbc_test_lib:to_upper(Fields), - {updated, 1} = odbc:sql_query(Ref, UpdateQuery, TimeOut), + %% Do not check {updated, 1} as some drivers will return 0 + %% even though the update is done, which is checked by the test + %% case when the altered message is recived. + {updated, _} = odbc:sql_query(Ref, UpdateQuery, TimeOut), ok = odbc:commit(Ref, commit), Pid ! altered, - ok = odbc:disconnect(Ref), - - ok. + ok = odbc:disconnect(Ref). %%------------------------------------------------------------------------- many_timeouts(doc) -> ["Tests that many consecutive timeouts lead to that the connection " @@ -490,14 +498,15 @@ many_timeouts(doc) -> many_timeouts(suite) -> []; many_timeouts(Config) when is_list(Config) -> {ok, Ref} = odbc:connect(?RDBMS:connection_string(), - [{auto_commit, off}]), + [{auto_commit, off}] ++ odbc_test_lib:platform_options()), Table = ?config(tableName, Config), + TransStr = transaction_support_str(?RDBMS), {updated, _} = odbc:sql_query(Ref, "CREATE TABLE " ++ Table ++ - " (ID integer, DATA varchar(10), PRIMARY KEY(ID))"), + " (ID integer, DATA varchar(10), PRIMARY KEY(ID))" ++ TransStr), {updated, 1} = odbc:sql_query(Ref, "INSERT INTO " ++ Table ++ " VALUES(1,'bar')"), @@ -517,22 +526,20 @@ many_timeouts(Config) when is_list(Config) -> end, ok = odbc:commit(Ref, commit), - ok = odbc:disconnect(Ref), - ok. + ok = odbc:disconnect(Ref). update_table_many_timeouts(Table, TimeOut, Pid) -> {ok, Ref} = odbc:connect(?RDBMS:connection_string(), - [{auto_commit, off}]), + [{auto_commit, off}] ++ odbc_test_lib:platform_options()), UpdateQuery = "UPDATE " ++ Table ++ " SET DATA = 'foobar' WHERE ID = 1", ok = loop_many_timouts(Ref, UpdateQuery, TimeOut), Pid ! many_timeouts_occurred, - ok = odbc:disconnect(Ref), - ok. + ok = odbc:disconnect(Ref). loop_many_timouts(Ref, UpdateQuery, TimeOut) -> @@ -546,18 +553,19 @@ loop_many_timouts(Ref, UpdateQuery, TimeOut) -> end. %%------------------------------------------------------------------------- timeout_reset(doc) -> - ["Check that the number of consecutive timouts is reset to 0 when " + ["Check that the number of consecutive timouts is reset to 0 when " "a successful call to the database is made."]; timeout_reset(suite) -> []; timeout_reset(Config) when is_list(Config) -> {ok, Ref} = odbc:connect(?RDBMS:connection_string(), - [{auto_commit, off}]), + [{auto_commit, off}] ++ odbc_test_lib:platform_options()), Table = ?config(tableName, Config), + TransStr = transaction_support_str(?RDBMS), {updated, _} = odbc:sql_query(Ref, "CREATE TABLE " ++ Table ++ - " (ID integer, DATA varchar(10), PRIMARY KEY(ID))"), + " (ID integer, DATA varchar(10), PRIMARY KEY(ID))" ++ TransStr), {updated, 1} = odbc:sql_query(Ref, "INSERT INTO " ++ Table ++ " VALUES(1,'bar')"), @@ -593,13 +601,12 @@ timeout_reset(Config) when is_list(Config) -> ["DATA"] = odbc_test_lib:to_upper(Fields), ok = odbc:commit(Ref, commit), - ok = odbc:disconnect(Ref), - ok. + ok = odbc:disconnect(Ref). update_table_timeout_reset(Table, TimeOut, Pid) -> {ok, Ref} = odbc:connect(?RDBMS:connection_string(), - [{auto_commit, off}]), + [{auto_commit, off}] ++ odbc_test_lib:platform_options()), UpdateQuery = "UPDATE " ++ Table ++ " SET DATA = 'foobar' WHERE ID = 1", ok = loop_timout_reset(Ref, UpdateQuery, TimeOut, @@ -616,15 +623,16 @@ update_table_timeout_reset(Table, TimeOut, Pid) -> odbc:sql_query(Ref, "SELECT DATA FROM " ++ Table ++ " WHERE ID = 2"), ["DATA"] = odbc_test_lib:to_upper(Fields), - {updated,1} = odbc:sql_query(Ref, UpdateQuery, TimeOut), + %% Do not check {updated, 1} as some drivers will return 0 + %% even though the update is done, which is checked by the test + %% case when the altered message is recived. + {updated, _} = odbc:sql_query(Ref, UpdateQuery, TimeOut), ok = odbc:commit(Ref, commit), Pid ! altered, - ok = odbc:disconnect(Ref), - - ok. + ok = odbc:disconnect(Ref). loop_timout_reset(_, _, _, 0) -> ok; @@ -648,13 +656,14 @@ disconnect_on_timeout(suite) -> []; disconnect_on_timeout(Config) when is_list(Config) -> {ok, Ref} = odbc:connect(?RDBMS:connection_string(), - [{auto_commit, off}]), + [{auto_commit, off}] ++ odbc_test_lib:platform_options()), Table = ?config(tableName, Config), + TransStr = transaction_support_str(?RDBMS), {updated, _} = odbc:sql_query(Ref, "CREATE TABLE " ++ Table ++ - " (ID integer, DATA varchar(10), PRIMARY KEY(ID))"), + " (ID integer, DATA varchar(10), PRIMARY KEY(ID))" ++ TransStr), {updated, 1} = odbc:sql_query(Ref, "INSERT INTO " ++ Table ++ " VALUES(1,'bar')"), @@ -678,7 +687,7 @@ disconnect_on_timeout(Config) when is_list(Config) -> update_table_disconnect_on_timeout(Table, TimeOut, Pid) -> {ok, Ref} = odbc:connect(?RDBMS:connection_string(), - [{auto_commit, off}]), + [{auto_commit, off}] ++ odbc_test_lib:platform_options()), UpdateQuery = "UPDATE " ++ Table ++ " SET DATA = 'foobar' WHERE ID = 1", case catch odbc:sql_query(Ref, UpdateQuery, TimeOut) of @@ -695,7 +704,7 @@ connection_closed(doc) -> " use a connection that has been closed"]; connection_closed(suite) -> []; connection_closed(Config) when is_list(Config) -> - {ok, Ref} = odbc:connect(?RDBMS:connection_string(), []), + {ok, Ref} = odbc:connect(?RDBMS:connection_string(), odbc_test_lib:platform_options()), Table = ?config(tableName, Config), {updated, _} = @@ -714,8 +723,7 @@ connection_closed(Config) when is_list(Config) -> {error, connection_closed} = odbc:next(Ref), {error, connection_closed} = odbc:prev(Ref), {error, connection_closed} = odbc:select(Ref, next, 3), - {error, connection_closed} = odbc:commit(Ref, commit), - ok. + {error, connection_closed} = odbc:commit(Ref, commit). %%------------------------------------------------------------------------- disable_scrollable_cursors(doc) -> @@ -753,8 +761,7 @@ disable_scrollable_cursors(Config) when is_list(Config) -> {error, scrollable_cursors_disabled} = odbc:select(Ref, {absolute, 2}, 5), - {selected, _ColNames,[]} = odbc:select(Ref, next, 1), - ok. + {selected, _ColNames,[]} = odbc:select(Ref, next, 1). %%------------------------------------------------------------------------- return_rows_as_lists(doc)-> @@ -763,7 +770,7 @@ return_rows_as_lists(doc)-> return_rows_as_lists(suite) -> []; return_rows_as_lists(Config) when is_list(Config) -> {ok, Ref} = odbc:connect(?RDBMS:connection_string(), - [{tuple_row, off}]), + [{tuple_row, off}] ++ odbc_test_lib:platform_options()), Table = ?config(tableName, Config), @@ -784,16 +791,21 @@ return_rows_as_lists(Config) when is_list(Config) -> {ok, _} = odbc:select_count(Ref, "SELECT * FROM " ++ Table), - First = ?RDBMS:first_list_rows(), - Last = ?RDBMS:last_list_rows(), - Prev = ?RDBMS:prev_list_rows(), - Next = ?RDBMS:next_list_rows(), - - Last = odbc:last(Ref), - Prev = odbc:prev(Ref), - First = odbc:first(Ref), - Next = odbc:next(Ref), - ok. + case proplists:get_value(scrollable_cursors, odbc_test_lib:platform_options()) of + off -> + Next = ?RDBMS:next_list_rows(), + Next = odbc:next(Ref); + _ -> + First = ?RDBMS:first_list_rows(), + Last = ?RDBMS:last_list_rows(), + Prev = ?RDBMS:prev_list_rows(), + Next = ?RDBMS:next_list_rows(), + + Last = odbc:last(Ref), + Prev = odbc:prev(Ref), + First = odbc:first(Ref), + Next = odbc:next(Ref) + end. %%------------------------------------------------------------------------- @@ -802,22 +814,27 @@ api_missuse(doc)-> api_missuse(suite) -> []; api_missuse(Config) when is_list(Config)-> - {ok, Ref} = odbc:connect(?RDBMS:connection_string(), []), + {ok, Ref} = odbc:connect(?RDBMS:connection_string(), odbc_test_lib:platform_options()), %% Serious programming fault, connetion will be shut down gen_server:call(Ref, {self(), foobar, 10}, infinity), test_server:sleep(10), undefined = process_info(Ref, status), - {ok, Ref2} = odbc:connect(?RDBMS:connection_string(), []), + {ok, Ref2} = odbc:connect(?RDBMS:connection_string(), + odbc_test_lib:platform_options()), %% Serious programming fault, connetion will be shut down gen_server:cast(Ref2, {self(), foobar, 10}), test_server:sleep(10), undefined = process_info(Ref2, status), - {ok, Ref3} = odbc:connect(?RDBMS:connection_string(), []), + {ok, Ref3} = odbc:connect(?RDBMS:connection_string(), + odbc_test_lib:platform_options()), %% Could be an innocent misstake the connection lives. Ref3 ! foobar, test_server:sleep(10), - {status, _} = process_info(Ref3, status), - ok. + {status, _} = process_info(Ref3, status). +transaction_support_str(mysql) -> + "ENGINE = InnoDB"; +transaction_support_str(_) -> + "". diff --git a/lib/odbc/test/odbc_data_type_SUITE.erl b/lib/odbc/test/odbc_data_type_SUITE.erl index bfb1e4b329..d61a91f973 100644 --- a/lib/odbc/test/odbc_data_type_SUITE.erl +++ b/lib/odbc/test/odbc_data_type_SUITE.erl @@ -44,24 +44,29 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> case odbc_test_lib:odbc_check() of ok -> - [{group, char}, {group, int}, {group, floats}, + [{group, char},{group, fixed_char}, {group, binary_char}, + {group, fixed_binary_char}, {group, unicode}, + {group, int}, {group, floats}, {group, dec_and_num}, timestamp]; Other -> {skip, Other} end. groups() -> [{char, [], - [char_fixed_lower_limit, char_fixed_upper_limit, - char_fixed_padding, varchar_lower_limit, + [varchar_lower_limit, varchar_upper_limit, varchar_no_padding, - text_lower_limit, text_upper_limit, unicode]}, + text_lower_limit, text_upper_limit]}, + {fixed_char, [], + [char_fixed_lower_limit, char_fixed_upper_limit, + char_fixed_padding]}, {binary_char, [], - [binary_char_fixed_lower_limit, - binary_char_fixed_upper_limit, - binary_char_fixed_padding, binary_varchar_lower_limit, + [binary_varchar_lower_limit, binary_varchar_upper_limit, binary_varchar_no_padding, - binary_text_lower_limit, binary_text_upper_limit, - unicode]}, + binary_text_lower_limit, binary_text_upper_limit]}, + {fixed_binary_char, [], [binary_char_fixed_lower_limit, + binary_char_fixed_upper_limit, + binary_char_fixed_padding]}, + {unicode, [], [utf8, nchar, nvarchar]}, {int, [], [tiny_int_lower_limit, tiny_int_upper_limit, small_int_lower_limit, small_int_upper_limit, @@ -74,14 +79,31 @@ groups() -> [dec_long, dec_double, dec_bignum, num_long, num_double, num_bignum]}]. +init_per_group(GroupName, Config) when GroupName == fixed_char; + GroupName == fixed_binary_char -> + case ?RDBMS of + mysql -> + {skip, "No supported by MYSQL"}; + _ -> + Config + end; + +init_per_group(unicode, Config) -> + case {os:type(), erlang:system_info({wordsize, external})} of + {{unix, _}, 4} -> + Config; + {{unix, _}, _} -> + {skip, "Postgres drivers pre version psqlODBC 08.04.0200 have utf8-problems"}; + _ -> + Config + end; + init_per_group(_GroupName, Config) -> Config. end_per_group(_GroupName, Config) -> Config. - - %%-------------------------------------------------------------------- %% Function: init_per_suite(Config) -> Config %% Config - [tuple()] @@ -91,10 +113,18 @@ end_per_group(_GroupName, Config) -> %% Note: This function is free to add any key/value pairs to the Config %% variable, but should NOT alter/remove any existing entries. %%-------------------------------------------------------------------- -init_per_suite(Config) -> - application:start(odbc), - [{tableName, odbc_test_lib:unique_table_name()} | Config]. - +init_per_suite(Config) when is_list(Config) -> + case odbc_test_lib:skip() of + true -> + {skip, "ODBC not supported"}; + false -> + case (catch odbc:start()) of + ok -> + [{tableName, odbc_test_lib:unique_table_name()}| Config]; + _ -> + {skip, "ODBC not startable"} + end + end. %%-------------------------------------------------------------------- %% Function: end_per_suite(Config) -> _ %% Config - [tuple()] @@ -117,22 +147,81 @@ end_per_suite(_Config) -> %% Note: This function is free to add any key/value pairs to the Config %% variable, but should NOT alter/remove any existing entries. %%-------------------------------------------------------------------- +init_per_testcase(Case, Config) when Case == varchar_upper_limit; + Case == binary_varchar_upper_limit; + Case == varchar_no_padding; + Case == binary_varchar_no_padding -> + case is_fixed_upper_limit(?RDBMS) of + true -> + common_init_per_testcase(Case, Config); + false -> + {skip, "Upper limit is not fixed in" ++ atom_to_list(?RDBMS)} + end; + +init_per_testcase(text_upper_limit, _Config) -> + {skip, "Consumes too much resources"}; + +init_per_testcase(Case, Config) when Case == bit_true; Case == bit_false -> + case is_supported_bit(?RDBMS) of + true -> + common_init_per_testcase(Case, Config); + false -> + {skip, "Not supported by driver"} + end; + +init_per_testcase(param_insert_tiny_int = Case, Config) -> + case is_supported_tinyint(?RDBMS) of + true -> + common_init_per_testcase(Case, Config); + false -> + {skip, "Not supported by driver"} + end; + +init_per_testcase(Case, Config) when Case == nchar; + Case == nvarchar -> + case ?RDBMS of + sqlserver -> + common_init_per_testcase(Case, Config); + _ -> + {skip, "Not supported by driver"} + end; + init_per_testcase(Case, Config) -> + common_init_per_testcase(Case, Config). + +common_init_per_testcase(Case, Config) -> + PlatformOptions = odbc_test_lib:platform_options(), case atom_to_list(Case) of "binary" ++ _ -> {ok, Ref} = odbc:connect(?RDBMS:connection_string(), - [{binary_strings, on}]); - "unicode" -> + [{binary_strings, on}] ++ PlatformOptions); + LCase when LCase == "utf8"; + LCase == "nchar"; + LCase == "nvarchar" -> {ok, Ref} = odbc:connect(?RDBMS:connection_string(), - [{binary_strings, on}]); + [{binary_strings, on}] ++ PlatformOptions); _ -> - {ok, Ref} = odbc:connect(?RDBMS:connection_string(), []) + {ok, Ref} = odbc:connect(?RDBMS:connection_string(), PlatformOptions) end, + odbc_test_lib:strict(Ref, ?RDBMS), Dog = test_server:timetrap(?default_timeout), Temp = lists:keydelete(connection_ref, 1, Config), NewConfig = lists:keydelete(watchdog, 1, Temp), [{watchdog, Dog}, {connection_ref, Ref} | NewConfig]. +is_fixed_upper_limit(mysql) -> + false; +is_fixed_upper_limit(_) -> + true. +is_supported_tinyint(sqlserver) -> + true; +is_supported_tinyint(_) -> + false. +is_supported_bit(sqlserver) -> + true; +is_supported_bit(_) -> + false. + %%-------------------------------------------------------------------- %% Function: end_per_testcase(Case, Config) -> _ %% Case - atom() @@ -146,7 +235,7 @@ end_per_testcase(_TestCase, Config) -> ok = odbc:disconnect(Ref), %% Clean up if needed Table = ?config(tableName, Config), - {ok, NewRef} = odbc:connect(?RDBMS:connection_string(), []), + {ok, NewRef} = odbc:connect(?RDBMS:connection_string(), odbc_test_lib:platform_options()), odbc:sql_query(NewRef, "DROP TABLE " ++ Table), odbc:disconnect(NewRef), Dog = ?config(watchdog, Config), @@ -169,18 +258,18 @@ char_fixed_lower_limit(Config) when is_list(Config) -> {error, _} = odbc:sql_query(Ref, "CREATE TABLE " ++ Table ++ - ?RDBMS:create_fixed_char_table( + ?RDBMS:create_fixed_char_table( (?RDBMS:fixed_char_min() - 1))), %% Lower limit {updated, _} = % Value == 0 || -1 driver dependent! odbc:sql_query(Ref, "CREATE TABLE " ++ Table ++ - ?RDBMS:create_fixed_char_table( - ?RDBMS:fixed_char_min())), + ?RDBMS:create_fixed_char_table( + ?RDBMS:fixed_char_min())), %% Right length data {updated, _} = odbc:sql_query(Ref, "INSERT INTO " ++ Table ++" VALUES(" ++ - "'" ++ string:chars($a, ?RDBMS:fixed_char_min()) + "'" ++ string:chars($a, ?RDBMS:fixed_char_min()) ++ "')"), %% Select data {selected, Fields,[{"a"}]} = @@ -191,11 +280,11 @@ char_fixed_lower_limit(Config) when is_list(Config) -> %% Too long data {error, _} = odbc:sql_query(Ref,"INSERT INTO " ++ Table ++" VALUES(" ++ - "'" ++ string:chars($a, - (?RDBMS:fixed_char_min() - + 1)) - ++ "')"), - ok. + "'" ++ string:chars($a, + (?RDBMS:fixed_char_min() + + 1)) + ++ "')"). + %%------------------------------------------------------------------------- char_fixed_upper_limit(doc) -> @@ -243,8 +332,7 @@ char_fixed_upper_limit(Config) when is_list(Config) -> {error, _} = odbc:sql_query(Ref, "CREATE TABLE " ++ Table ++ ?RDBMS:create_fixed_char_table( - (?RDBMS:fixed_char_max() + 1))), - ok + (?RDBMS:fixed_char_max() + 1))) end. %%------------------------------------------------------------------------- @@ -261,20 +349,20 @@ char_fixed_padding(Config) when is_list(Config) -> %% Data should be padded with blanks {updated, _} = % Value == 0 || -1 driver dependent! odbc:sql_query(Ref, "CREATE TABLE " ++ Table ++ - ?RDBMS:create_fixed_char_table( - ?RDBMS:fixed_char_max())), + ?RDBMS:create_fixed_char_table( + ?RDBMS:fixed_char_max())), - {updated, _} = + {updated, _} = odbc:sql_query(Ref, "INSERT INTO " ++ Table ++" VALUES(" ++ - "'" ++ string:chars($a, - ?RDBMS:fixed_char_min()) + "'" ++ string:chars($a, + ?RDBMS:fixed_char_min()) ++ "')"), {selected, Fields, [{CharStr}]} = odbc:sql_query(Ref,"SELECT FIELD FROM " ++ Table), true = length(CharStr) == ?RDBMS:fixed_char_max(), - ["FIELD"] = odbc_test_lib:to_upper(Fields), - ok. + ["FIELD"] = odbc_test_lib:to_upper(Fields). + %%------------------------------------------------------------------------- varchar_lower_limit(doc) -> @@ -287,33 +375,33 @@ varchar_lower_limit(Config) when is_list(Config) -> %% Below limit {error, _} = - odbc:sql_query(Ref, "CREATE TABLE " ++ Table ++ - ?RDBMS:create_var_char_table( - ?RDBMS:var_char_min() - 1)), + odbc:sql_query(Ref, "CREATE TABLE " ++ Table ++ + ?RDBMS:create_var_char_table( + ?RDBMS:var_char_min() - 1)), %% Lower limit {updated, _} = % Value == 0 || -1 driver dependent! odbc:sql_query(Ref, "CREATE TABLE " ++ Table ++ - ?RDBMS:create_var_char_table( - ?RDBMS:var_char_min())), + ?RDBMS:create_var_char_table( + ?RDBMS:var_char_min())), + + Str = string:chars($a, ?RDBMS:var_char_min()), %% Right length data {updated, _} = odbc:sql_query(Ref, "INSERT INTO " ++ Table ++" VALUES(" ++ - "'" ++ string:chars($a, ?RDBMS:var_char_min()) - ++ "')"), + "'" ++ Str ++ "')"), %% Select data - {selected, Fields, [{"a"}]} = + {selected, Fields, [{Str}]} = odbc:sql_query(Ref,"SELECT FIELD FROM " ++ Table), ["FIELD"] = odbc_test_lib:to_upper(Fields), - %% Too long data - {error, _} = - odbc:sql_query(Ref, "INSERT INTO " ++ Table ++" VALUES(" ++ - "'" ++ string:chars($a, - (?RDBMS:var_char_min()+1)) - ++ "')"), - ok. + %% Too long datae + {error, _} = + odbc:sql_query(Ref, "INSERT INTO " ++ Table ++" VALUES(" ++ + "'" ++ string:chars($a, + (?RDBMS:var_char_min()+1)) + ++ "')"). %%------------------------------------------------------------------------- @@ -389,8 +477,7 @@ varchar_no_padding(Config) when is_list(Config) -> {selected, Fields, [{CharStr}]} = odbc:sql_query(Ref,"SELECT FIELD FROM " ++ Table), true = length(CharStr) /= ?RDBMS:var_char_max(), - ["FIELD"] = odbc_test_lib:to_upper(Fields), - ok. + ["FIELD"] = odbc_test_lib:to_upper(Fields). %%------------------------------------------------------------------------- @@ -413,8 +500,7 @@ text_lower_limit(Config) when is_list(Config) -> {selected, Fields, [{"a"}]} = odbc:sql_query(Ref,"SELECT FIELD FROM " ++ Table), - ["FIELD"] = odbc_test_lib:to_upper(Fields), - ok. + ["FIELD"] = odbc_test_lib:to_upper(Fields). %%------------------------------------------------------------------------- @@ -444,8 +530,7 @@ text_upper_limit(Config) when is_list(Config) -> %% {error, _} = %% odbc:sql_query(Ref, "INSERT INTO " ++ Table ++" VALUES(" ++ %% "'" ++ string:chars($a, (?RDBMS:text_max()+1)) -%% ++ "')"), -%% ok. +%% ++ "')"). %%------------------------------------------------------------------------- @@ -469,13 +554,18 @@ binary_char_fixed_lower_limit(Config) when is_list(Config) -> ?RDBMS:create_fixed_char_table( ?RDBMS:fixed_char_min())), + Str = string:chars($a, ?RDBMS:fixed_char_min()), + %% Right length data {updated, _} = odbc:sql_query(Ref, "INSERT INTO " ++ Table ++" VALUES(" ++ - "'" ++ string:chars($a, ?RDBMS:fixed_char_min()) + "'" ++ Str ++ "')"), + + Bin = list_to_binary(Str), + %% Select data - {selected, Fields,[{<<"a">>}]} = + {selected, Fields,[{Bin}]} = odbc:sql_query(Ref,"SELECT FIELD FROM " ++ Table), ["FIELD"] = odbc_test_lib:to_upper(Fields), @@ -486,8 +576,7 @@ binary_char_fixed_lower_limit(Config) when is_list(Config) -> "'" ++ string:chars($a, (?RDBMS:fixed_char_min() + 1)) - ++ "')"), - ok. + ++ "')"). %%------------------------------------------------------------------------- binary_char_fixed_upper_limit(doc) -> @@ -565,8 +654,8 @@ binary_char_fixed_padding(Config) when is_list(Config) -> {selected, Fields, [{CharBin}]} = odbc:sql_query(Ref,"SELECT FIELD FROM " ++ Table), true = size(CharBin) == ?RDBMS:fixed_char_max(), - ["FIELD"] = odbc_test_lib:to_upper(Fields), - ok. + ["FIELD"] = odbc_test_lib:to_upper(Fields). + %%------------------------------------------------------------------------- binary_varchar_lower_limit(doc) -> @@ -588,13 +677,17 @@ binary_varchar_lower_limit(Config) when is_list(Config) -> ?RDBMS:create_var_char_table( ?RDBMS:var_char_min())), + Str = string:chars($a, ?RDBMS:var_char_min()), + %% Right length data {updated, _} = odbc:sql_query(Ref, "INSERT INTO " ++ Table ++" VALUES(" ++ - "'" ++ string:chars($a, ?RDBMS:var_char_min()) + "'" ++ Str ++ "')"), + BinStr = list_to_binary(Str), + %% Select data - {selected, Fields, [{<<"a">>}]} = + {selected, Fields, [{BinStr}]} = odbc:sql_query(Ref,"SELECT FIELD FROM " ++ Table), ["FIELD"] = odbc_test_lib:to_upper(Fields), @@ -604,8 +697,7 @@ binary_varchar_lower_limit(Config) when is_list(Config) -> odbc:sql_query(Ref, "INSERT INTO " ++ Table ++" VALUES(" ++ "'" ++ string:chars($a, (?RDBMS:var_char_min()+1)) - ++ "')"), - ok. + ++ "')"). %%------------------------------------------------------------------------- @@ -654,8 +746,7 @@ binary_varchar_upper_limit(Config) when is_list(Config) -> {error, _} = odbc:sql_query(Ref, "CREATE TABLE " ++ Table ++ ?RDBMS:create_var_char_table( - (?RDBMS:var_char_max() + 1))), - ok + (?RDBMS:var_char_max() + 1))) end. %%------------------------------------------------------------------------- @@ -681,8 +772,7 @@ binary_varchar_no_padding(Config) when is_list(Config) -> {selected, Fields, [{CharBin}]} = odbc:sql_query(Ref,"SELECT FIELD FROM " ++ Table), true = size(CharBin) /= ?RDBMS:var_char_max(), - ["FIELD"] = odbc_test_lib:to_upper(Fields), - ok. + ["FIELD"] = odbc_test_lib:to_upper(Fields). %%------------------------------------------------------------------------- @@ -705,8 +795,7 @@ binary_text_lower_limit(Config) when is_list(Config) -> {selected, Fields, [{<<"a">>}]} = odbc:sql_query(Ref,"SELECT FIELD FROM " ++ Table), - ["FIELD"] = odbc_test_lib:to_upper(Fields), - ok. + ["FIELD"] = odbc_test_lib:to_upper(Fields). %%------------------------------------------------------------------------- @@ -736,11 +825,7 @@ binary_text_upper_limit(Config) when is_list(Config) -> %% {error, _} = %% odbc:sql_query(Ref, "INSERT INTO " ++ Table ++" VALUES(" ++ %% "'" ++ string:chars($a, (?RDBMS:text_max()+1)) -%% ++ "')"), -%% ok. - - -%%------------------------------------------------------------------------- +%% ++ "')"). %%------------------------------------------------------------------------- @@ -774,8 +859,7 @@ tiny_int_lower_limit(Config) when is_list(Config) -> odbc:sql_query(Ref, "INSERT INTO " ++ Table ++" VALUES(" ++ "'" ++ integer_to_list(?RDBMS:tiny_int_min() - 1) - ++ "')"), - ok + ++ "')") end. %%------------------------------------------------------------------------- @@ -809,8 +893,7 @@ tiny_int_upper_limit(Config) when is_list(Config) -> odbc:sql_query(Ref, "INSERT INTO " ++ Table ++" VALUES(" ++ "'" ++ integer_to_list(?RDBMS:tiny_int_max() + 1) - ++ "')"), - ok + ++ "')") end. %%------------------------------------------------------------------------- @@ -840,8 +923,7 @@ small_int_lower_limit(Config) when is_list(Config) -> odbc:sql_query(Ref, "INSERT INTO " ++ Table ++" VALUES(" ++ "'" ++ integer_to_list(?RDBMS:small_int_min() - 1) - ++ "')"), - ok. + ++ "')"). %%------------------------------------------------------------------------- @@ -870,8 +952,7 @@ small_int_upper_limit(Config) when is_list(Config) -> odbc:sql_query(Ref,"INSERT INTO " ++ Table ++" VALUES(" ++ "'" ++ integer_to_list(?RDBMS:small_int_max() + 1) - ++ "')"), - ok. + ++ "')"). %%------------------------------------------------------------------------- int_lower_limit(doc) -> @@ -898,8 +979,7 @@ int_lower_limit(Config) when is_list(Config) -> {error, _} = odbc:sql_query(Ref, "INSERT INTO " ++ Table ++" VALUES(" ++ "'" ++ integer_to_list(?RDBMS:int_min() - 1) - ++ "')"), - ok. + ++ "')"). %%------------------------------------------------------------------------- @@ -927,8 +1007,7 @@ int_upper_limit(Config) when is_list(Config) -> {error, _} = odbc:sql_query(Ref, "INSERT INTO " ++ Table ++" VALUES(" ++ "'" ++ integer_to_list(?RDBMS:int_max() + 1) - ++ "')"), - ok. + ++ "')"). %%------------------------------------------------------------------------- @@ -957,8 +1036,7 @@ big_int_lower_limit(Config) when is_list(Config) -> odbc:sql_query(Ref, "INSERT INTO " ++ Table ++" VALUES(" ++ "'" ++ integer_to_list(?RDBMS:big_int_min() - 1) - ++ "')"), - ok. + ++ "')"). %%------------------------------------------------------------------------- @@ -987,8 +1065,7 @@ big_int_upper_limit(Config) when is_list(Config) -> odbc:sql_query(Ref, "INSERT INTO " ++ Table ++" VALUES(" ++ "'" ++ integer_to_list(?RDBMS:big_int_max() + 1) - ++ "')"), - ok. + ++ "')"). %%------------------------------------------------------------------------- bit_false(doc) -> @@ -1020,8 +1097,7 @@ bit_false(Config) when is_list(Config) -> {error, _} = odbc:sql_query(Ref, "INSERT INTO " ++ Table ++" VALUES(" ++ "'" ++ integer_to_list(-1) - ++ "')"), - ok + ++ "')") end. %%------------------------------------------------------------------------- @@ -1056,14 +1132,10 @@ bit_true(Config) when is_list(Config) -> {error, _} = odbc:sql_query(Ref, "INSERT INTO " ++ Table ++" VALUES(" ++ "'" ++ integer_to_list(-1) - ++ "')"), - ok + ++ "')") end. %%------------------------------------------------------------------------- - - -%%------------------------------------------------------------------------- float_lower_limit(doc) -> [""]; float_lower_limit(suite) -> @@ -1073,44 +1145,45 @@ float_lower_limit(Config) when is_list(Config) -> Ref = ?config(connection_ref, Config), Table = ?config(tableName, Config), - {updated, _} = % Value == 0 || -1 driver dependent! - odbc:sql_query(Ref, "CREATE TABLE " ++ Table ++ - ?RDBMS:create_float_table()), - - {updated, _} = - odbc:sql_query(Ref, "INSERT INTO " ++ Table ++" VALUES(" ++ - "'" ++ float_to_list( - ?RDBMS:float_min()) - ++ "')"), - {selected,[_ColName],[{MinFloat}]} = - odbc:sql_query(Ref,"SELECT FIELD FROM " ++ Table), - - true = ?RDBMS:float_min() == MinFloat, - case ?RDBMS of - oracle -> - {updated, _} = % Value == 0 || -1 driver dependent! - odbc:sql_query(Ref, "DROP TABLE " ++ Table), - + mysql -> + {skip, "Not clearly defined in MYSQL"}; + _ -> {updated, _} = % Value == 0 || -1 driver dependent! odbc:sql_query(Ref, "CREATE TABLE " ++ Table ++ - ?RDBMS:create_float_table()), + ?RDBMS:create_float_table()), {updated, _} = - odbc:sql_query(Ref, - "INSERT INTO " ++ Table ++" VALUES(" ++ - ?RDBMS:float_underflow() ++ ")"), - - SelectResult = ?RDBMS:float_zero_selected(), - SelectResult = - odbc:sql_query(Ref,"SELECT FIELD FROM " ++ Table); - _ -> - {error, _} = odbc:sql_query(Ref, "INSERT INTO " ++ Table ++" VALUES(" ++ - ?RDBMS:float_underflow() ++ ")") - end, - ok. + "'" ++ float_to_list( + ?RDBMS:float_min()) + ++ "')"), + {selected,[_ColName],[{MinFloat}]} = + odbc:sql_query(Ref,"SELECT FIELD FROM " ++ Table), + true = ?RDBMS:float_min() == MinFloat, + + case ?RDBMS of + oracle -> + {updated, _} = % Value == 0 || -1 driver dependent! + odbc:sql_query(Ref, "DROP TABLE " ++ Table), + + {updated, _} = % Value == 0 || -1 driver dependent! + odbc:sql_query(Ref, "CREATE TABLE " ++ Table ++ + ?RDBMS:create_float_table()), + {updated, _} = + odbc:sql_query(Ref, + "INSERT INTO " ++ Table ++" VALUES(" ++ + ?RDBMS:float_underflow() ++ ")"), + SelectResult = ?RDBMS:float_zero_selected(), + SelectResult = + odbc:sql_query(Ref,"SELECT FIELD FROM " ++ Table); + _ -> + {error, _} = + odbc:sql_query(Ref, "INSERT INTO " ++ Table ++" VALUES(" ++ + ?RDBMS:float_underflow() ++ ")") + end + end. %%------------------------------------------------------------------------- float_upper_limit(doc) -> @@ -1121,26 +1194,28 @@ float_upper_limit(Config) when is_list(Config) -> Ref = ?config(connection_ref, Config), Table = ?config(tableName, Config), - {updated, _} = % Value == 0 || -1 driver dependent! - odbc:sql_query(Ref, "CREATE TABLE " ++ Table ++ - ?RDBMS:create_float_table()), - - {updated, _} = - odbc:sql_query(Ref, "INSERT INTO " ++ Table ++" VALUES(" ++ - "'" ++ float_to_list( - ?RDBMS:float_max()) - ++ "')"), - + case ?RDBMS of + mysql -> + {skip, "Not clearly defined in MYSQL"}; + _-> + {updated, _} = % Value == 0 || -1 driver dependent! + odbc:sql_query(Ref, "CREATE TABLE " ++ Table ++ + ?RDBMS:create_float_table()), - {selected,[_ColName],[{MaxFloat}]} - = odbc:sql_query(Ref,"SELECT FIELD FROM " ++ Table), + {updated, _} = + odbc:sql_query(Ref, "INSERT INTO " ++ Table ++" VALUES(" ++ + "'" ++ float_to_list( + ?RDBMS:float_max()) + ++ "')"), + {selected,[_ColName],[{MaxFloat}]} + = odbc:sql_query(Ref,"SELECT FIELD FROM " ++ Table), - true = ?RDBMS:float_max() == MaxFloat, + true = ?RDBMS:float_max() == MaxFloat, - {error, _} = - odbc:sql_query(Ref, "INSERT INTO " ++ Table ++" VALUES(" ++ - ?RDBMS:float_overflow() ++ ")"), - ok. + {error, _} = + odbc:sql_query(Ref, "INSERT INTO " ++ Table ++" VALUES(" ++ + ?RDBMS:float_overflow() ++ ")") + end. %%------------------------------------------------------------------------- float_zero(doc) -> @@ -1160,8 +1235,7 @@ float_zero(Config) when is_list(Config) -> SelectResult = ?RDBMS:float_zero_selected(), SelectResult = - odbc:sql_query(Ref,"SELECT FIELD FROM " ++ Table), - ok. + odbc:sql_query(Ref,"SELECT FIELD FROM " ++ Table). %%------------------------------------------------------------------------- real_zero(doc) -> ["Test the real value zero."]; @@ -1185,10 +1259,8 @@ real_zero(Config) when is_list(Config) -> SelectResult = ?RDBMS:real_zero_selected(), SelectResult = - odbc:sql_query(Ref,"SELECT FIELD FROM " ++ Table), - ok + odbc:sql_query(Ref,"SELECT FIELD FROM " ++ Table) end. -%%------------------------------------------------------------------------- %%------------------------------------------------------------------------ dec_long(doc) -> [""]; @@ -1207,8 +1279,7 @@ dec_long(Config) when is_list(Config) -> {selected, Fields, [{2}]} = odbc:sql_query(Ref,"SELECT FIELD FROM " ++ Table), - ["FIELD"] = odbc_test_lib:to_upper(Fields), - ok. + ["FIELD"] = odbc_test_lib:to_upper(Fields). %%------------------------------------------------------------------------ dec_double(doc) -> [""]; @@ -1255,8 +1326,7 @@ dec_double(Config) when is_list(Config) -> {selected, Fields2, [{1.60000}]} = odbc:sql_query(Ref,"SELECT FIELD FROM " ++ Table), - ["FIELD"] = odbc_test_lib:to_upper(Fields2), - ok. + ["FIELD"] = odbc_test_lib:to_upper(Fields2). %%------------------------------------------------------------------------ dec_bignum(doc) -> @@ -1289,8 +1359,7 @@ dec_bignum(Config) when is_list(Config) -> {selected, Fields1, [{"1.6"}]} = odbc:sql_query(Ref,"SELECT FIELD FROM " ++ Table), - ["FIELD"] = odbc_test_lib:to_upper(Fields1), - ok. + ["FIELD"] = odbc_test_lib:to_upper(Fields1). %%------------------------------------------------------------------------ num_long(doc) -> [""]; @@ -1309,8 +1378,7 @@ num_long(Config) when is_list(Config) -> {selected, Fields, [{2}]} = odbc:sql_query(Ref,"SELECT FIELD FROM " ++ Table), - ["FIELD"] = odbc_test_lib:to_upper(Fields), - ok. + ["FIELD"] = odbc_test_lib:to_upper(Fields). %%------------------------------------------------------------------------ num_double(doc) -> [""]; @@ -1356,8 +1424,7 @@ num_double(Config) when is_list(Config) -> {selected, Fields2, [{1.6000}]} = odbc:sql_query(Ref,"SELECT FIELD FROM " ++ Table), - ["FIELD"] = odbc_test_lib:to_upper(Fields2), - ok. + ["FIELD"] = odbc_test_lib:to_upper(Fields2). %%------------------------------------------------------------------------ num_bignum(doc) -> [""]; @@ -1389,21 +1456,19 @@ num_bignum(Config) when is_list(Config) -> {selected, Fields1, [{"1.6"}]} = odbc:sql_query(Ref,"SELECT FIELD FROM " ++ Table), - ["FIELD"] = odbc_test_lib:to_upper(Fields1), - ok. + ["FIELD"] = odbc_test_lib:to_upper(Fields1). %%------------------------------------------------------------------------ -unicode(doc) -> +utf8(doc) -> ["Test unicode support"]; -unicode(suit) -> +utf8(suit) -> []; -unicode(Config) when is_list(Config) -> +utf8(Config) when is_list(Config) -> Ref = ?config(connection_ref, Config), Table = ?config(tableName, Config), - {updated, _} = % Value == 0 || -1 driver dependent! - odbc:sql_query(Ref, "CREATE TABLE " ++ Table ++ - ?RDBMS:create_unicode_table()), + odbc:sql_query(Ref, "CREATE TABLE " ++ Table ++ "(FIELD text)"), + Latin1Data = ["���������", "testasdf", "Row 3", @@ -1416,39 +1481,7 @@ unicode(Config) when is_list(Config) -> "Row 10", "Row 11", "Row 12"], - - case ?RDBMS of - sqlserver -> - w_char_support_win(Ref, Table, Latin1Data); - postgres -> - direct_utf8(Ref, Table, Latin1Data); - oracle -> - {skip, "not currently supported"} - end. - -w_char_support_win(Ref, Table, Latin1Data) -> - UnicodeIn = lists:map(fun(S) -> - unicode:characters_to_binary(S,latin1,{utf16,little}) - end, - Latin1Data), - - test_server:format("UnicodeIn (utf 16): ~p ~n",[UnicodeIn]), - {updated, _} = odbc:param_query(Ref, "INSERT INTO " ++ Table ++ "(FIELD) values(?)", - [{{sql_wvarchar,50},UnicodeIn}]), - - {selected,_,UnicodeOut} = odbc:sql_query(Ref,"SELECT * FROM " ++ Table), - - test_server:format("UnicodeOut: ~p~n", [UnicodeOut]), - - Result = lists:map(fun({Unicode}) -> - unicode:characters_to_list(Unicode,{utf16,little}) - end, - UnicodeOut), - Latin1Data = Result. - - -direct_utf8(Ref, Table, Latin1Data) -> UnicodeIn = lists:map(fun(String) -> unicode:characters_to_binary(String,latin1,utf8) end, @@ -1469,6 +1502,37 @@ direct_utf8(Ref, Table, Latin1Data) -> test_server:format("Result: ~p ~n", [Result]), Latin1Data = Result. +%%------------------------------------------------------------------------ + +nchar(doc) -> + ["Test unicode nchar support in sqlserver"]; +nchar(suit) -> + []; +nchar(Config) when is_list(Config) -> + Ref = ?config(connection_ref, Config), + Table = ?config(tableName, Config), + + {updated, _} = % Value == 0 || -1 driver dependent! + odbc:sql_query(Ref, "CREATE TABLE " ++ Table ++ + "(FIELD nchar(50))"), + + w_char_support(Ref, Table, sql_wvarchar, 50). + +%%------------------------------------------------------------------------ + +nvarchar(doc) -> + ["Test 'unicode' nvarchar support"]; +nvarchar(suit) -> + []; +nvarchar(Config) when is_list(Config) -> + Ref = ?config(connection_ref, Config), + Table = ?config(tableName, Config), + + {updated, _} = % Value == 0 || -1 driver dependent! + odbc:sql_query(Ref, "CREATE TABLE " ++ Table ++ + "(FIELD nvarchar(50))"), + + w_char_support(Ref, Table, sql_wlongvarchar, 50). %%------------------------------------------------------------------------ timestamp(doc) -> @@ -1497,3 +1561,43 @@ timestamp(Config) when is_list(Config) -> TimeStamps = lists:map(fun(Value) -> {Value} end, Data), {selected,_, TimeStamps} = odbc:sql_query(Ref, "SELECT * FROM " ++ Table). +%%------------------------------------------------------------------------ + +w_char_support(Ref, Table, CharType, Size) -> + Latin1Data = ["���������", + "testasdf", + "Row 3", + "Row 4", + "Row 5", + "Row 6", + "Row 7", + "Row 8", + "Row 9", + "Row 10", + "Row 11", + "Row 12"], + + UnicodeIn = lists:map(fun(S) -> + unicode:characters_to_binary(S,latin1,{utf16,little}) + end, + Latin1Data), + + test_server:format("UnicodeIn (utf 16): ~p ~n",[UnicodeIn]), + + {updated, _} = odbc:param_query(Ref, "INSERT INTO " ++ Table ++ "(FIELD) values(?)", + [{{CharType, Size},UnicodeIn}]), + + {selected,_,UnicodeOut} = odbc:sql_query(Ref,"SELECT * FROM " ++ Table), + + test_server:format("UnicodeOut: ~p~n", [UnicodeOut]), + + PadResult = lists:map(fun({Unicode}) -> + unicode:characters_to_list(Unicode,{utf16,little}) + end, + UnicodeOut), + + test_server:format("Result: ~p~n", [PadResult]), + + Result = lists:map(fun(Str) -> string:strip(Str) end, PadResult), + + Latin1Data = Result. diff --git a/lib/odbc/test/odbc_query_SUITE.erl b/lib/odbc/test/odbc_query_SUITE.erl index 8b8d1e7a40..1852678b4b 100644 --- a/lib/odbc/test/odbc_query_SUITE.erl +++ b/lib/odbc/test/odbc_query_SUITE.erl @@ -43,19 +43,22 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> case odbc_test_lib:odbc_check() of ok -> - [sql_query, first, last, next, prev, select_count, + [sql_query, next, {group, scrollable_cursors}, select_count, select_next, select_relative, select_absolute, create_table_twice, delete_table_twice, duplicate_key, not_connection_owner, no_result_set, query_error, - multiple_select_result_sets, multiple_mix_result_sets, - multiple_result_sets_error, + {group, multiple_result_sets}, {group, parameterized_queries}, {group, describe_table}, delete_nonexisting_row]; Other -> {skip, Other} end. groups() -> - [{parameterized_queries, [], + [{multiple_result_sets, [], [multiple_select_result_sets, + multiple_mix_result_sets, + multiple_result_sets_error]}, + {scrollable_cursors, [], [first, last, prev]}, + {parameterized_queries, [], [{group, param_integers}, param_insert_decimal, param_insert_numeric, {group, param_insert_string}, param_insert_float, param_insert_real, @@ -72,15 +75,27 @@ groups() -> [describe_integer, describe_string, describe_floating, describe_dec_num, describe_no_such_table]}]. -init_per_group(_GroupName, Config) -> +init_per_group(multiple_result_sets, Config) -> + case is_supported_multiple_resultsets(?RDBMS) of + true -> + Config; + false -> + {skip, "Not supported by " ++ atom_to_list(?RDBMS) ++ "driver"} + end; +init_per_group(scrollable_cursors, Config) -> + case proplists:get_value(scrollable_cursors, odbc_test_lib:platform_options()) of + off -> + {skip, "Not supported by driver"}; + _ -> + Config + end; + +init_per_group(_,Config) -> Config. end_per_group(_GroupName, Config) -> Config. - - - %%-------------------------------------------------------------------- %% Function: init_per_suite(Config) -> Config %% Config - [tuple()] @@ -91,8 +106,17 @@ end_per_group(_GroupName, Config) -> %% variable, but should NOT alter/remove any existing entries. %%-------------------------------------------------------------------- init_per_suite(Config) when is_list(Config) -> - application:start(odbc), - [{tableName, odbc_test_lib:unique_table_name()}| Config]. + case odbc_test_lib:skip() of + true -> + {skip, "ODBC not supported"}; + false -> + case (catch odbc:start()) of + ok -> + [{tableName, odbc_test_lib:unique_table_name()}| Config]; + _ -> + {skip, "ODBC not startable"} + end + end. %%-------------------------------------------------------------------- %% Function: end_per_suite(Config) -> _ @@ -117,7 +141,8 @@ end_per_suite(_Config) -> %% variable, but should NOT alter/remove any existing entries. %%-------------------------------------------------------------------- init_per_testcase(_Case, Config) -> - {ok, Ref} = odbc:connect(?RDBMS:connection_string(), []), + {ok, Ref} = odbc:connect(?RDBMS:connection_string(), odbc_test_lib:platform_options()), + odbc_test_lib:strict(Ref, ?RDBMS), Dog = test_server:timetrap(?default_timeout), Temp = lists:keydelete(connection_ref, 1, Config), NewConfig = lists:keydelete(watchdog, 1, Temp), @@ -136,7 +161,7 @@ end_per_testcase(_Case, Config) -> ok = odbc:disconnect(Ref), %% Clean up if needed Table = ?config(tableName, Config), - {ok, NewRef} = odbc:connect(?RDBMS:connection_string(), []), + {ok, NewRef} = odbc:connect(?RDBMS:connection_string(), odbc_test_lib:platform_options()), odbc:sql_query(NewRef, "DROP TABLE " ++ Table), odbc:disconnect(NewRef), Dog = ?config(watchdog, Config), @@ -663,9 +688,6 @@ multiple_result_sets_error(Config) when is_list(Config) -> end. %%------------------------------------------------------------------------- - -%%------------------------------------------------------------------------- -%%------------------------------------------------------------------------- param_insert_tiny_int(doc)-> ["Test insertion of tiny ints by parameterized queries."]; param_insert_tiny_int(suite) -> @@ -901,8 +923,6 @@ param_insert_numeric(Config) when is_list(Config) -> ok. %%------------------------------------------------------------------------- - -%%------------------------------------------------------------------------- param_insert_char(doc)-> ["Test insertion of fixed length string by parameterized queries."]; param_insert_char(suite) -> @@ -1325,8 +1345,6 @@ param_select(Config) when is_list(Config) -> ok. %%------------------------------------------------------------------------- - -%%------------------------------------------------------------------------- describe_integer(doc) -> ["Test describe_table/[2,3] for integer columns."]; describe_integer(suite) -> @@ -1338,7 +1356,7 @@ describe_integer(Config) when is_list(Config) -> {updated, _} = odbc:sql_query(Ref, "CREATE TABLE " ++ Table ++ - " (int1 SMALLINT, int2 INT, int3 INTEGER)"), + " (myint1 SMALLINT, myint2 INT, myint3 INTEGER)"), Decs = ?RDBMS:describe_integer(), %% Make sure to test timeout clause @@ -1399,7 +1417,7 @@ describe_dec_num(Config) when is_list(Config) -> {updated, _} = odbc:sql_query(Ref, "CREATE TABLE " ++ Table ++ - " (dec DECIMAL(9,3), num NUMERIC(9,2))"), + " (mydec DECIMAL(9,3), mynum NUMERIC(9,2))"), Decs = ?RDBMS:describe_dec_num(), @@ -1451,3 +1469,7 @@ is_driver_error(Error) -> false -> test_server:fail(Error) end. +is_supported_multiple_resultsets(sqlserver) -> + true; +is_supported_multiple_resultsets(_) -> + false. diff --git a/lib/odbc/test/odbc_start_SUITE.erl b/lib/odbc/test/odbc_start_SUITE.erl index 65b990133f..e3a3440559 100644 --- a/lib/odbc/test/odbc_start_SUITE.erl +++ b/lib/odbc/test/odbc_start_SUITE.erl @@ -39,11 +39,18 @@ %% variable, but should NOT alter/remove any existing entries. %%-------------------------------------------------------------------- init_per_suite(Config) -> - case code:which(odbc) of - non_existing -> - {skip, "No ODBC built"}; - _ -> - [{tableName, odbc_test_lib:unique_table_name()} | Config] + case odbc_test_lib:skip() of + true -> + {skip, "ODBC not supported"}; + false -> + case code:which(odbc) of + non_existing -> + {skip, "No ODBC built"}; + _ -> + %% Make sure odbc is not already started + odbc:stop(), + [{tableName, odbc_test_lib:unique_table_name()} | Config] + end end. %%-------------------------------------------------------------------- @@ -125,14 +132,16 @@ start(doc) -> start(suite) -> []; start(Config) when is_list(Config) -> - {error,odbc_not_started} = odbc:connect(?RDBMS:connection_string(), []), + PlatformOptions = odbc_test_lib:platform_options(), + {error,odbc_not_started} = odbc:connect(?RDBMS:connection_string(), + PlatformOptions), odbc:start(), - case odbc:connect(?RDBMS:connection_string(), []) of + case odbc:connect(?RDBMS:connection_string(), PlatformOptions) of {ok, Ref0} -> ok = odbc:disconnect(Ref0), odbc:stop(), {error,odbc_not_started} = - odbc:connect(?RDBMS:connection_string(), []), + odbc:connect(?RDBMS:connection_string(), PlatformOptions), start_odbc(transient), start_odbc(permanent); {error, odbc_not_started} -> @@ -144,7 +153,7 @@ start(Config) when is_list(Config) -> start_odbc(Type) -> ok = odbc:start(Type), - case odbc:connect(?RDBMS:connection_string(), []) of + case odbc:connect(?RDBMS:connection_string(), odbc_test_lib:platform_options()) of {ok, Ref} -> ok = odbc:disconnect(Ref), odbc:stop(); diff --git a/lib/odbc/test/odbc_test.hrl b/lib/odbc/test/odbc_test.hrl index 87f50043db..f7bb338a7f 100644 --- a/lib/odbc/test/odbc_test.hrl +++ b/lib/odbc/test/odbc_test.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2010. All Rights Reserved. +%% Copyright Ericsson AB 2002-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -25,9 +25,16 @@ -define(RDBMS, case os:type() of {unix, sunos} -> - postgres; + mysql; {unix,linux} -> - postgres; + case erlang:system_info({wordsize, external}) of + 4 -> + mysql; + _ -> + postgres + end; + {unix, darwin} -> + mysql; {win32, _} -> sqlserver end). diff --git a/lib/odbc/test/odbc_test_lib.erl b/lib/odbc/test/odbc_test_lib.erl index 012eb96e43..4d7d1ae2fa 100644 --- a/lib/odbc/test/odbc_test_lib.erl +++ b/lib/odbc/test/odbc_test_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2010. All Rights Reserved. +%% Copyright Ericsson AB 2002-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -36,20 +36,9 @@ match_float(Float, Match, Delta) -> (Float < Match + Delta) and (Float > Match - Delta). odbc_check() -> - case erlang:system_info(wordsize) of + case erlang:system_info({wordsize, external}) of 4 -> - case test_server:os_type() of - {unix, sunos} -> - ok; - {unix, linux} -> - ok; - {win32, _} -> - ok; - Other -> - lists:flatten( - io_lib:format("Platform not supported: ~w", - [Other])) - end; + ok; Other -> case os:type() of {unix, linux} -> @@ -75,3 +64,46 @@ check_row_count(Expected, Count) -> to_upper(List) -> lists:map(fun(Str) -> string:to_upper(Str) end, List). + +strict(Ref, mysql) -> + odbc:sql_query(Ref, "SET sql_mode='STRICT_ALL_TABLES,STRICT_TRANS_TABLES';"); +strict(_,_) -> + ok. + +platform_options() -> + []. + +skip() -> + case os:type() of + {unix, linux} -> + Issue = linux_issue(), + is_sles9(Issue); + {unix, sunos} -> + not supported_solaris(); + _ -> + false + end. + +supported_solaris() -> + case os:version() of + {_,10,_} -> + true; + _ -> + false + end. + +linux_issue() -> + {ok, Binary} = file:read_file("/etc/issue"), + string:tokens(binary_to_list(Binary), " "). + +is_sles11(IssueTokens) -> + lists:member("11", IssueTokens). + +is_sles10(IssueTokens) -> + lists:member("10", IssueTokens). + +is_sles9(IssueTokens) -> + lists:member("9", IssueTokens). + +is_ubuntu(IssueTokens) -> + lists:member("Ubuntu", IssueTokens). diff --git a/lib/odbc/test/oracle.erl b/lib/odbc/test/oracle.erl index ebf6dbb6bf..d74863d8c1 100644 --- a/lib/odbc/test/oracle.erl +++ b/lib/odbc/test/oracle.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2010. All Rights Reserved. +%% Copyright Ericsson AB 2002-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -108,10 +108,6 @@ create_text_table() -> " (FIELD long)". %Oracle long is variable length char data %------------------------------------------------------------------------- -create_unicode_table() -> - " (FIELD nvarchar(50))". - -%------------------------------------------------------------------------- create_timestamp_table() -> " (FIELD DATETIME)". @@ -231,8 +227,8 @@ param_select() -> %------------------------------------------------------------------------- describe_integer() -> - {ok,[{"INT1",{sql_decimal,38,0}},{"INT2",{sql_decimal,38,0}}, - {"INT3",{sql_decimal,38,0}}]}. + {ok,[{"MYINT1",{sql_decimal,38,0}},{"MYINT2",{sql_decimal,38,0}}, + {"MYINT3",{sql_decimal,38,0}}]}. describe_string() -> {ok,[{"STR1",{sql_char,10}}, @@ -243,4 +239,4 @@ describe_string() -> describe_floating() -> {ok,[{"F",sql_double},{"R",sql_double},{"D",sql_double}]}. describe_dec_num() -> - {ok,[{"DEC",{sql_decimal,9,3}},{"NUM",{sql_decimal,9,2}}]}. + {ok,[{"MYDEC",{sql_decimal,9,3}},{"MYNUM",{sql_decimal,9,2}}]}. diff --git a/lib/odbc/test/postgres.erl b/lib/odbc/test/postgres.erl index 169ca26e43..d564dbd5ff 100644 --- a/lib/odbc/test/postgres.erl +++ b/lib/odbc/test/postgres.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2010. All Rights Reserved. +%% Copyright Ericsson AB 2006-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -30,7 +30,7 @@ connection_string() -> {unix, sunos} -> "DSN=Postgres;UID=odbctest"; {unix, linux} -> - Size = erlang:system_info(wordsize), + Size = erlang:system_info({wordsize, external}), linux_dist_connection_string(Size) end. @@ -43,7 +43,12 @@ linux_dist_connection_string(4) -> end; linux_dist_connection_string(_) -> - "DSN=PostgresLinux64;UID=odbctest". + case linux_dist() of + "ubuntu" -> + "DSN=PostgresLinux64Ubuntu;UID=odbctest"; + _ -> + "DSN=PostgresLinux64;UID=odbctest" + end. linux_dist() -> case file:read_file("/etc/issue") of @@ -135,10 +140,6 @@ create_text_table() -> " (FIELD text)". %------------------------------------------------------------------------- -create_unicode_table() -> - " (FIELD text)". - -%------------------------------------------------------------------------- create_timestamp_table() -> " (FIELD TIMESTAMP)". @@ -275,9 +276,9 @@ param_select() -> %------------------------------------------------------------------------- describe_integer() -> - {ok,[{"int1",sql_smallint}, - {"int2",sql_integer}, - {"int3",sql_integer}]}. + {ok,[{"myint1",sql_smallint}, + {"myint2",sql_integer}, + {"myint3",sql_integer}]}. describe_string() -> {ok,[{"str1",{sql_char,10}}, @@ -288,7 +289,7 @@ describe_string() -> describe_floating() -> {ok,[{"f",sql_real},{"r",sql_real},{"d",{sql_float,15}}]}. describe_dec_num() -> - {ok,[{"dec",{sql_numeric,9,3}},{"num",{sql_numeric,9,2}}]}. + {ok,[{"mydec",{sql_numeric,9,3}},{"mynum",{sql_numeric,9,2}}]}. describe_timestamp() -> {ok, [{"field", sql_timestamp}]}. diff --git a/lib/odbc/test/sqlserver.erl b/lib/odbc/test/sqlserver.erl index e3fe30e0bc..59252d4276 100644 --- a/lib/odbc/test/sqlserver.erl +++ b/lib/odbc/test/sqlserver.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2010. All Rights Reserved. +%% Copyright Ericsson AB 2002-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -123,10 +123,6 @@ create_text_table() -> " (FIELD text)". %------------------------------------------------------------------------- -create_unicode_table() -> - " (FIELD nvarchar(50))". - -%------------------------------------------------------------------------- create_timestamp_table() -> " (FIELD DATETIME)". @@ -279,8 +275,8 @@ param_select() -> %------------------------------------------------------------------------- describe_integer() -> - {ok,[{"int1", sql_smallint},{"int2", sql_integer}, - {"int3", sql_integer}]}. + {ok,[{"myint1", sql_smallint},{"myint2", sql_integer}, + {"myint3", sql_integer}]}. describe_string() -> {ok,[{"str1",{sql_char,10}}, @@ -292,7 +288,7 @@ describe_floating() -> {ok,[{"f", sql_real},{"r", sql_real}, {"d", {sql_float, 53}}]}. describe_dec_num() -> - {ok,[{"dec",{sql_decimal,9,3}},{"num",{sql_numeric,9,2}}]}. + {ok,[{"mydec",{sql_decimal,9,3}},{"mynum",{sql_numeric,9,2}}]}. describe_timestamp() -> {ok, [{"field", sql_timestamp}]}. diff --git a/lib/odbc/vsn.mk b/lib/odbc/vsn.mk index 42a51be33e..120ed9ee3d 100644 --- a/lib/odbc/vsn.mk +++ b/lib/odbc/vsn.mk @@ -1 +1 @@ -ODBC_VSN = 2.10.10 +ODBC_VSN = 2.10.11 diff --git a/lib/os_mon/c_src/cpu_sup.c b/lib/os_mon/c_src/cpu_sup.c index fbf318c614..e3bdbd1489 100644 --- a/lib/os_mon/c_src/cpu_sup.c +++ b/lib/os_mon/c_src/cpu_sup.c @@ -191,7 +191,10 @@ int main(int argc, char** argv) { static cpu_t *read_procstat(FILE *fp, cpu_t *cpu) { char buffer[BUFFERSIZE]; - fgets(buffer, BUFFERSIZE, fp); + if (fgets(buffer, BUFFERSIZE, fp) == NULL) { + memset(cpu, 0, sizeof(cpu_t)); + return cpu; + } sscanf(buffer, "cpu%u %Lu %Lu %Lu %Lu %Lu %Lu %Lu %Lu", &(cpu->id), &(cpu->user), @@ -223,7 +226,11 @@ static void util_measure(unsigned int **result_vec, int *result_sz) { return; } - fgets(buffer, BUFFERSIZE, fp); /*ignore read*/ + /*ignore read*/ + if (fgets(buffer, BUFFERSIZE, fp) == NULL) { + *result_sz = 0; + return; + } rv = *result_vec; rv[0] = no_of_cpus; rv[1] = CU_VALUES; @@ -447,8 +454,12 @@ static void sendv(unsigned int data[], int ints) { } static void error(char* err_msg) { - write(FD_ERR, err_msg, strlen(err_msg)); - write(FD_ERR, "\n", 1); + /* + * if we get error here we have trouble, + * silence unnecessary warnings + */ + if(write(FD_ERR, err_msg, strlen(err_msg))); + if(write(FD_ERR, "\n", 1)); exit(-1); } diff --git a/lib/parsetools/doc/src/leex.xml b/lib/parsetools/doc/src/leex.xml index 12abfd244f..1fa426a79e 100644 --- a/lib/parsetools/doc/src/leex.xml +++ b/lib/parsetools/doc/src/leex.xml @@ -79,6 +79,10 @@ Token = tuple()</code> <item><p>Causes warnings to be printed as they occur. Default is <c>true</c>.</p> </item> + <tag><c>warnings_as_errors</c></tag> + <item> + <p>Causes warnings to be treated as errors.</p> + </item> <tag><c>{report, bool()}</c></tag> <item><p>This is a short form for both <c>report_errors</c> and <c>report_warnings</c>.</p> diff --git a/lib/parsetools/doc/src/yecc.xml b/lib/parsetools/doc/src/yecc.xml index 81f1550b0a..1d2a985d7d 100644 --- a/lib/parsetools/doc/src/yecc.xml +++ b/lib/parsetools/doc/src/yecc.xml @@ -95,6 +95,10 @@ <item>This is a short form for both <c>report_errors</c> and <c>report_warnings</c>. </item> + <tag><c>warnings_as_errors</c></tag> + <item> + <p>Causes warnings to be treated as errors.</p> + </item> <tag><c>{return_errors, bool()}</c>.</tag> <item>If this flag is set, <c>{error, Errors, Warnings}</c> is returned when there are errors. Default is @@ -421,9 +425,9 @@ myparser:parse_and_scan({Mod, Tokenizer, Args}) </code> Nonterminals E T F. Terminals '+' '*' '(' ')' number. Rootsymbol E. -E -> E '+' T: ['$1', '$2', '$3']. +E -> E '+' T: ['$2', '$1', '$3']. E -> T : '$1'. -T -> T '*' F: ['$1', '$2', '$3']. +T -> T '*' F: ['$2', '$1', '$3']. T -> F : '$1'. F -> '(' E ')' : '$2'. F -> number : '$1'. </code> @@ -434,8 +438,8 @@ Terminals '+' '*' '(' ')' number. Rootsymbol E. Left 100 '+'. Left 200 '*'. -E -> E '+' E : ['$1', '$2', '$3']. -E -> E '*' E : ['$1', '$2', '$3']. +E -> E '+' E : ['$2', '$1', '$3']. +E -> E '*' E : ['$2', '$1', '$3']. E -> '(' E ')' : '$2'. E -> number : '$1'. </code> <p>3. An overloaded minus operator:</p> diff --git a/lib/parsetools/src/leex.erl b/lib/parsetools/src/leex.erl index d0b4b9efe7..cdf20461d9 100644 --- a/lib/parsetools/src/leex.erl +++ b/lib/parsetools/src/leex.erl @@ -35,7 +35,7 @@ -export([compile/3,file/1,file/2,format_error/1]). -import(lists, [member/2,reverse/1,sort/1,delete/2, - keysort/2,keydelete/3,keyfind/3, + keysort/2,keydelete/3, map/2,foldl/3,foreach/2,flatmap/2]). -import(string, [substr/2,substr/3,span/2]). -import(ordsets, [is_element/2,add_element/2,union/2]). @@ -58,7 +58,7 @@ gfile=[], % Graph file module, % Module name opts=[], % Options - posix=false, % POSIX regular expressions + % posix=false, % POSIX regular expressions errors=[], warnings=[] }). @@ -73,12 +73,15 @@ %%% Interface to erl_compile. compile(Input0, Output0, - #options{warning = WarnLevel, verbose=Verbose, includes=Includes}) -> + #options{warning = WarnLevel, verbose=Verbose, includes=Includes, + specific=Specific}) -> Input = assure_extension(shorten_filename(Input0), ".xrl"), Output = assure_extension(shorten_filename(Output0), ".erl"), Includefile = lists:sublist(Includes, 1), + Werror = proplists:get_bool(warnings_as_errors, Specific), Opts = [{scannerfile,Output},{includefile,Includefile},{verbose,Verbose}, - {report_errors,true},{report_warnings,WarnLevel > 0}], + {report_errors,true},{report_warnings,WarnLevel > 0}, + {warnings_as_errors, Werror}], case file(Input, Opts) of {ok, _} -> ok; @@ -107,10 +110,15 @@ file(File, Opts0) -> St = try {ok,REAs,Actions,Code,St2} = parse_file(St1), {DFA,DF} = make_dfa(REAs, St2), - St3 = out_file(St2, DFA, DF, Actions, Code), - case lists:member(dfa_graph, St3#leex.opts) of - true -> out_dfa_graph(St3, DFA, DF); - false -> St3 + case werror(St2) of + false -> + St3 = out_file(St2, DFA, DF, Actions, Code), + case lists:member(dfa_graph, St3#leex.opts) of + true -> out_dfa_graph(St3, DFA, DF); + false -> St3 + end; + true -> + St2 end catch #leex{}=St4 -> St4 @@ -131,8 +139,8 @@ format_error({regexp,E})-> "unterminated " ++ Cs; {illegal_char,Cs} -> "illegal character " ++ Cs; - {posix_cc,What} -> - ["illegal POSIX character class ",io_lib:write_string(What)]; +%% {posix_cc,What} -> +%% ["illegal POSIX character class ",io_lib:write_string(What)]; {char_class,What} -> ["illegal character class ",io_lib:write_string(What)] end, @@ -163,7 +171,8 @@ options(Options0) when is_list(Options0) -> (T) -> [T] end, Options0), options(Options, [scannerfile,includefile,report_errors, - report_warnings,return_errors,return_warnings, + report_warnings,warnings_as_errors, + return_errors,return_warnings, verbose,dfa_graph], []) catch error: _ -> badarg end; @@ -217,6 +226,7 @@ default_option(dfa_graph) -> false; default_option(includefile) -> []; default_option(report_errors) -> true; default_option(report_warnings) -> true; +default_option(warnings_as_errors) -> false; default_option(return_errors) -> false; default_option(return_warnings) -> false; default_option(scannerfile) -> []; @@ -225,6 +235,7 @@ default_option(verbose) -> false. atom_option(dfa_graph) -> {dfa_graph,true}; atom_option(report_errors) -> {report_errors,true}; atom_option(report_warnings) -> {report_warnings,true}; +atom_option(warnings_as_errors) -> {warnings_as_errors,true}; atom_option(return_errors) -> {return_errors,true}; atom_option(return_warnings) -> {return_warnings,true}; atom_option(verbose) -> {verbose,true}; @@ -251,19 +262,29 @@ leex_ret(St) -> report_warnings(St), Es = pack_errors(St#leex.errors), Ws = pack_warnings(St#leex.warnings), + Werror = werror(St), if + Werror -> + do_error_return(St, Es, Ws); Es =:= [] -> case member(return_warnings, St#leex.opts) of true -> {ok, St#leex.efile, Ws}; false -> {ok, St#leex.efile} end; - true -> - case member(return_errors, St#leex.opts) of - true -> {error, Es, Ws}; - false -> error - end + true -> + do_error_return(St, Es, Ws) + end. + +do_error_return(St, Es, Ws) -> + case member(return_errors, St#leex.opts) of + true -> {error, Es, Ws}; + false -> error end. +werror(St) -> + St#leex.warnings =/= [] + andalso member(warnings_as_errors, St#leex.opts). + pack_errors([{File,_} | _] = Es) -> [{File, flatmap(fun({_,E}) -> [E] end, sort(Es))}]; pack_errors([]) -> @@ -286,16 +307,26 @@ report_errors(St) -> end, report_errors, St#leex.opts). report_warnings(St) -> - when_opt(fun () -> - foreach(fun({File,{none,Mod,W}}) -> - io:fwrite("~s: Warning: ~s\n", - [File,Mod:format_error(W)]); - ({File,{Line,Mod,W}}) -> - io:fwrite("~s:~w: Warning: ~s\n", - [File,Line,Mod:format_error(W)]) - end, sort(St#leex.warnings)) - end, report_warnings, St#leex.opts). - + Werror = member(warnings_as_errors, St#leex.opts), + Prefix = case Werror of + true -> ""; + false -> "Warning: " + end, + ReportWerror = Werror andalso member(report_errors, St#leex.opts), + ShouldReport = member(report_warnings, St#leex.opts) orelse ReportWerror, + when_bool(fun () -> + foreach(fun({File,{none,Mod,W}}) -> + io:fwrite("~s: ~s~s\n", + [File,Prefix, + Mod:format_error(W)]); + ({File,{Line,Mod,W}}) -> + io:fwrite("~s:~w: ~s~s\n", + [File,Line,Prefix, + Mod:format_error(W)]) + end, sort(St#leex.warnings)) + end, ShouldReport). + +-spec add_error(_, #leex{}) -> no_return(). add_error(E, St) -> add_error(St#leex.xfile, E, St). @@ -341,6 +372,12 @@ when_opt(Do, Opt, Opts) -> false -> ok end. +when_bool(Do, Bool) -> + case Bool of + true -> Do(); + false -> ok + end. + verbose_print(St, Format, Args) -> when_opt(fun () -> io:fwrite(Format, Args) end, verbose, St#leex.opts). @@ -644,14 +681,14 @@ re_repeat1([$*|Cs], Sn, S, St) -> re_repeat1(Cs, Sn, {kclosure,S}, St); re_repeat1([$+|Cs], Sn, S, St) -> re_repeat1(Cs, Sn, {pclosure,S}, St); re_repeat1([$?|Cs], Sn, S, St) -> re_repeat1(Cs, Sn, {optional,S}, St); %% { only starts interval when ere is true, otherwise normal character. -re_repeat1([${|Cs0], Sn, S, #leex{posix=true}=St) -> % $} - case re_interval_range(Cs0) of - {Min,Max,[$}|Cs1]} when is_integer(Min), is_integer(Max), Min =< Max -> - re_repeat1(Cs1, Sn, {interval,S,Min,Max}, St); - {Min,Max,[$}|Cs1]} when is_integer(Min), is_atom(Max) -> - re_repeat1(Cs1, Sn, {interval,S,Min,Max}, St); - {_,_,Cs1} -> parse_error({interval_range,string_between([${|Cs0], Cs1)}) - end; +%% re_repeat1([${|Cs0], Sn, S, #leex{posix=true}=St) -> % $} +%% case re_interval_range(Cs0) of +%% {Min,Max,[$}|Cs1]} when is_integer(Min), is_integer(Max), Min =< Max -> +%% re_repeat1(Cs1, Sn, {interval,S,Min,Max}, St); +%% {Min,Max,[$}|Cs1]} when is_integer(Min), is_atom(Max) -> +%% re_repeat1(Cs1, Sn, {interval,S,Min,Max}, St); +%% {_,_,Cs1} -> parse_error({interval_range,string_between([${|Cs0], Cs1)}) +%% end; re_repeat1(Cs, Sn, S, _) -> {S,Sn,Cs}. %% re_single(Chars, SubNumber, State) -> {RegExp,SubNumber,Chars}. @@ -733,7 +770,7 @@ special_char($|, _) -> true; special_char($*, _) -> true; special_char($+, _) -> true; special_char($?, _) -> true; -special_char(${, #leex{posix=true}) -> true; % Only when POSIX set +%% special_char(${, #leex{posix=true}) -> true; % Only when POSIX set special_char($\\, _) -> true; special_char(_, _) -> false. @@ -744,12 +781,12 @@ re_char_class([$]|Cs], St) -> % Must special case this. re_char_class(Cs, [$]], St); re_char_class(Cs, St) -> re_char_class(Cs, [], St). -re_char_class("[:" ++ Cs0, Cc, #leex{posix=true}=St) -> - %% POSIX char class only. - case posix_cc(Cs0) of - {Pcl,":]" ++ Cs1} -> re_char_class(Cs1, [{posix,Pcl}|Cc], St); - {_,Cs1} -> parse_error({posix_cc,string_between(Cs0, Cs1)}) - end; +%% re_char_class("[:" ++ Cs0, Cc, #leex{posix=true}=St) -> +%% %% POSIX char class only. +%% case posix_cc(Cs0) of +%% {Pcl,":]" ++ Cs1} -> re_char_class(Cs1, [{posix,Pcl}|Cc], St); +%% {_,Cs1} -> parse_error({posix_cc,string_between(Cs0, Cs1)}) +%% end; re_char_class([C1|Cs0], Cc, St) when C1 =/= $] -> case re_char(C1, Cs0) of {Cf,[$-,C2|Cs1]} when C2 =/= $] -> @@ -766,19 +803,19 @@ re_char_class(Cs, Cc, _) -> {reverse(Cc),Cs}. % Preserve order %% posix_cc(String) -> {PosixClass,RestString}. %% Handle POSIX character classes. -posix_cc("alnum" ++ Cs) -> {alnum,Cs}; -posix_cc("alpha" ++ Cs) -> {alpha,Cs}; -posix_cc("blank" ++ Cs) -> {blank,Cs}; -posix_cc("cntrl" ++ Cs) -> {cntrl,Cs}; -posix_cc("digit" ++ Cs) -> {digit,Cs}; -posix_cc("graph" ++ Cs) -> {graph,Cs}; -posix_cc("lower" ++ Cs) -> {lower,Cs}; -posix_cc("print" ++ Cs) -> {print,Cs}; -posix_cc("punct" ++ Cs) -> {punct,Cs}; -posix_cc("space" ++ Cs) -> {space,Cs}; -posix_cc("upper" ++ Cs) -> {upper,Cs}; -posix_cc("xdigit" ++ Cs) -> {xdigit,Cs}; -posix_cc(Cs) -> parse_error({posix_cc,substr(Cs, 1, 5)}). +%% posix_cc("alnum" ++ Cs) -> {alnum,Cs}; +%% posix_cc("alpha" ++ Cs) -> {alpha,Cs}; +%% posix_cc("blank" ++ Cs) -> {blank,Cs}; +%% posix_cc("cntrl" ++ Cs) -> {cntrl,Cs}; +%% posix_cc("digit" ++ Cs) -> {digit,Cs}; +%% posix_cc("graph" ++ Cs) -> {graph,Cs}; +%% posix_cc("lower" ++ Cs) -> {lower,Cs}; +%% posix_cc("print" ++ Cs) -> {print,Cs}; +%% posix_cc("punct" ++ Cs) -> {punct,Cs}; +%% posix_cc("space" ++ Cs) -> {space,Cs}; +%% posix_cc("upper" ++ Cs) -> {upper,Cs}; +%% posix_cc("xdigit" ++ Cs) -> {xdigit,Cs}; +%% posix_cc(Cs) -> parse_error({posix_cc,substr(Cs, 1, 5)}). escape_char($n) -> $\n; % \n = LF escape_char($r) -> $\r; % \r = CR @@ -797,24 +834,24 @@ escape_char(C) -> C. % Pass it straight through %% Int, -> Int,any %% Int1,Int2 -> Int1,Int2 -re_interval_range(Cs0) -> - case re_number(Cs0) of - {none,Cs1} -> {none,none,Cs1}; - {N,[$,|Cs1]} -> - case re_number(Cs1) of - {none,Cs2} -> {N,any,Cs2}; - {M,Cs2} -> {N,M,Cs2} - end; - {N,Cs1} -> {N,none,Cs1} - end. +%% re_interval_range(Cs0) -> +%% case re_number(Cs0) of +%% {none,Cs1} -> {none,none,Cs1}; +%% {N,[$,|Cs1]} -> +%% case re_number(Cs1) of +%% {none,Cs2} -> {N,any,Cs2}; +%% {M,Cs2} -> {N,M,Cs2} +%% end; +%% {N,Cs1} -> {N,none,Cs1} +%% end. -re_number([C|Cs]) when C >= $0, C =< $9 -> - re_number(Cs, C - $0); -re_number(Cs) -> {none,Cs}. +%% re_number([C|Cs]) when C >= $0, C =< $9 -> +%% re_number(Cs, C - $0); +%% re_number(Cs) -> {none,Cs}. -re_number([C|Cs], Acc) when C >= $0, C =< $9 -> - re_number(Cs, 10*Acc + (C - $0)); -re_number(Cs, Acc) -> {Acc,Cs}. +%% re_number([C|Cs], Acc) when C >= $0, C =< $9 -> +%% re_number(Cs, 10*Acc + (C - $0)); +%% re_number(Cs, Acc) -> {Acc,Cs}. string_between(Cs1, Cs2) -> substr(Cs1, 1, length(Cs1)-length(Cs2)). diff --git a/lib/parsetools/src/yecc.erl b/lib/parsetools/src/yecc.erl index 4119e2631b..354d56527d 100644 --- a/lib/parsetools/src/yecc.erl +++ b/lib/parsetools/src/yecc.erl @@ -133,12 +133,15 @@ %%% Interface to erl_compile. compile(Input0, Output0, - #options{warning = WarnLevel, verbose=Verbose, includes=Includes}) -> + #options{warning = WarnLevel, verbose=Verbose, includes=Includes, + specific=Specific}) -> Input = shorten_filename(Input0), Output = shorten_filename(Output0), Includefile = lists:sublist(Includes, 1), + Werror = proplists:get_bool(warnings_as_errors, Specific), Opts = [{parserfile,Output}, {includefile,Includefile}, {verbose,Verbose}, - {report_errors, true}, {report_warnings, WarnLevel > 0}], + {report_errors, true}, {report_warnings, WarnLevel > 0}, + {warnings_as_errors, Werror}], case file(Input, Opts) of {ok, _OutFile} -> ok; @@ -278,8 +281,8 @@ options(Options0) when is_list(Options0) -> (T) -> [T] end, Options0), options(Options, [file_attributes, includefile, parserfile, - report_errors, report_warnings, return_errors, - return_warnings, time, verbose], []) + report_errors, report_warnings, warnings_as_errors, + return_errors, return_warnings, time, verbose], []) catch error: _ -> badarg end; options(Option) -> @@ -333,6 +336,7 @@ default_option(includefile) -> []; default_option(parserfile) -> []; default_option(report_errors) -> true; default_option(report_warnings) -> true; +default_option(warnings_as_errors) -> false; default_option(return_errors) -> false; default_option(return_warnings) -> false; default_option(time) -> false; @@ -341,6 +345,7 @@ default_option(verbose) -> false. atom_option(file_attributes) -> {file_attributes, true}; atom_option(report_errors) -> {report_errors, true}; atom_option(report_warnings) -> {report_warnings, true}; +atom_option(warnings_as_errors) -> {warnings_as_errors,true}; atom_option(return_errors) -> {return_errors, true}; atom_option(return_warnings) -> {return_warnings, true}; atom_option(time) -> {time, true}; @@ -409,12 +414,16 @@ infile(Parent, Infilex, Options) -> {error, Reason} -> add_error(St0#yecc.infile, none, {file_error, Reason}, St0) end, - case St#yecc.errors of - [] -> ok; + case {St#yecc.errors, werror(St)} of + {[], false} -> ok; _ -> _ = file:delete(St#yecc.outfile) end, Parent ! {self(), yecc_ret(St)}. +werror(St) -> + St#yecc.warnings =/= [] + andalso member(warnings_as_errors, St#yecc.options). + outfile(St0) -> case file:open(St0#yecc.outfile, [write, delayed_write]) of {ok, Outport} -> @@ -777,17 +786,23 @@ yecc_ret(St0) -> report_warnings(St), Es = pack_errors(St#yecc.errors), Ws = pack_warnings(St#yecc.warnings), + Werror = werror(St), if + Werror -> + do_error_return(St, Es, Ws); Es =:= [] -> case member(return_warnings, St#yecc.options) of true -> {ok, St#yecc.outfile, Ws}; false -> {ok, St#yecc.outfile} end; true -> - case member(return_errors, St#yecc.options) of - true -> {error, Es, Ws}; - false -> error - end + do_error_return(St, Es, Ws) + end. + +do_error_return(St, Es, Ws) -> + case member(return_errors, St#yecc.options) of + true -> {error, Es, Ws}; + false -> error end. check_expected(St0) -> @@ -837,14 +852,22 @@ report_errors(St) -> end. report_warnings(St) -> - case member(report_warnings, St#yecc.options) of + Werror = member(warnings_as_errors, St#yecc.options), + Prefix = case Werror of + true -> ""; + false -> "Warning: " + end, + ReportWerror = Werror andalso member(report_errors, St#yecc.options), + case member(report_warnings, St#yecc.options) orelse ReportWerror of true -> foreach(fun({File,{none,Mod,W}}) -> - io:fwrite(<<"~s: Warning: ~s\n">>, - [File,Mod:format_error(W)]); + io:fwrite(<<"~s: ~s~s\n">>, + [File,Prefix, + Mod:format_error(W)]); ({File,{Line,Mod,W}}) -> - io:fwrite(<<"~s:~w: Warning: ~s\n">>, - [File,Line,Mod:format_error(W)]) + io:fwrite(<<"~s:~w: ~s~s\n">>, + [File,Line,Prefix, + Mod:format_error(W)]) end, sort(St#yecc.warnings)); false -> ok diff --git a/lib/parsetools/test/leex_SUITE.erl b/lib/parsetools/test/leex_SUITE.erl index 23ad16f98d..1e50aedf07 100644 --- a/lib/parsetools/test/leex_SUITE.erl +++ b/lib/parsetools/test/leex_SUITE.erl @@ -152,6 +152,24 @@ file(Config) when is_list(Config) -> ?line writable(Dotfile), file:delete(Dotfile), + ok = file:delete(Scannerfile), + Warn = <<"Definitions.1998\n" + "D = [0-9]\n" + "Rules.\n" + "{L}+ : {token,{word,TokenLine,TokenChars}}.\n" + "Erlang code.\n">>, + ok = file:write_file(Filename, Warn), + error = leex:file(Filename, [warnings_as_errors]), + false = filelib:is_regular(Scannerfile), + error = leex:file(Filename, [return_warnings,warnings_as_errors]), + false = filelib:is_regular(Scannerfile), + {error,_,[{Filename,[{1,leex,ignored_characters}]}]} = + leex:file(Filename, [return_errors,warnings_as_errors]), + false = filelib:is_regular(Scannerfile), + {ok,Scannerfile,[{Filename,[{1,leex,ignored_characters}]}]} = + leex:file(Filename, [return_warnings]), + true = filelib:is_regular(Scannerfile), + file:delete(Filename), ok. @@ -551,7 +569,7 @@ ex2(Config) when is_list(Config) -> <<" %%% File : erlang_scan.xrl %%% Author : Robert Virding -%%% Purpose : Tkoen definitions for Erlang. +%%% Purpose : Token definitions for Erlang. Definitions. O = [0-7] diff --git a/lib/parsetools/test/yecc_SUITE.erl b/lib/parsetools/test/yecc_SUITE.erl index 1de87b3bff..a5f66b48e9 100644 --- a/lib/parsetools/test/yecc_SUITE.erl +++ b/lib/parsetools/test/yecc_SUITE.erl @@ -173,6 +173,7 @@ syntax(Config) when is_list(Config) -> %% Report errors. Very simple test of format_error/1. Ret = [return, {report, true}], Filename = filename:join(Dir, "file.yrl"), + Parserfile = filename:join(Dir, "file.erl"), Parserfile1 = filename:join(Dir, "a file"), ?line ok = file:write_file(Filename, <<"">>), @@ -247,6 +248,19 @@ syntax(Config) when is_list(Config) -> ?line {ok,_,[{_,[{2,yecc,bad_declaration}]}]} = yecc:file(Filename, Ret), + %% Bad declaration with warnings_as_errors. + ok = file:delete(Parserfile), + error = yecc:file(Filename, [warnings_as_errors]), + false = filelib:is_regular(Parserfile), + error = yecc:file(Filename, [return_warnings,warnings_as_errors]), + false = filelib:is_regular(Parserfile), + {error,_,[{_,[{2,yecc,bad_declaration}]}]} = + yecc:file(Filename, [return_errors,warnings_as_errors]), + false = filelib:is_regular(Parserfile), + {ok,_,[{_,[{2,yecc,bad_declaration}]}]} = + yecc:file(Filename, [return_warnings]), + true = filelib:is_regular(Parserfile), + %% Bad declaration. ?line ok = file:write_file(Filename, <<"Nonterminals nt. Terminals t. diff --git a/lib/percept/src/percept_db.erl b/lib/percept/src/percept_db.erl index 52e9afb78f..61b68ce44f 100644 --- a/lib/percept/src/percept_db.erl +++ b/lib/percept/src/percept_db.erl @@ -92,7 +92,7 @@ restart(PerceptDB)-> stop_sync(PerceptDB), do_start(). -%% @spec do_start(pid()) -> pid() +%% @spec do_start() -> pid() %% @private %% @doc starts the percept database. @@ -131,6 +131,7 @@ stop_sync(Pid)-> {'DOWN', MonitorRef, _Type, Pid, _Info}-> true after ?STOP_TIMEOUT-> + erlang:demonitor(MonitorRef, [flush]), exit(Pid, kill) end. @@ -166,14 +167,14 @@ insert(Trace) -> select(Query) -> percept_db ! {select, self(), Query}, - receive Match -> Match end. + receive {result, Match} -> Match end. %% @spec select(atom(), list()) -> Result %% @equiv select({Table,Options}) select(Table, Options) -> percept_db ! {select, self(), {Table, Options}}, - receive Match -> Match end. + receive {result, Match} -> Match end. %% @spec consolidate() -> Result %% @doc Checks timestamp and state-flow inconsistencies in the @@ -213,7 +214,7 @@ loop_percept_db() -> insert_trace(clean_trace(Trace)), loop_percept_db(); {select, Pid, Query} -> - Pid ! select_query(Query), + Pid ! {result, select_query(Query)}, loop_percept_db(); {action, stop} -> stopped; @@ -222,7 +223,7 @@ loop_percept_db() -> loop_percept_db(); {operate, Pid, {Table, {Fun, Start}}} -> Result = ets:foldl(Fun, Start, Table), - Pid ! Result, + Pid ! {result, Result}, loop_percept_db(); Unhandled -> io:format("loop_percept_db, unhandled query: ~p~n", [Unhandled]), diff --git a/lib/public_key/asn1/README b/lib/public_key/asn1/README index 5fb8cf9725..2a880e2d51 100644 --- a/lib/public_key/asn1/README +++ b/lib/public_key/asn1/README @@ -46,6 +46,6 @@ diff -r1.1 PKIXAttributeCertificate.asn1 --- > version AttCertVersion, -- version is v2 -4. Defenitions of publuic keys from PKCS-1.asn1 present in +4. Definitions of public keys from PKCS-1.asn1 present in PKIX1Algorithms88.asn1 where removed as we take them directly from PKCS-1.asn1
\ No newline at end of file diff --git a/lib/public_key/doc/src/public_key.xml b/lib/public_key/doc/src/public_key.xml index d60d91cd83..9a3832c68b 100644 --- a/lib/public_key/doc/src/public_key.xml +++ b/lib/public_key/doc/src/public_key.xml @@ -63,7 +63,7 @@ <p><code>pki_asn1_type() = 'Certificate' | 'RSAPrivateKey'| 'RSAPublicKey' 'DSAPrivateKey' | 'DSAPublicKey' | 'DHParameter' | 'SubjectPublicKeyInfo'</code></p> - <p><code>pem_entry () = {pki_asn1_type(), binary() %% DER or encrypted DER + <p><code>pem_entry () = {pki_asn1_type(), binary(), %% DER or encrypted DER not_encrypted | {"DES-CBC" | "DES-EDE3-CBC", crypto:rand_bytes(8)}}.</code></p> <p><code>rsa_public_key() = #'RSAPublicKey'{}</code></p> @@ -72,8 +72,6 @@ <p><code>dsa_public_key() = {integer(), #'Dss-Parms'{}} </code></p> - <p><code>rsa_private_key() = #'RSAPrivateKey'{} </code></p> - <p><code>dsa_private_key() = #'DSAPrivateKey'{}</code></p> <p><code> public_crypt_options() = [{rsa_pad, rsa_padding()}]. </code></p> @@ -149,7 +147,7 @@ <name>der_decode(Asn1type, Der) -> term()</name> <fsummary> Decodes a public key asn1 der encoded entity.</fsummary> <type> - <v>Asn1Type = atom() -</v> + <v>Asn1Type = atom()</v> <d> ASN.1 type present in the public_key applications asn1 specifications.</d> <v>Der = der_encoded()</v> @@ -166,7 +164,8 @@ <v>Asn1Type = atom()</v> <d> Asn1 type present in the public_key applications ASN.1 specifications.</d> - <v>Entity = term() - The erlang representation of <c> Asn1Type</c></v> + <v>Entity = term()</v> + <d>The erlang representation of <c>Asn1Type</c></d> </type> <desc> <p> Encodes a public key entity with ASN.1 DER encoding.</p> @@ -218,12 +217,13 @@ <fsummary> Creates a pem entry that can be fed to pem_encode/1.</fsummary> <type> <v>Asn1Type = pki_asn1_type()</v> - <v>Entity = term() - The Erlang representation of + <v>Entity = term()</v> + <d>The Erlang representation of <c>Asn1Type</c>. If <c>Asn1Type</c> is 'SubjectPublicKeyInfo' then <c>Entity</c> must be either an rsa_public_key() or a dsa_public_key() and this function will create the appropriate 'SubjectPublicKeyInfo' entry. - </v> + </d> <v>CipherInfo = {"DES-CBC" | "DES-EDE3-CBC", crypto:rand_bytes(8)}</v> <v>Password = string()</v> </type> @@ -281,7 +281,7 @@ <desc> <p>Der encodes a pkix x509 certificate or part of such a certificate. This function must be used for encoding certificates or parts of certificates - that are decoded/created on the otp format, whereas for the plain format this + that are decoded/created in the otp format, whereas for the plain format this function will directly call der_encode/2. </p> </desc> </func> diff --git a/lib/public_key/src/public_key.erl b/lib/public_key/src/public_key.erl index 2901020e83..33fcce2c44 100644 --- a/lib/public_key/src/public_key.erl +++ b/lib/public_key/src/public_key.erl @@ -488,9 +488,10 @@ pkix_path_validation(PathErr, [Cert | Chain], Options0) when is_atom(PathErr)-> _:_ -> {error, Reason} end; -pkix_path_validation(TrustedCert, CertChain, Options) when - is_binary(TrustedCert) -> OtpCert = pkix_decode_cert(TrustedCert, - otp), pkix_path_validation(OtpCert, CertChain, Options); +pkix_path_validation(TrustedCert, CertChain, Options) + when is_binary(TrustedCert) -> + OtpCert = pkix_decode_cert(TrustedCert, otp), + pkix_path_validation(OtpCert, CertChain, Options); pkix_path_validation(#'OTPCertificate'{} = TrustedCert, CertChain, Options) when is_list(CertChain), is_list(Options) -> diff --git a/lib/reltool/src/reltool_sys_win.erl b/lib/reltool/src/reltool_sys_win.erl index 76c064f1e7..8b0f64eb45 100644 --- a/lib/reltool/src/reltool_sys_win.erl +++ b/lib/reltool/src/reltool_sys_win.erl @@ -54,7 +54,9 @@ whitelist, blacklist, derived, - fgraph_wins + fgraph_wins, + app_box, + mod_box }). -define(WIN_WIDTH, 800). @@ -86,6 +88,11 @@ -define(blacklist, "Excluded"). -define(derived, "Derived"). +-define(safe_config,{sys,[{incl_cond,exclude}, + {app,kernel,[{incl_cond,include}]}, + {app,stdlib,[{incl_cond,include}]}, + {app,sasl,[{incl_cond,include}]}]}). + -record(root_data, {dir}). -record(lib_data, {dir, tree, item}). -record(escript_data, {file, tree, item}). @@ -102,7 +109,7 @@ start_link(Opts) -> proc_lib:start_link(?MODULE, init, - [[{parent, self()} | Opts]], + [[{safe_config, false}, {parent, self()} | Opts]], infinity, []). @@ -126,53 +133,73 @@ init(Options) -> exit({Reason, erlang:get_stacktrace()}) end. -do_init([{parent, Parent} | Options]) -> +do_init([{safe_config, Safe}, {parent, Parent} | Options]) -> case reltool_server:start_link(Options) of {ok, ServerPid, C, Sys} -> process_flag(trap_exit, C#common.trap_exit), - S = #state{parent_pid = Parent, - server_pid = ServerPid, - common = C, - config_file = filename:absname("config.reltool"), - target_dir = filename:absname("reltool_target_dir"), - app_wins = [], - sys = Sys, - fgraph_wins = []}, wx:new(), wx:debug(C#common.wx_debug), - S2 = create_window(S), %% wx_misc:beginBusyCursor(), case reltool_server:get_status(ServerPid) of {ok, Warnings} -> exit_dialog(Warnings), - {ok, Sys2} = reltool_server:get_sys(ServerPid), - S3 = S2#state{sys = Sys2}, + {ok, Sys} = reltool_server:get_sys(ServerPid), + S = #state{parent_pid = Parent, + server_pid = ServerPid, + common = C, + config_file = filename:absname("config.reltool"), + target_dir = filename:absname("reltool_target_dir"), + app_wins = [], + sys = Sys, + fgraph_wins = []}, + S2 = create_window(S), S5 = wx:batch(fun() -> Title = atom_to_list(?APPLICATION), - wxFrame:setTitle(S3#state.frame, + wxFrame:setTitle(S2#state.frame, Title), %% wxFrame:setMinSize(Frame, %% {?WIN_WIDTH, ?WIN_HEIGHT}), wxStatusBar:setStatusText( - S3#state.status_bar, + S2#state.status_bar, "Done."), - S4 = redraw_apps(S3), - redraw_libs(S4) + S3 = redraw_apps(S2), + S4 = redraw_libs(S3), + redraw_config_page(S4) end), %% wx_misc:endBusyCursor(), %% wxFrame:destroy(Frame), proc_lib:init_ack(S#state.parent_pid, {ok, self()}), loop(S5); {error, Reason} -> - io:format("~p(~p): <ERROR> ~p\n", [?MODULE, ?LINE, Reason]), - exit(Reason) + restart_server_safe_config(Safe,Parent,Reason) end; {error, Reason} -> io:format("~p(~p): <ERROR> ~p\n", [?MODULE, ?LINE, Reason]), exit(Reason) end. +restart_server_safe_config(true,_Parent,Reason) -> + io:format("~p(~p): <ERROR> ~p\n", [?MODULE, ?LINE, Reason]), + exit(Reason); +restart_server_safe_config(false,Parent,Reason) -> + Strings = + [{?wxBLACK,"Could not start reltool server:\n\n"}, + {?wxRED,Reason++"\n\n"}, + {?wxBLACK, + io_lib:format( + "Resetting the configuration to:~n~n ~p~n~n" + "Do you want to continue with this configuration?", + [?safe_config])}], + + case question_dialog_2("Reltool server start error", Strings) of + ?wxID_OK -> + do_init([{safe_config,true},{parent,Parent},?safe_config]); + ?wxID_CANCEL -> + io:format("~p(~p): <ERROR> ~p\n", [?MODULE, ?LINE, Reason]), + exit(Reason) + end. + exit_dialog([]) -> ok; exit_dialog(Warnings) -> @@ -606,6 +633,13 @@ create_config_page(#state{sys = Sys, book = Book} = S) -> {proportion, 1}]), wxPanel:setSizer(Panel, Sizer), wxNotebook:addPage(Book, Panel, ?SYS_PAGE, []), + S#state{app_box = AppBox, mod_box = ModBox}. + +redraw_config_page(#state{sys = Sys, app_box = AppBox, mod_box = ModBox} = S) -> + AppChoice = reltool_utils:incl_cond_to_index(Sys#sys.incl_cond), + wxRadioBox:setSelection(AppBox, AppChoice), + ModChoice = reltool_utils:mod_cond_to_index(Sys#sys.mod_cond), + wxRadioBox:setSelection(ModBox, ModChoice), S. create_main_release_page(#state{book = Book} = S) -> @@ -640,15 +674,15 @@ create_main_release_page(#state{book = Book} = S) -> add_release_page(Book, #rel{name = RelName, rel_apps = RelApps}) -> Panel = wxPanel:new(Book, []), Sizer = wxBoxSizer:new(?wxHORIZONTAL), - RelBox = wxRadioBox:new(Panel, - ?wxID_ANY, - "Applications included in the release " ++ RelName, - ?wxDefaultPosition, - ?wxDefaultSize, - [atom_to_list(RA#rel_app.name) || RA <- RelApps], - []), - %% wxRadioBox:setSelection(RelBox, 2), % mandatory - wxEvtHandler:connect(RelBox, command_radiobox_selected, + AppNames = [kernel, stdlib | + [RA#rel_app.name || RA <- RelApps] -- [kernel, stdlib]], + RelBox = wxListBox:new( + Panel,?wxID_ANY, + [{pos,?wxDefaultPosition}, + {size,?wxDefaultSize}, + {choices,[[atom_to_list(AppName)] || AppName <- AppNames]}, + {style,?wxLB_EXTENDED}]), + wxEvtHandler:connect(RelBox, command_listbox_selected, [{userData, {config_rel_cond, RelName}}]), RelToolTip = "Choose which applications that shall " "be included in the release resource file.", @@ -1363,7 +1397,8 @@ refresh(S) -> [ok = reltool_app_win:refresh(AW#app_win.pid) || AW <- S#state.app_wins], S2 = S#state{sys = Sys}, S3 = redraw_libs(S2), - redraw_apps(S3). + S4 = redraw_apps(S3), + redraw_config_page(S4). question_dialog(Question, Details) -> %% Parent = S#state.frame, @@ -1420,6 +1455,44 @@ display_message(Message, Icon) -> wxMessageDialog:showModal(Dialog), wxMessageDialog:destroy(Dialog). +%% Strings = [{Color,String}] +question_dialog_2(DialogLabel, Strings) -> + %% Parent = S#state.frame, + Parent = wx:typeCast(wx:null(), wxWindow), + %% [{style, ?wxYES_NO bor ?wxICON_ERROR bor ?wx}]), + DialogStyle = ?wxRESIZE_BORDER bor ?wxCAPTION bor ?wxSYSTEM_MENU bor + ?wxMINIMIZE_BOX bor ?wxMAXIMIZE_BOX bor ?wxCLOSE_BOX, + Dialog = wxDialog:new(Parent, ?wxID_ANY, DialogLabel, + [{style, DialogStyle}]), + Color = wxWindow:getBackgroundColour(Dialog), + TextStyle = ?wxTE_READONLY bor ?wxTE_MULTILINE bor ?wxHSCROLL, + Text = wxTextCtrl:new(Dialog, ?wxID_ANY, + [{size, {600, 400}}, {style, TextStyle}]), + wxWindow:setBackgroundColour(Text, Color), + TextAttr = wxTextAttr:new(), + add_text(Text,TextAttr,Strings), + Sizer = wxBoxSizer:new(?wxVERTICAL), + wxSizer:add(Sizer, Text, [{border, 2}, {flag, ?wxEXPAND}, {proportion, 1}]), + ButtSizer = wxDialog:createStdDialogButtonSizer(Dialog, ?wxOK bor ?wxCANCEL), + wxSizer:add(Sizer, ButtSizer, [{border, 2}, {flag, ?wxEXPAND}]), + wxPanel:setSizer(Dialog, Sizer), + wxSizer:fit(Sizer, Dialog), + wxSizer:setSizeHints(Sizer, Dialog), + Answer = wxDialog:showModal(Dialog), + wxDialog:destroy(Dialog), + Answer. + +add_text(Text,Attr,[{Color,String}|Strings]) -> + wxTextAttr:setTextColour(Attr, Color), + wxTextCtrl:setDefaultStyle(Text, Attr), + wxTextCtrl:appendText(Text, String), + add_text(Text,Attr,Strings); +add_text(_,_,[]) -> + ok. + + + + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% sys callbacks diff --git a/lib/sasl/doc/src/release_handler.xml b/lib/sasl/doc/src/release_handler.xml index 4a973bc5ed..5ac0dc1acc 100644 --- a/lib/sasl/doc/src/release_handler.xml +++ b/lib/sasl/doc/src/release_handler.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2009</year> + <year>1996</year><year>2011</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -159,9 +159,12 @@ old reboot_old permanent <funcs> <func> <name>check_install_release(Vsn) -> {ok, OtherVsn, Descr} | {error, Reason}</name> + <name>check_install_release(Vsn,Opts) -> {ok, OtherVsn, Descr} | {error, Reason}</name> <fsummary>Check installation of a release in the system.</fsummary> <type> <v>Vsn = OtherVsn = string()</v> + <v>Opts = [Opt]</v> + <v>Opt = purge</v> <v>Descr = term()</v> <v>Reason = term()</v> </type> @@ -179,6 +182,11 @@ old reboot_old permanent upgrade script.</p> <p>Returns the same as <c>install_release/1</c>. <c>Descr</c> defaults to "" if no <c>relup</c> file is found.</p> + <p>If the option <c>purge</c> is given, all old code that can + be soft purged will be purged after all other checks are + successfully completed. This can be useful in order to + reduce the time needed by <seealso + marker="#install_release/1">install_release</seealso>.</p> </desc> </func> <func> @@ -299,6 +307,24 @@ release_handler:set_unpacked(RelFile, [{myapp,"1.0","/home/user"},...]). <c>{update_paths,true}</c>, afterwards <c>code:lib_dir(myapp)</c> will return <c>/home/user/myapp-1.0</c>.</p> + <note> + <p>Installing a new release might be quite time consuming if + there are many processes in the system. The reason is that + each process must be checked for references to old code + before a module can be purged. This check might lead to + garbage collections and copying of data.</p> + <p>If you wish to speed up the execution of + <c>install_release</c>, then you may call <seealso + marker="#check_install_release/1">check_install_release</seealso> + first, using the option <c>purge</c>. This will do the same + check for old code, and then purge all modules that can be + soft purged. The purged modules will then no longer have any + old code, and <c>install_release</c> will not need to do the + checks.</p> + <p>Obviously, this will not reduce the overall time for the + upgrade, but it will allow checks and purge to be executed + in the background before the real upgrade is started.</p> + </note> </desc> </func> <func> diff --git a/lib/sasl/doc/src/systools.xml b/lib/sasl/doc/src/systools.xml index 883c9c372b..8c1c327d74 100644 --- a/lib/sasl/doc/src/systools.xml +++ b/lib/sasl/doc/src/systools.xml @@ -45,7 +45,8 @@ <v>Name = string()</v> <v>UpFrom = DownTo = [Name | {Name,Descr}]</v> <v> Descr = term()</v> - <v>Opt = {path,[Dir]} | restart_emulator | silent | noexec | {outdir,Dir}</v> + <v>Opt = {path,[Dir]} | restart_emulator | silent | noexec | {outdir,Dir} + | warnings_as_errors</v> <v> Dir = string()</v> <v>Result = ok | error | {ok,Relup,Module,Warnings} | {error,Module,Error}</v> <v> Relup - see relup(4)</v> @@ -122,6 +123,8 @@ <p>If the option <c>noexec</c> is provided, the function returns the same values as for <c>silent</c> but no <c>relup</c> file is created.</p> + <p>If the option <c>warnings_as_errors</c> is provided, warnings + are treated as errors.</p> </desc> </func> <func> @@ -130,7 +133,8 @@ <fsummary>Generate a boot script <c>.script/.boot</c>.</fsummary> <type> <v>Name = string()</v> - <v>Opt = src_tests | {path,[Dir]} | local | {variables,[Var]} | exref | {exref,[App]}] | silent | {outdir,Dir}</v> + <v>Opt = src_tests | {path,[Dir]} | local | {variables,[Var]} | exref | {exref,[App]}] + | silent | {outdir,Dir} | warnings_as_errors</v> <v> Dir = string()</v> <v> Var = {VarName,Prefix}</v> <v> VarName = Prefix = string()</v> @@ -232,6 +236,8 @@ Warnings and errors can be converted to strings by calling <c>Module:format_warning(Warnings)</c> or <c>Module:format_error(Error)</c>.</p> + <p>If the option <c>warnings_as_errors</c> is provided, warnings + are treated as errors.</p> </desc> </func> <func> diff --git a/lib/sasl/examples/src/Makefile b/lib/sasl/examples/src/Makefile index 4a4e04a536..c58f651696 100644 --- a/lib/sasl/examples/src/Makefile +++ b/lib/sasl/examples/src/Makefile @@ -66,7 +66,7 @@ release_spec: opt $(INSTALL_DIR) $(RELSYSDIR)/examples/src $(INSTALL_DIR) $(RELSYSDIR)/examples/ebin (cd ..; tar cf - src ebin | (cd $(RELSYSDIR)/examples; tar xf -)) - chmod -f -R ug+w $(RELSYSDIR)/examples + chmod -R ug+w $(RELSYSDIR)/examples release_docs_spec: diff --git a/lib/sasl/src/erlsrv.erl b/lib/sasl/src/erlsrv.erl index f9804c41dc..086dc7c651 100644 --- a/lib/sasl/src/erlsrv.erl +++ b/lib/sasl/src/erlsrv.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2009. All Rights Reserved. +%% Copyright Ericsson AB 1998-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -75,14 +75,21 @@ write_all_data(Port,[H|T]) -> write_all_data(Port,T). read_all_data(Port) -> + lists:reverse(read_all_data(Port,[],[])). +read_all_data(Port,Line,Lines) -> receive + {Port, {data, {noeol,Data}}} -> + read_all_data(Port,Line++Data,Lines); {Port, {data, {eol,Data}}} -> - [ Data | read_all_data(Port)]; - _ -> + read_all_data(Port,[],[Line++Data|Lines]); + {Port,_Other} -> Port ! {self(), close}, receive {Port, closed} -> - [] + case Line of + [] -> Lines; + _ -> [Line|Lines] + end end end. @@ -208,7 +215,7 @@ store_service(EmulatorVersion,Service) -> false -> {error, no_servicename}; {value, {_,Name}} -> - {Action,Service1} = case get_service(Name) of + {Action,Service1} = case get_service(EmulatorVersion,Name) of {error, no_such_service} -> {"add",Service}; _ -> @@ -377,8 +384,14 @@ pick_argument(_,[],Acc) -> {Acc, ""}; pick_argument(normal,[$ |T],Acc) -> {Acc,T}; +pick_argument(normal,[$\\|T],Acc) -> + pick_argument(normal_escaped,T,[$\\|Acc]); pick_argument(normal,[$"|T],Acc) -> pick_argument(quoted,T,[$"|Acc]); +pick_argument(normal_escaped,[$"|T],Acc) -> + pick_argument(bquoted,T,[$"|Acc]); +pick_argument(normal_escaped,[A|T],Acc) -> + pick_argument(normal,T,[A|Acc]); pick_argument(quoted_escaped,[H|T],Acc) -> pick_argument(quoted,T,[H|Acc]); pick_argument(quoted,[$"|T],Acc) -> @@ -387,6 +400,14 @@ pick_argument(quoted,[$\\|T],Acc) -> pick_argument(quoted_escaped,T,[$\\|Acc]); pick_argument(quoted,[H|T],Acc) -> pick_argument(quoted,T,[H|Acc]); +pick_argument(bquoted_escaped,[$"|T],Acc) -> + pick_argument(normal,T,[$"|Acc]); +pick_argument(bquoted_escaped,[H|T],Acc) -> + pick_argument(bquoted,T,[H|Acc]); +pick_argument(bquoted,[$\\|T],Acc) -> + pick_argument(bquoted_escaped,T,[$\\|Acc]); +pick_argument(bquoted,[H|T],Acc) -> + pick_argument(bquoted,T,[H|Acc]); pick_argument(normal,[H|T],Acc) -> pick_argument(normal,T,[H|Acc]). diff --git a/lib/sasl/src/release_handler.erl b/lib/sasl/src/release_handler.erl index b60aa847df..bc08f94dff 100644 --- a/lib/sasl/src/release_handler.erl +++ b/lib/sasl/src/release_handler.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% Copyright Ericsson AB 1996-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -25,8 +25,8 @@ -export([start_link/0, create_RELEASES/1, create_RELEASES/2, create_RELEASES/4, unpack_release/1, - check_install_release/1, install_release/1, install_release/2, - remove_release/1, + check_install_release/1, check_install_release/2, + install_release/1, install_release/2, remove_release/1, which_releases/0, make_permanent/1, reboot_old_release/1, set_unpacked/2, set_removed/1, install_file/2]). -export([upgrade_app/2, downgrade_app/2, downgrade_app/3, @@ -149,15 +149,35 @@ unpack_release(ReleaseName) -> %%----------------------------------------------------------------- %% Purpose: Checks the relup script for the specified version. %% The release must be unpacked. +%% Options = [purge] - all old code that can be soft purged +%% will be purged if all checks succeeds. This can be usefull +%% in order to reduce time needed in the following call to +%% install_release. %% Returns: {ok, FromVsn, Descr} | {error, Reason} -%% Reason = {already_installed, Vsn} | +%% Reason = {illegal_option, IllegalOpt} | +%% {already_installed, Vsn} | %% {bad_relup_file, RelFile} | %% {no_such_release, Vsn} | %% {no_such_from_vsn, Vsn} | %% exit_reason() %%----------------------------------------------------------------- check_install_release(Vsn) -> - call({check_install_release, Vsn}). + check_install_release(Vsn, []). + +check_install_release(Vsn, Opts) -> + case check_check_install_options(Opts, false) of + {ok,Purge} -> + call({check_install_release, Vsn, Purge}); + Error -> + Error + end. + +check_check_install_options([purge|Opts], _) -> + check_check_install_options(Opts, true); +check_check_install_options([Illegal|_],_Purge) -> + {error,{illegal_option,Illegal}}; +check_check_install_options([],Purge) -> + {ok,Purge}. %%----------------------------------------------------------------- @@ -291,7 +311,8 @@ check_script(Script, LibDirs) -> release_handler_1:check_script(Script, LibDirs). %%----------------------------------------------------------------- -%% eval_script(Script, Apps, LibDirs, Opts) -> {ok, UnPurged} | +%% eval_script(Script, Apps, LibDirs, NewLibs, Opts) -> +%% {ok, UnPurged} | %% restart_new_emulator | %% {error, Error} %% {'EXIT', Reason} @@ -299,9 +320,13 @@ check_script(Script, LibDirs) -> %% net_kernel:monitor_nodes(true) before calling this function. %% No! No other process than the release_handler can ever call this %% function, if sync_nodes is used. -%%----------------------------------------------------------------- -eval_script(Script, Apps, LibDirs, Opts) -> - catch release_handler_1:eval_script(Script, Apps, LibDirs, Opts). +%% +%% LibDirs is a list of all applications, while NewLibs is a list of +%% applications that have changed version between the current and the +%% new release. +%% ----------------------------------------------------------------- +eval_script(Script, Apps, LibDirs, NewLibs, Opts) -> + catch release_handler_1:eval_script(Script, Apps, LibDirs, NewLibs, Opts). %%----------------------------------------------------------------- %% Func: create_RELEASES(Root, RelFile, LibDirs) -> ok | {error, Reason} @@ -405,6 +430,7 @@ eval_appup_script(App, ToVsn, ToDir, Script) -> Res = release_handler_1:eval_script(Script, [], % [AppSpec] [{App, ToVsn, ToDir}], + [{App, ToVsn, ToDir}], []), % [Opt] case Res of {ok, _Unpurged} -> @@ -535,11 +561,12 @@ handle_call({unpack_release, ReleaseName}, _From, S) handle_call({unpack_release, _ReleaseName}, _From, S) -> {reply, {error, client_node}, S}; -handle_call({check_install_release, Vsn}, _From, S) -> +handle_call({check_install_release, Vsn, Purge}, _From, S) -> case catch do_check_install_release(S#state.rel_dir, Vsn, S#state.releases, - S#state.masters) of + S#state.masters, + Purge) of {ok, CurrentVsn, Descr} -> {reply, {ok, CurrentVsn, Descr}, S}; {error, Reason} -> @@ -849,7 +876,7 @@ check_path_response(Path, {ok, _Info}) -> check_path_response(Path, {error, _Reason}) -> throw({error, {no_such_directory, Path}}). -do_check_install_release(RelDir, Vsn, Releases, Masters) -> +do_check_install_release(RelDir, Vsn, Releases, Masters, Purge) -> case lists:keysearch(Vsn, #release.vsn, Releases) of {value, #release{status = current}} -> {error, {already_installed, Vsn}}; @@ -874,7 +901,20 @@ do_check_install_release(RelDir, Vsn, Releases, Masters) -> case get_rh_script(LatestRelease, Release, RelDir, Masters) of {ok, {CurrentVsn, Descr, Script}} -> case catch check_script(Script, Libs) of - ok -> + {ok,SoftPurgeMods} when Purge=:=true -> + %% Get modules with brutal_purge + %% instructions, but that can be + %% soft purged + {ok,BrutalPurgeMods} = + release_handler_1:check_old_processes( + Script,brutal_purge), + lists:foreach( + fun(Mod) -> + catch erlang:purge_module(Mod) + end, + SoftPurgeMods ++ BrutalPurgeMods), + {ok, CurrentVsn, Descr}; + {ok,_} -> {ok, CurrentVsn, Descr}; Else -> Else @@ -890,6 +930,7 @@ do_check_install_release(RelDir, Vsn, Releases, Masters) -> end. do_install_release(#state{start_prg = StartPrg, + root = RootDir, rel_dir = RelDir, releases = Releases, masters = Masters, static_emulator = Static}, @@ -905,7 +946,9 @@ do_install_release(#state{start_prg = StartPrg, EnvBefore = application_controller:prep_config_change(), Apps = change_appl_data(RelDir, Release, Masters), LibDirs = Release#release.libs, - case eval_script(Script, Apps, LibDirs, Opts) of + NewLibs = get_new_libs(LatestRelease#release.libs, + Release#release.libs), + case eval_script(Script, Apps, LibDirs, NewLibs, Opts) of {ok, []} -> application_controller:config_change(EnvBefore), mon_nodes(false), @@ -926,8 +969,8 @@ do_install_release(#state{start_prg = StartPrg, NReleases = set_status(Vsn, current, Releases), NReleases2 = set_status(Vsn,tmp_current,NReleases), write_releases(RelDir, NReleases2, Masters), - prepare_restart_new_emulator(StartPrg, RelDir, - Release, + prepare_restart_new_emulator(StartPrg, RootDir, + RelDir, Release, PermanentRelease, Masters), {restart_new_emulator, CurrentVsn, Descr}; @@ -997,7 +1040,7 @@ do_make_services_permanent(PermanentVsn,Vsn, PermanentEVsn, EVsn) -> throw(Error4) end end. - + do_make_permanent(#state{releases = Releases, rel_dir = RelDir, unpurged = Unpurged, masters = Masters, @@ -1409,8 +1452,8 @@ prepare_restart_nt(#release{erts_vsn = EVsn, vsn = Vsn}, FutureServiceName = hd(string:tokens(atom_to_list(node()),"@")) ++ "_" ++ Vsn, CurrentService = case erlsrv:get_service(PermEVsn,CurrentServiceName) of - {error, Reason} -> - throw({error, Reason}); + {error, _} = Error1 -> + throw(Error1); CS -> CS end, @@ -1425,37 +1468,33 @@ prepare_restart_nt(#release{erts_vsn = EVsn, vsn = Vsn}, CurrentServiceName), case erlsrv:store_service(EVsn, FutureService) of - {error, Rison} -> - throw({error,Rison}); - _ -> + {error, _} = Error2 -> + throw(Error2); + _X -> erlsrv:disable_service(EVsn, FutureServiceName), ErlSrv = filename:nativename(erlsrv:erlsrv(EVsn)), - case heart:set_cmd(ErlSrv ++ " enable " ++ FutureServiceName ++ - " & " ++ ErlSrv ++ " start " ++ - FutureServiceName ++ - " & " ++ ErlSrv ++ " disable " ++ - FutureServiceName) of + StartDisabled = ErlSrv ++ " start_disabled " ++ FutureServiceName, + case heart:set_cmd(StartDisabled) of ok -> ok; - Error -> - throw({error, {'heart:set_cmd() error', Error}}) + Error3 -> + throw({error, {'heart:set_cmd() error', Error3}}) end end. - %%----------------------------------------------------------------- %% Set things up for restarting the new emulator. The actual %% restart is performed by calling init:reboot() higher up. %%----------------------------------------------------------------- -prepare_restart_new_emulator(StartPrg, RelDir, - Release, PRelease, - Masters) -> +prepare_restart_new_emulator(StartPrg, RootDir, RelDir, + Release, PRelease, Masters) -> #release{erts_vsn = EVsn, vsn = Vsn} = Release, Data = EVsn ++ " " ++ Vsn, DataFile = write_new_start_erl(Data, RelDir, Masters), %% Tell heart to use DataFile instead of start_erl.data case os:type() of {win32,nt} -> + write_ini_file(RootDir,EVsn,Masters), prepare_restart_nt(Release,PRelease,DataFile); {unix,_} -> StartP = check_start_prg(StartPrg, Masters), @@ -1832,50 +1871,10 @@ write_start(File, Data, false) -> end; write_start(File, Data, Masters) -> all_masters(Masters), - write_start_m(File, Data, Masters). + safe_write_file_m(File, Data, Masters). %%----------------------------------------------------------------- -%% Write the "start_erl.data" file at all master nodes. -%% 1. Save "start_erl.backup" at all nodes. -%% 2. Write the "start_erl.change" file at all nodes. -%% 3. Move "start_erl.change" to "start_erl.data". -%% 4. Remove "start_erl.backup" at all nodes. -%% -%% If one of the steps above fails, all steps is recovered from -%% (as long as possible), except for 4 which is allowed to fail. -%%----------------------------------------------------------------- -write_start_m(File, Data, Masters) -> - Dir = filename:dirname(File), - Backup = filename:join(Dir, "start_erl.backup"), - Change = filename:join(Dir, "start_erl.change"), - case at_all_masters(Masters, ?MODULE, do_copy_files, - [File, [Backup]]) of - ok -> - case at_all_masters(Masters, ?MODULE, do_write_file, - [Change, Data]) of - ok -> - case at_all_masters(Masters, file, rename, - [Change, File]) of - ok -> - remove_files(all, [Backup, Change], Masters), - ok; - {error, {Master, R}} -> - takewhile(Master, Masters, file, rename, - [Backup, File]), - remove_files(all, [Backup, Change], Masters), - throw({error, {Master, R, move_start_erl}}) - end; - {error, {Master, R}} -> - remove_files(all, [Backup, Change], Masters), - throw({error, {Master, R, write_start_erl}}) - end; - {error, {Master, R}} -> - remove_files(Master, [Backup], Masters), - throw({error, {Master, R, backup_start_erl}}) - end. - -%%----------------------------------------------------------------- %% Copy the "start.boot" and "sys.config" from SrcDir to DestDir at all %% master nodes. %% 1. Save DestDir/"start.backup" and DestDir/"sys.backup" at all nodes. @@ -1917,3 +1916,97 @@ set_static_files(SrcDir, DestDir, Masters) -> remove_files(Master, [BackupBoot, BackupConf], Masters), throw({error, {Master, R, backup_start_config}}) end. + +%%----------------------------------------------------------------- +%% Write erl.ini +%% Writes the erl.ini file used by erl.exe when (re)starting the erlang node. +%% At first installation, this is done by Install.exe, which means that if +%% the format of this file for some reason is changed, then Install.c must +%% also be updated (and probably some other c-files which read erl.ini) +%%----------------------------------------------------------------- +write_ini_file(RootDir,EVsn,Masters) -> + BinDir = filename:join([RootDir,"erts-"++EVsn,"bin"]), + Str0 = io_lib:format("[erlang]~n" + "Bindir=~s~n" + "Progname=erl~n" + "Rootdir=~s~n", + [filename:nativename(BinDir), + filename:nativename(RootDir)]), + Str = re:replace(Str0,"\\\\","\\\\\\\\",[{return,list},global]), + IniFile = filename:join(BinDir,"erl.ini"), + do_write_ini_file(IniFile,Str,Masters). + +do_write_ini_file(File,Data,false) -> + case do_write_file(File, Data) of + ok -> ok; + Error -> throw(Error) + end; +do_write_ini_file(File,Data,Masters) -> + all_masters(Masters), + safe_write_file_m(File, Data, Masters). + + +%%----------------------------------------------------------------- +%% Write the given file at all master nodes. +%% 1. Save <File>.backup at all nodes. +%% 2. Write <File>.change at all nodes. +%% 3. Move <File>.change to <File> +%% 4. Remove <File>.backup at all nodes. +%% +%% If one of the steps above fails, all steps are recovered from +%% (as long as possible), except for 4 which is allowed to fail. +%%----------------------------------------------------------------- +safe_write_file_m(File, Data, Masters) -> + Backup = File ++ ".backup", + Change = File ++ ".change", + case at_all_masters(Masters, ?MODULE, do_copy_files, + [File, [Backup]]) of + ok -> + case at_all_masters(Masters, ?MODULE, do_write_file, + [Change, Data]) of + ok -> + case at_all_masters(Masters, file, rename, + [Change, File]) of + ok -> + remove_files(all, [Backup, Change], Masters), + ok; + {error, {Master, R}} -> + takewhile(Master, Masters, file, rename, + [Backup, File]), + remove_files(all, [Backup, Change], Masters), + throw({error, {Master, R, rename, + filename:basename(Change), + filename:basename(File)}}) + end; + {error, {Master, R}} -> + remove_files(all, [Backup, Change], Masters), + throw({error, {Master, R, write, filename:basename(Change)}}) + end; + {error, {Master, R}} -> + remove_files(Master, [Backup], Masters), + throw({error, {Master, R, backup, + filename:basename(File), + filename:basename(Backup)}}) + end. + +%%----------------------------------------------------------------- +%% Figure out which applications that have changed version between the +%% two releases. The paths for these applications must always be +%% updated, even if the relup script does not load any modules. See +%% OTP-9402. +%% +%% A different situation is when the same application version is used +%% in old and new release, but the path has changed. This is not +%% handled here - instead it must be explicitely indicated by the +%% 'update_paths' option to release_handler:install_release/2 if the +%% code path shall be updated then. +%% ----------------------------------------------------------------- +get_new_libs([{App,Vsn,_LibDir}|CurrentLibs], NewLibs) -> + case lists:keyfind(App,1,NewLibs) of + {App,NewVsn,_} = LibInfo when NewVsn =/= Vsn -> + [LibInfo | get_new_libs(CurrentLibs,NewLibs)]; + _ -> + get_new_libs(CurrentLibs,NewLibs) + end; +get_new_libs([],_) -> + []. diff --git a/lib/sasl/src/release_handler_1.erl b/lib/sasl/src/release_handler_1.erl index 8d050fb7b0..ef95606bb5 100644 --- a/lib/sasl/src/release_handler_1.erl +++ b/lib/sasl/src/release_handler_1.erl @@ -19,7 +19,8 @@ -module(release_handler_1). %% External exports --export([eval_script/3, eval_script/4, check_script/2]). +-export([eval_script/1, eval_script/5, + check_script/2, check_old_processes/2]). -export([get_current_vsn/1]). %% exported because used in a test case -record(eval_state, {bins = [], stopped = [], suspended = [], apps = [], @@ -33,11 +34,11 @@ %% libdirs = [{Lib, LibVsn, LibDir}] - Maps Lib to Vsn and Directory %% unpurged = [{Mod, soft_purge | brutal_purge}] %% vsns = [{Mod, OldVsn, NewVsn}] - remember the old vsn of a mod -%% before it is removed/a new vsn is loaded; the new vsn +%% before a new vsn is loaded; the new vsn %% is kept in case of a downgrade, where the code_change %% function receives the vsn of the module to downgrade %% *to*. -%% newlibs = [{Lib, Dir}] - list of all new libs; used to change +%% newlibs = [{Lib, LibVsn, LibDir}] - list of all new libs; used to change %% the code path %% opts = [{Tag, Value}] - list of options %%----------------------------------------------------------------- @@ -47,34 +48,39 @@ %%% This is a low-level release handler. %%%----------------------------------------------------------------- check_script(Script, LibDirs) -> - case catch check_old_processes(Script) of - ok -> + case catch check_old_processes(Script,soft_purge) of + {ok, PurgeMods} -> {Before, _After} = split_instructions(Script), case catch lists:foldl(fun(Instruction, EvalState1) -> eval(Instruction, EvalState1) end, #eval_state{libdirs = LibDirs}, Before) of - EvalState2 when is_record(EvalState2, eval_state) -> ok; - {error, Error} -> {error, Error}; - Other -> {error, Other} + EvalState2 when is_record(EvalState2, eval_state) -> + {ok,PurgeMods}; + {error, Error} -> + {error, Error}; + Other -> + {error, Other} end; {error, Mod} -> {error, {old_processes, Mod}} end. -eval_script(Script, Apps, LibDirs) -> - eval_script(Script, Apps, LibDirs, []). +%% eval_script/1 - For testing only - no apps added, just testing instructions +eval_script(Script) -> + eval_script(Script, [], [], [], []). -eval_script(Script, Apps, LibDirs, Opts) -> - case catch check_old_processes(Script) of - ok -> +eval_script(Script, Apps, LibDirs, NewLibs, Opts) -> + case catch check_old_processes(Script,soft_purge) of + {ok,_} -> {Before, After} = split_instructions(Script), case catch lists:foldl(fun(Instruction, EvalState1) -> eval(Instruction, EvalState1) end, #eval_state{apps = Apps, libdirs = LibDirs, + newlibs = NewLibs, opts = Opts}, Before) of EvalState2 when is_record(EvalState2, eval_state) -> @@ -110,32 +116,63 @@ split_instructions([], Before) -> {[], lists:reverse(Before)}. %%----------------------------------------------------------------- -%% Func: check_old_processes/1 +%% Func: check_old_processes/2 %% Args: Script = [instruction()] +%% PrePurgeMethod = soft_purge | brutal_purge %% Purpose: Check if there is any process that runs an old version -%% of a module that should be soft_purged, (i.e. not purged -%% at all if there is any such process). Returns {error, Mod} -%% if so, ok otherwise. -%% Returns: ok | {error, Mod} +%% of a module that should be purged according to PrePurgeMethod. +%% Returns a list of modules that can be soft_purged. +%% +%% If PrePurgeMethod == soft_purge, the function will succeed +%% only if there is no process running old code of any of the +%% modules. Else it will throw {error,Mod}, where Mod is the +%% first module found that can not be soft_purged. +%% +%% If PrePurgeMethod == brutal_purge, the function will +%% always succeed and return a list of all modules that are +%% specified in the script with PrePurgeMethod brutal_purge, +%% but that can be soft_purged. +%% +%% Returns: {ok,PurgeMods} | {error, Mod} +%% PurgeMods = [Mod] %% Mod = atom() %%----------------------------------------------------------------- -check_old_processes(Script) -> - lists:foreach(fun({load, {Mod, soft_purge, _PostPurgeMethod}}) -> - check_old_code(Mod); - ({remove, {Mod, soft_purge, _PostPurgeMethod}}) -> - check_old_code(Mod); - (_) -> ok - end, - Script). +check_old_processes(Script,PrePurgeMethod) -> + Procs = erlang:processes(), + {ok,lists:flatmap( + fun({load, {Mod, PPM, _PostPurgeMethod}}) when PPM==PrePurgeMethod -> + check_old_code(Mod,Procs,PrePurgeMethod); + ({remove, {Mod, PPM, _PostPurgeMethod}}) when PPM==PrePurgeMethod -> + check_old_code(Mod,Procs,PrePurgeMethod); + (_) -> [] + end, + Script)}. + +check_old_code(Mod,Procs,PrePurgeMethod) -> + case erlang:check_old_code(Mod) of + true when PrePurgeMethod==soft_purge -> + do_check_old_code(Mod,Procs); + true when PrePurgeMethod==brutal_purge -> + case catch do_check_old_code(Mod,Procs) of + {error,Mod} -> []; + R -> R + end; + false -> + [] + end. + + +do_check_old_code(Mod,Procs) -> + lists:foreach( + fun(Pid) -> + case erlang:check_process_code(Pid, Mod) of + false -> ok; + true -> throw({error, Mod}) + end + end, + Procs), + [Mod]. -check_old_code(Mod) -> - lists:foreach(fun(Pid) -> - case erlang:check_process_code(Pid, Mod) of - false -> ok; - true -> throw({error, Mod}) - end - end, - erlang:processes()). %%----------------------------------------------------------------- %% An unpurged module is a module for which there exist an old @@ -214,16 +251,15 @@ check_old_code(Mod) -> %%----------------------------------------------------------------- eval({load_object_code, {Lib, LibVsn, Modules}}, EvalState) -> case lists:keysearch(Lib, 1, EvalState#eval_state.libdirs) of - {value, {Lib, LibVsn, LibDir}} -> - Ebin = filename:join(LibDir, "ebin"), + {value, {Lib, LibVsn, LibDir} = LibInfo} -> Ext = code:objfile_extension(), {NewBins, NewVsns} = lists:foldl(fun(Mod, {Bins, Vsns}) -> File = lists:concat([Mod, Ext]), - FName = filename:join(Ebin, File), + FName = filename:join([LibDir, "ebin", File]), case erl_prim_loader:get_file(FName) of {ok, Bin, FName2} -> - NVsns = add_new_vsn(Mod, Bin, Vsns), + NVsns = add_vsns(Mod, Bin, Vsns), {[{Mod, Bin, FName2} | Bins],NVsns}; error -> throw({error, {no_such_file,FName}}) @@ -232,7 +268,7 @@ eval({load_object_code, {Lib, LibVsn, Modules}}, EvalState) -> {EvalState#eval_state.bins, EvalState#eval_state.vsns}, Modules), - NewLibs = [{Lib, Ebin} | EvalState#eval_state.newlibs], + NewLibs = lists:keystore(Lib,1,EvalState#eval_state.newlibs,LibInfo), EvalState#eval_state{bins = NewBins, newlibs = NewLibs, vsns = NewVsns}; @@ -242,15 +278,14 @@ eval({load_object_code, {Lib, LibVsn, Modules}}, EvalState) -> eval(point_of_no_return, EvalState) -> Libs = case get_opt(update_paths, EvalState, false) of false -> - EvalState#eval_state.newlibs; % [{Lib, Path}] + EvalState#eval_state.newlibs; true -> - lists:map(fun({Lib, _LibVsn, LibDir}) -> - Ebin= filename:join(LibDir,"ebin"), - {Lib, Ebin} - end, - EvalState#eval_state.libdirs) + EvalState#eval_state.libdirs end, - lists:foreach(fun({Lib, Path}) -> code:replace_path(Lib, Path) end, + lists:foreach(fun({Lib, _LibVsn, LibDir}) -> + Ebin = filename:join(LibDir,"ebin"), + code:replace_path(Lib, Ebin) + end, Libs), EvalState; eval({load, {Mod, _PrePurgeMethod, PostPurgeMethod}}, EvalState) -> @@ -258,32 +293,21 @@ eval({load, {Mod, _PrePurgeMethod, PostPurgeMethod}}, EvalState) -> {value, {_Mod, Bin, File}} = lists:keysearch(Mod, 1, Bins), % load_binary kills all procs running old code % if soft_purge, we know that there are no such procs now - Vsns = EvalState#eval_state.vsns, - NewVsns = add_old_vsn(Mod, Vsns), code:load_binary(Mod, File, Bin), % Now, the prev current is old. There might be procs % running it. Find them. Unpurged = do_soft_purge(Mod,PostPurgeMethod,EvalState#eval_state.unpurged), EvalState#eval_state{bins = lists:keydelete(Mod, 1, Bins), - unpurged = Unpurged, - vsns = NewVsns}; + unpurged = Unpurged}; eval({remove, {Mod, _PrePurgeMethod, PostPurgeMethod}}, EvalState) -> - % purge kills all procs running old code - % if soft_purge, we know that there are no such procs now - Vsns = EvalState#eval_state.vsns, - NewVsns = add_old_vsn(Mod, Vsns), + %% purge kills all procs running old code + %% if soft_purge, we know that there are no such procs now code:purge(Mod), code:delete(Mod), - % Now, the prev current is old. There might be procs - % running it. Find them. - Unpurged = - case code:soft_purge(Mod) of - true -> EvalState#eval_state.unpurged; - false -> [{Mod, PostPurgeMethod} | EvalState#eval_state.unpurged] - end, -%% Bins = EvalState#eval_state.bins, -%% EvalState#eval_state{bins = lists:keydelete(Mod, 1, Bins), - EvalState#eval_state{unpurged = Unpurged, vsns = NewVsns}; + %% Now, the prev current is old. There might be procs + %% running it. Find them. + Unpurged = do_soft_purge(Mod,PostPurgeMethod,EvalState#eval_state.unpurged), + EvalState#eval_state{unpurged = Unpurged}; eval({purge, Modules}, EvalState) -> % Now, if there are any processes still executing old code, OR % if some new processes started after suspend but before load, @@ -606,26 +630,20 @@ sync_nodes(Id, Nodes) -> end, NNodes). -add_old_vsn(Mod, Vsns) -> +add_vsns(Mod, NewBin, Vsns) -> + OldVsn = get_current_vsn(Mod), + NewVsn = get_vsn(NewBin), case lists:keysearch(Mod, 1, Vsns) of - {value, {Mod, undefined, NewVsn}} -> - OldVsn = get_current_vsn(Mod), - lists:keyreplace(Mod, 1, Vsns, {Mod, OldVsn, NewVsn}); - {value, {Mod, _OldVsn, _NewVsn}} -> - Vsns; + {value, {Mod, OldVsn0, NewVsn0}} -> + lists:keyreplace(Mod, 1, Vsns, {Mod, + replace_undefined(OldVsn0,OldVsn), + replace_undefined(NewVsn0,NewVsn)}); false -> - OldVsn = get_current_vsn(Mod), - [{Mod, OldVsn, undefined} | Vsns] + [{Mod, OldVsn, NewVsn} | Vsns] end. -add_new_vsn(Mod, Bin, Vsns) -> - NewVsn = get_vsn(Bin), - case lists:keysearch(Mod, 1, Vsns) of - {value, {Mod, OldVsn, undefined}} -> - lists:keyreplace(Mod, 1, Vsns, {Mod, OldVsn, NewVsn}); - false -> - [{Mod, undefined, NewVsn} | Vsns] - end. +replace_undefined(undefined,Vsn) -> Vsn; +replace_undefined(Vsn,_) -> Vsn. %%----------------------------------------------------------------- %% Func: get_current_vsn/1 @@ -645,7 +663,9 @@ get_current_vsn(Mod) -> {ok, Bin, _File2} -> get_vsn(Bin); error -> - throw({error, {no_such_file, File}}) + %% This is the case when a new module is added, there will + %% be no current version of it at the time of this call. + undefined end. %%----------------------------------------------------------------- diff --git a/lib/sasl/src/systools_lib.erl b/lib/sasl/src/systools_lib.erl index b652c109fe..1b6ea125d9 100644 --- a/lib/sasl/src/systools_lib.erl +++ b/lib/sasl/src/systools_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. +%% Copyright Ericsson AB 1996-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -24,7 +24,7 @@ %% -export([file_term2binary/2, read_term/1, read_term_from_stream/2, - get_dirs/1, get_path/1]). + get_dirs/1, get_path/1, werror/2]). -include_lib("kernel/include/file.hrl"). @@ -176,21 +176,26 @@ add_dirs(RegName, Dirs, Root) -> regexp_match(RegName, D0, Root) -> case file:list_dir(D0) of {ok, Files} when length(Files) > 0 -> - FR = fun(F) -> - case regexp:match(F, RegName) of - {match,1,N} when N == length(F) -> - DirF = join(D0, F, Root), - case dir_p(DirF) of - true -> - {true, DirF}; + case re:compile(RegName) of + {ok, MP} -> + FR = fun(F) -> + case re:run(F, MP) of + {match,[{0,N}]} when N == length(F) -> + DirF = join(D0, F, Root), + case dir_p(DirF) of + true -> + {true, DirF}; + _ -> + false + end; _ -> false - end; - _ -> - false - end - end, - {true,lists:zf(FR, Files)}; + end + end, + {true,lists:zf(FR, Files)}; + _ -> + false + end; _ -> false end. @@ -214,6 +219,7 @@ flat([H|T], Ack) -> flat(T, [H|Ack]); flat([], Ack) -> lists:reverse(Ack). - - + +werror(Options, Warnings) -> + lists:member(warnings_as_errors, Options) andalso Warnings =/= []. diff --git a/lib/sasl/src/systools_make.erl b/lib/sasl/src/systools_make.erl index 7489ee58d2..7f400f5cce 100644 --- a/lib/sasl/src/systools_make.erl +++ b/lib/sasl/src/systools_make.erl @@ -44,10 +44,12 @@ %%----------------------------------------------------------------- %% Create a boot script from a release file. -%% Options is a list of {path, Path} | silent | local where path sets -%% the search path, silent supresses error message printing on console, -%% local generates a script with references to the directories there -%% the applications are found. +%% Options is a list of {path, Path} | silent | local +%% | warnings_as_errors +%% where path sets the search path, silent supresses error message +%% printing on console, local generates a script with references +%% to the directories there the applications are found, +%% and warnings_as_errors treats warnings as errors. %% %% New options: {path,Path} can contain wildcards %% src_tests @@ -85,11 +87,16 @@ make_script(RelName, Output, Flags) when is_list(RelName), ModTestP = {member(src_tests, Flags),xref_p(Flags)}, case get_release(RelName, Path, ModTestP, machine(Flags)) of {ok, Release, Appls, Warnings} -> - case generate_script(Output,Release,Appls,Flags) of - ok -> + case systools_lib:werror(Flags, Warnings) of + true -> return(ok,Warnings,Flags); - Error -> - return(Error,Warnings,Flags) + false -> + case generate_script(Output,Release,Appls,Flags) of + ok -> + return(ok,Warnings,Flags); + Error -> + return(Error,Warnings,Flags) + end end; Error -> return(Error,[],Flags) @@ -130,10 +137,21 @@ get_outdir(Flags) -> return(ok,Warnings,Flags) -> case member(silent,Flags) of true -> - {ok,?MODULE,Warnings}; + case systools_lib:werror(Flags, Warnings) of + true -> + error; + false -> + {ok,?MODULE,Warnings} + end; _ -> - io:format("~s",[format_warning(Warnings)]), - ok + case member(warnings_as_errors,Flags) of + true -> + io:format("~s",[format_warning(Warnings, true)]), + error; + false -> + io:format("~s",[format_warning(Warnings)]), + ok + end end; return({error,Mod,Error},_,Flags) -> case member(silent,Flags) of @@ -1612,9 +1630,9 @@ var_dir(_Dir, _, _, []) -> false. appDir(AppDir) -> - case reverse(filename:split(AppDir)) of - ["ebin"|Dir] -> filename:join(reverse(Dir)); - _ -> AppDir + case filename:basename(AppDir) of + "ebin" -> filename:dirname(AppDir); + _ -> AppDir end. add_modules(Modules, Tar, AppDir, ToDir, Ext) -> @@ -1833,78 +1851,89 @@ get_flag(_,_) -> false. %% Check Options for make_script check_args_script(Args) -> cas(Args, - {undef, undef, undef, undef, undef, undef, undef, undef, []}). + {undef, undef, undef, undef, undef, undef, undef, undef, + undef, []}). -cas([], {_Path,_Sil,_Loc,_Test,_Var,_Mach,_Xref,_XrefApps, X}) -> +cas([], {_Path,_Sil,_Loc,_Test,_Var,_Mach,_Xref,_XrefApps,_Werror, X}) -> X; %%% path --------------------------------------------------------------- -cas([{path, P} | Args], {Path, Sil, Loc, Test, Var, Mach, - Xref, XrefApps, X}) when is_list(P) -> +cas([{path, P} | Args], {Path, Sil, Loc, Test, Var, Mach, Xref, + XrefApps, Werror, X}) when is_list(P) -> case check_path(P) of ok -> - cas(Args, {P, Sil, Loc, Test, Var, Mach, Xref, XrefApps,X}); + cas(Args, {P, Sil, Loc, Test, Var, Mach, Xref, XrefApps, + Werror, X}); error -> cas(Args, {Path, Sil, Loc, Test, Var, Mach, Xref, XrefApps, - X++[{path,P}]}) + Werror, X++[{path,P}]}) end; %%% silent ------------------------------------------------------------- -cas([silent | Args], {Path, _Sil, Loc, Test, Var, Mach, - Xref, XrefApps, X}) -> - cas(Args, {Path, silent, Loc, Test, Var, Mach, Xref, XrefApps, X}); +cas([silent | Args], {Path, _Sil, Loc, Test, Var, Mach, Xref, + XrefApps, Werror, X}) -> + cas(Args, {Path, silent, Loc, Test, Var, Mach, Xref, XrefApps, + Werror, X}); %%% local -------------------------------------------------------------- -cas([local | Args], {Path, Sil, _Loc, Test, Var, Mach, - Xref, XrefApps, X}) -> - cas(Args, {Path, Sil, local, Test, Var, Mach, Xref, XrefApps, X}); +cas([local | Args], {Path, Sil, _Loc, Test, Var, Mach, Xref, + XrefApps, Werror, X}) -> + cas(Args, {Path, Sil, local, Test, Var, Mach, Xref, XrefApps, + Werror, X}); %%% src_tests ------------------------------------------------------- -cas([src_tests | Args], {Path, Sil, Loc, _Test, Var, Mach, - Xref, XrefApps, X}) -> +cas([src_tests | Args], {Path, Sil, Loc, _Test, Var, Mach, Xref, + XrefApps, Werror, X}) -> cas(Args, - {Path, Sil, Loc, src_tests, Var, Mach, Xref, XrefApps,X}); + {Path, Sil, Loc, src_tests, Var, Mach, Xref, Werror, XrefApps,X}); %%% variables ---------------------------------------------------------- -cas([{variables, V} | Args], {Path, Sil, Loc, Test, Var, Mach, - Xref, XrefApps, X}) when is_list(V) -> +cas([{variables, V} | Args], {Path, Sil, Loc, Test, Var, Mach, Xref, + XrefApps, Werror, X}) when is_list(V) -> case check_vars(V) of ok -> cas(Args, - {Path, Sil, Loc, Test, V, Mach, Xref, XrefApps, X}); + {Path, Sil, Loc, Test, V, Mach, Xref, XrefApps, Werror, X}); error -> cas(Args, {Path, Sil, Loc, Test, Var, Mach, Xref, XrefApps, - X++[{variables, V}]}) + Werror, X++[{variables, V}]}) end; %%% machine ------------------------------------------------------------ -cas([{machine, M} | Args], {Path, Sil, Loc, Test, Var, Mach, - Xref, XrefApps, X}) when is_atom(M) -> - cas(Args, {Path, Sil, Loc, Test, Var, Mach, Xref, XrefApps, X}); +cas([{machine, M} | Args], {Path, Sil, Loc, Test, Var, Mach, Xref, + XrefApps, Werror, X}) when is_atom(M) -> + cas(Args, {Path, Sil, Loc, Test, Var, Mach, Xref, XrefApps, Werror, X}); %%% exref -------------------------------------------------------------- -cas([exref | Args], {Path, Sil, Loc, Test, Var, Mach, - _Xref, XrefApps, X}) -> - cas(Args, {Path, Sil, Loc, Test, Var, Mach, exref, XrefApps, X}); +cas([exref | Args], {Path, Sil, Loc, Test, Var, Mach, _Xref, + XrefApps, Werror, X}) -> + cas(Args, {Path, Sil, Loc, Test, Var, Mach, exref, XrefApps, Werror, X}); %%% exref Apps --------------------------------------------------------- -cas([{exref, Apps} | Args], {Path, Sil, Loc, Test, Var, Mach, - Xref, XrefApps, X}) when is_list(Apps) -> +cas([{exref, Apps} | Args], {Path, Sil, Loc, Test, Var, Mach, Xref, + XrefApps, Werror, X}) when is_list(Apps) -> case check_apps(Apps) of ok -> cas(Args, {Path, Sil, Loc, Test, Var, Mach, - Xref, Apps, X}); + Xref, Apps, Werror, X}); error -> cas(Args, {Path, Sil, Loc, Test, Var, Mach, - Xref, XrefApps, X++[{exref, Apps}]}) + Xref, XrefApps, Werror, X++[{exref, Apps}]}) end; %%% outdir Dir --------------------------------------------------------- -cas([{outdir, Dir} | Args], {Path, Sil, Loc, Test, Var, Mach, - Xref, XrefApps, X}) when is_list(Dir) -> - cas(Args, {Path, Sil, Loc, Test, Var, Mach, Xref, XrefApps, X}); +cas([{outdir, Dir} | Args], {Path, Sil, Loc, Test, Var, Mach, Xref, + XrefApps, Werror, X}) when is_list(Dir) -> + cas(Args, {Path, Sil, Loc, Test, Var, Mach, Xref, XrefApps, Werror, X}); %%% otp_build (secret, not documented) --------------------------------- -cas([otp_build | Args], {Path, Sil, Loc, Test, Var, Mach, - Xref, XrefApps, X}) -> - cas(Args, {Path, Sil, Loc, Test, Var, Mach, Xref, XrefApps, X}); +cas([otp_build | Args], {Path, Sil, Loc, Test, Var, Mach, Xref, + XrefApps, Werror, X}) -> + cas(Args, {Path, Sil, Loc, Test, Var, Mach, Xref, XrefApps, Werror, X}); %%% no_module_tests (kept for backwards compatibility, but ignored) ---- -cas([no_module_tests | Args], {Path, Sil, Loc, Test, Var, Mach, - Xref, XrefApps, X}) -> - cas(Args, {Path, Sil, Loc, Test, Var, Mach, Xref, XrefApps,X}); +cas([no_module_tests | Args], {Path, Sil, Loc, Test, Var, Mach, Xref, + XrefApps, Werror, X}) -> + cas(Args, {Path, Sil, Loc, Test, Var, Mach, Xref, XrefApps, Werror, X}); +%%% warnings_as_errors (kept for backwards compatibility, but ignored) ---- +cas([warnings_as_errors | Args], {Path, Sil, Loc, Test, Var, Mach, Xref, + XrefApps, _Werror, X}) -> + cas(Args, {Path, Sil, Loc, Test, Var, Mach, Xref, XrefApps, + warnings_as_errors, X}); %%% ERROR -------------------------------------------------------------- -cas([Y | Args], {Path, Sil, Loc, Test, Var, Mach, Xref, XrefApps, X}) -> - cas(Args, {Path, Sil, Loc, Test, Var, Mach, Xref, XrefApps,X++[Y]}). +cas([Y | Args], {Path, Sil, Loc, Test, Var, Mach, Xref, XrefApps, + Werror, X}) -> + cas(Args, {Path, Sil, Loc, Test, Var, Mach, Xref, XrefApps, Werror, + X++[Y]}). @@ -2030,7 +2059,6 @@ check_apps([H|T]) when is_atom(H) -> check_apps(_) -> error. - %% Format error format_error(badly_formatted_release) -> @@ -2144,21 +2172,31 @@ form_tar_err({add, File, Error}) -> %% Format warning format_warning(Warnings) -> - map(fun({warning,W}) -> form_warn(W) end, Warnings). - -form_warn({source_not_found,{Mod,_,App,_,_}}) -> - io_lib:format("*WARNING* ~p: Source code not found: ~p.erl~n", - [App,Mod]); -form_warn({{parse_error, File},{_,_,App,_,_}}) -> - io_lib:format("*WARNING* ~p: Parse error: ~p~n", - [App,File]); -form_warn({obj_out_of_date,{Mod,_,App,_,_}}) -> - io_lib:format("*WARNING* ~p: Object code (~p) out of date~n",[App,Mod]); -form_warn({exref_undef, Undef}) -> - F = fun({M,F,A}) -> - io_lib:format("*WARNING* Undefined function ~p:~p/~p~n", - [M,F,A]) + format_warning(Warnings, false). + +format_warning(Warnings, Werror) -> + Prefix = case Werror of + true -> + ""; + false -> + "*WARNING* " + end, + map(fun({warning,W}) -> form_warn(Prefix, W) end, Warnings). + +form_warn(Prefix, {source_not_found,{Mod,_,App,_,_}}) -> + io_lib:format("~s~p: Source code not found: ~p.erl~n", + [Prefix,App,Mod]); +form_warn(Prefix, {{parse_error, File},{_,_,App,_,_}}) -> + io_lib:format("~s~p: Parse error: ~p~n", + [Prefix,App,File]); +form_warn(Prefix, {obj_out_of_date,{Mod,_,App,_,_}}) -> + io_lib:format("~s~p: Object code (~p) out of date~n", + [Prefix,App,Mod]); +form_warn(Prefix, {exref_undef, Undef}) -> + F = fun({M,F,A}) -> + io_lib:format("~sUndefined function ~p:~p/~p~n", + [Prefix,M,F,A]) end, map(F, Undef); -form_warn(What) -> - io_lib:format("*WARNING* ~p~n", [What]). +form_warn(Prefix, What) -> + io_lib:format("~s ~p~n", [Prefix,What]). diff --git a/lib/sasl/src/systools_relup.erl b/lib/sasl/src/systools_relup.erl index ec5486226c..6d9e922900 100644 --- a/lib/sasl/src/systools_relup.erl +++ b/lib/sasl/src/systools_relup.erl @@ -122,7 +122,7 @@ %% rel_filename() = description() = string() %% Opts = [opt()] %% opt() = {path, [path()]} | silent | noexec | restart_emulator -%% | {outdir, string()} +%% | {outdir, string()} | warnings_as_errors %% path() = [string()] %% Ret = ok | error | {ok, Relup, Module, Warnings} | {error, Module, Error} %% @@ -139,8 +139,9 @@ %% %% The option `path' sets search path, `silent' suppresses printing of %% error messages to the console, `noexec' inhibits the creation of -%% the output "relup" file, and restart_emulator ensures that the new -%% emulator is restarted (as the final step). +%% the output "relup" file, restart_emulator ensures that the new +%% emulator is restarted (as the final step), and `warnings_as_errors' +%% treats warnings as errors. %% ---------------------------------------------------------------- mk_relup(TopRelFile, BaseUpRelDcs, BaseDnRelDcs) -> mk_relup(TopRelFile, BaseUpRelDcs, BaseDnRelDcs, []). @@ -153,14 +154,29 @@ mk_relup(TopRelFile, BaseUpRelDcs, BaseDnRelDcs, Opts) -> {false, false} -> case R of {ok, _Res, _Mod, Ws} -> - print_warnings(Ws), - ok; + print_warnings(Ws, Opts), + case systools_lib:werror(Opts, Ws) of + true -> + error; + false -> + ok + end; Other -> print_error(Other), error end; - _ -> - R + _ -> + case R of + {ok, _Res, _Mod, Ws} -> + case systools_lib:werror(Opts, Ws) of + true -> + error; + false -> + R + end; + R -> + R + end end; BadArg -> erlang:error({badarg, BadArg}) @@ -195,7 +211,12 @@ do_mk_relup(TopRelFile, BaseUpRelDcs, BaseDnRelDcs, Path, Opts) -> {Dn, Ws2} = foreach_baserel_dn(TopRel, TopApps, BaseDnRelDcs, Path, Opts, Ws1), Relup = {TopRel#release.vsn, Up, Dn}, - write_relup_file(Relup, Opts), + case systools_lib:werror(Opts, Ws2) of + true -> + ok; + false -> + write_relup_file(Relup, Opts) + end, {ok, Relup, ?MODULE, Ws2}; Other -> throw(Other) @@ -527,20 +548,29 @@ format_error(Error) -> io:format("~p~n", [Error]). -print_warnings(Ws) when is_list(Ws) -> - lists:foreach(fun(W) -> print_warning(W) end, Ws); -print_warnings(W) -> - print_warning(W). +print_warnings(Ws, Opts) when is_list(Ws) -> + lists:foreach(fun(W) -> print_warning(W, Opts) end, Ws); +print_warnings(W, Opts) -> + print_warning(W, Opts). -print_warning(W) -> - S = format_warning(W), +print_warning(W, Opts) -> + Prefix = case lists:member(warnings_as_errors, Opts) of + true -> + ""; + false -> + "*WARNING* " + end, + S = format_warning(Prefix, W), io:format("~s", [S]). -format_warning({erts_vsn_changed, {Rel1, Rel2}}) -> - io_lib:format("*WARNING* The ERTS version changed between ~p and ~p~n", - [Rel1, Rel2]); -format_warning(What) -> - io_lib:format("*WARNING* ~p~n",[What]). +format_warning(W) -> + format_warning("*WARNING* ", W). + +format_warning(Prefix, {erts_vsn_changed, {Rel1, Rel2}}) -> + io_lib:format("~sThe ERTS version changed between ~p and ~p~n", + [Prefix, Rel1, Rel2]); +format_warning(Prefix, What) -> + io_lib:format("~s~p~n",[Prefix, What]). get_reason({error, {open, _, _}}) -> open; diff --git a/lib/sasl/test/Makefile b/lib/sasl/test/Makefile index ad08c8136b..65be134462 100644 --- a/lib/sasl/test/Makefile +++ b/lib/sasl/test/Makefile @@ -31,7 +31,8 @@ MODULES= \ systools_SUITE \ systools_rc_SUITE \ overload_SUITE \ - rb_SUITE + rb_SUITE \ + rh_test_lib ERL_FILES= $(MODULES:%=%.erl) @@ -85,7 +86,7 @@ release_tests_spec: make_emakefile $(INSTALL_DIR) $(RELSYSDIR) $(INSTALL_DATA) $(ERL_FILES) $(RELSYSDIR) $(INSTALL_DATA) sasl.spec sasl.cover $(EMAKEFILE) $(RELSYSDIR) - chmod -f -R u+w $(RELSYSDIR) + chmod -R u+w $(RELSYSDIR) @tar cfh - *_SUITE_data | (cd $(RELSYSDIR); tar xf -) release_docs_spec: diff --git a/lib/sasl/test/installer.erl b/lib/sasl/test/installer.erl index a114c4b5c9..f5ceab0dc4 100644 --- a/lib/sasl/test/installer.erl +++ b/lib/sasl/test/installer.erl @@ -119,6 +119,7 @@ install_3(TestNode,PrivDir) -> ?print(["install_3 unpack_release P2A ok"]), ?check_release("P2A",unpacked,["a-1.1"]), {ok, "P1I", [new_emu]} = release_handler:check_install_release("P2A"), + ?print(["install_3 check_install_release P2A ok"]), ok = release_handler:make_permanent("P1I"), ?print(["install_3 make_permanent P1I ok"]), ?check_release("P1I",permanent,["a-1.1"]), @@ -268,23 +269,30 @@ client1_1(TestNode,PrivDir,MasterDir,ClientSname) -> erl_boot_server:start([IP]), ok = net_kernel:monitor_nodes(true), - Node = start_client(TestNode,ClientSname), + Node = start_client(TestNode,client1,ClientSname), trace_disallowed_calls(Node), %% Check env var for SASL on client node SaslEnv = rpc:call(Node, application, get_all_env, [sasl]), + ?print([{client1_1,sasl_env},SaslEnv]), {_,CliDir} = lists:keyfind(client_directory,1,SaslEnv), {_,[Master]} = lists:keyfind(masters,1,SaslEnv), {_,StartCli} = lists:keyfind(start_prg,1,SaslEnv), - Root = code:root_dir(), - true = (CliDir =:= filename:join([Root,"clients","type1",Node])), - true = (StartCli =:= filename:join([CliDir,"bin","start"])), + NodeStr = atom_to_list(Node), + [NodeStr,"type1","clients"|_] = lists:reverse(filename:split(CliDir)), true = (Master =:= node()), + case os:type() of + {unix,_} -> + true = (StartCli =:= filename:join([CliDir,"bin","start"])); + _ -> + ok + end, %% Unpack P1H on master {ok, "P1H"} = unpack_release(PrivDir,"rel1"), %% Unpack and install P1H on client + Root = code:root_dir(), P1HDir = filename:join([Root, "releases", "P1H"]), %% The AppDirs argument (last arg to set_unpacked) below is really @@ -339,6 +347,7 @@ client1_2(TestNode,PrivDir,Node) -> ?check_running_app_client(Node,a,"1.0"), ok = rpc:call(Node, release_handler, make_permanent, ["P1H"]), + ?check_release_client(Node,"P1H",permanent,["a-1.0"]), check_disallowed_calls(), reboot(TestNode,Node), @@ -584,7 +593,7 @@ trace_disallowed_calls(Node) -> MasterProc = self(), rpc:call(Node,dbg,tracer,[process,{fun(T,_) -> MasterProc ! T end,[]}]), rpc:call(Node,dbg,p,[all,call]), - rpc:call(Node,dbg,tp,[file,[]]). + rpc:call(Node,dbg,tp,[file,[{'_',[],[{message,{caller}}]}]]). check_disallowed_calls() -> receive @@ -594,13 +603,12 @@ check_disallowed_calls() -> ok end. -start_client(TestNode,Client) -> - {Start, Node} = do_start_client(Client,test_host()), - Cmd = lists:concat(["env NODENAME=",Client," ", - filename:join(code:root_dir(), Start)]), - ?print([{start_client,Client},Cmd]), - Res = os:cmd(Cmd), - ?print([{start_client,result},Res]), +start_client(TestNode,Client,Sname) -> + Node = list_to_atom(lists:concat([Sname,"@",test_host()])), + case os:type() of + {unix,_} -> start_client_unix(TestNode,Sname,Node); + {win32,_} -> start_client_win32(TestNode,Client,Sname) + end, receive {nodeup, Node} -> wait_started(TestNode,Node) @@ -609,10 +617,34 @@ start_client(TestNode,Client) -> ?fail({"can not start", Node}) end. -do_start_client(Client, Host) -> - Node = list_to_atom(lists:concat([Client,"@",Host])), +start_client_unix(TestNode,Sname,Node) -> Start = filename:join(["clients", "type1", Node, "bin", "start"]), - {Start, Node}. + Cmd = lists:concat(["env NODENAME=",Sname," ", + filename:join(code:root_dir(), Start)]), + ?print([{start_client,Sname},Cmd]), + Res = os:cmd(Cmd), + ?print([{start_client,result},Res]). + +start_client_win32(TestNode,Client,ClientSname) -> + Name = atom_to_list(ClientSname) ++ "_P1G", + RootDir = code:root_dir(), + ErtsBinDir = filename:join(RootDir,"erts-4.4/bin"), + + {ClientArgs,RelClientDir} = rh_test_lib:get_client_args(Client,ClientSname, + RootDir), + StartErlArgs = rh_test_lib:get_start_erl_args(RootDir,RelClientDir, + ClientArgs), + ServiceArgs = rh_test_lib:get_service_args(RootDir, RelClientDir, + ClientSname, StartErlArgs), + + ?print([{start_client,ClientSname},ServiceArgs]), + Erlsrv = filename:nativename(filename:join(ErtsBinDir,"erlsrv")), + rh_test_lib:erlsrv(Erlsrv,stop,Name), + rh_test_lib:erlsrv(Erlsrv,remove,Name), + ok = rh_test_lib:erlsrv(Erlsrv,add,Name,ServiceArgs), + ok = rh_test_lib:erlsrv(Erlsrv,start,Name), + ?print([{start_client,result},ok]), + ok. reboot(TestNode,Node) -> cover_client(TestNode,Node,stop_cover), @@ -628,7 +660,7 @@ check_reboot(TestNode,Node) -> receive {nodeup, Node} -> wait_started(TestNode,Node) after 30000 -> - ?fail({Node, "not rebooted",net_adm:ping(Node)}) + ?fail({Node, "not rebooted",net_adm:ping(Node)}) end after 30000 -> ?fail({Node, "not closing down",net_adm:ping(Node)}) @@ -678,22 +710,28 @@ client2(TestNode,PrivDir,ClientSname) -> release_handler:remove_release("P1H"), ok = net_kernel:monitor_nodes(true), - Node = start_client(TestNode,ClientSname), + Node = start_client(TestNode,client2,ClientSname), %% Check env var for SASL on client node - ?print([{sasl_env, Node}, rpc:call(Node, application, get_all_env, [sasl])]), SaslEnv = rpc:call(Node, application, get_all_env, [sasl]), + ?print([{client1_1,sasl_env},SaslEnv]), {_,CliDir} = lists:keyfind(client_directory,1,SaslEnv), {_,[Master,Master2]} = lists:keyfind(masters,1,SaslEnv), {_,StartCli} = lists:keyfind(start_prg,1,SaslEnv), - Root = code:root_dir(), - true = (CliDir =:= filename:join([Root,"clients","type1",Node])), - true = (StartCli =:= filename:join([CliDir,"bin","start"])), + NodeStr = atom_to_list(Node), + [NodeStr,"type1","clients"|_] = lists:reverse(filename:split(CliDir)), true = (Master =:= node()), true = (Master2 =:= list_to_atom("master2@"++TestHost)), + case os:type() of + {unix,_} -> + true = (StartCli =:= filename:join([CliDir,"bin","start"])); + _ -> + ok + end, {ok, "P1H"} = unpack_release(PrivDir,"rel1"), + Root = code:root_dir(), {error,{bad_masters,[Master2]}} = rpc:call(Node, release_handler, set_unpacked, [filename:join([Root, "releases", "P1H", "rel1.rel"]),[]]), diff --git a/lib/sasl/test/release_handler_SUITE.erl b/lib/sasl/test/release_handler_SUITE.erl index efa775f344..b44da72d35 100644 --- a/lib/sasl/test/release_handler_SUITE.erl +++ b/lib/sasl/test/release_handler_SUITE.erl @@ -51,11 +51,14 @@ unix_cases() -> [target_system] ++ RunErlCases ++ cases(). win32_cases() -> - cases(). + [{group,release} | cases()]. %% Cases that can be run on all platforms cases() -> - [otp_2740, otp_2760, otp_5761, instructions, eval_appup]. + [otp_2740, otp_2760, otp_5761, otp_9402, otp_9417, + otp_9395_check_old_code, otp_9395_check_and_purge, + otp_9395_update_many_mods, otp_9395_rm_many_mods, + instructions, eval_appup]. groups() -> [{release,[], @@ -148,6 +151,10 @@ init_per_group(release_gg, Config0) -> end_per_group(release, Config) -> Dog = ?t:timetrap(?default_timeout), stop_print_proc(), + case os:type() of + {win32,_} -> delete_all_services(); + _ -> ok + end, delete_release(Config), ?t:timetrap_cancel(Dog), Config; @@ -169,6 +176,10 @@ end_per_testcase(Case, Config) -> Dog=?config(watchdog, Config), test_server:timetrap_cancel(Dog), + try apply(?MODULE,Case,[cleanup,Config]) + catch error:undef -> ok + end, + %% DEBUG case ?config(tc_status,Config) of ok -> @@ -206,10 +217,6 @@ end_per_testcase(Case, Config) -> %% immediately restarted by heart and the test cases wait until %% the node is actually up and running -- see wait_nodes_up/2) file:delete("sasl_erl_crash.dump"), - - try apply(?MODULE,Case,[cleanup,Config]) - catch error:undef -> ok - end, ok. gg_node_snames(Config) -> @@ -224,7 +231,10 @@ gg_node_snames(Config) -> no_run_erl(Config) when is_list(Config) -> {comment, "No run_erl program"}. - +break(Config) -> + erlang:display(test_break), + ?t:break(priv_dir(Config)), + ok. %% Test upgrade and downgrade of erts upgrade(Conf) when is_list(Conf) -> @@ -323,7 +333,7 @@ client1(Conf) when is_list(Conf) -> %% Copy the P1G release to a directory for use in this testcase ok = copy_installed(Conf,p1g_install,[Master]), - ok = copy_client(Conf,Master,Client,"start_cli1"), + ok = copy_client(Conf,Master,Client,client1), %% start the master node [TestNode] = start_nodes(Conf,[Master],"client1"), @@ -348,7 +358,7 @@ client2(Conf) when is_list(Conf) -> %% Copy the P1G release to a directory for use in this testcase ok = copy_installed(Conf,p1g_install,[Master]), - ok = copy_client(Conf,Master,Client,"start_cli2"), + ok = copy_client(Conf,Master,Client,client2), %% start the master node [TestNode] = start_nodes(Conf,[Master],"client2"), @@ -386,7 +396,7 @@ instructions(Conf) when is_list(Conf) -> {stop, [aa]}, {apply, {?MODULE, no_cc, []}}, {start, [aa]}], - {ok, _} = release_handler_1:eval_script(S1, [], []), + {ok, _} = release_handler_1:eval_script(S1), case whereis(cc) of Pid2 when is_pid(Pid2) -> ok; @@ -396,17 +406,17 @@ instructions(Conf) when is_list(Conf) -> %% Make bb run old version of b. S2 = [point_of_no_return, {remove, {b, soft_purge, soft_purge}}], - {ok, [{b, soft_purge}]} = release_handler_1:eval_script(S2, [], []), + {ok, [{b, soft_purge}]} = release_handler_1:eval_script(S2), check_bstate("first", [FirstBB]), false = code:is_loaded(b), - {error,{old_processes,b}} = release_handler_1:eval_script(S2,[],[]), + {error,{old_processes,b}} = release_handler_1:eval_script(S2), check_bstate("first", [FirstBB]), %% Let supervisor restart bb with new code S3 = [point_of_no_return, {purge, [b]}], - {ok, []} = release_handler_1:eval_script(S3, [], []), + {ok, []} = release_handler_1:eval_script(S3), ok = wait_for(bb), check_bstate("second", []), SecondBB = whereis(bb), @@ -439,7 +449,7 @@ instructions(Conf) when is_list(Conf) -> %% Let supervisor restart bb yet another time S4 = [point_of_no_return, {remove, {b, brutal_purge, soft_purge}}], - {ok, HopefullyEmpty} = release_handler_1:eval_script(S4, [], []), + {ok, HopefullyEmpty} = release_handler_1:eval_script(S4), ok = wait_for(bb), FourthBB = whereis(bb), @@ -549,7 +559,7 @@ otp_2760(Conf) -> LibDir = filename:join([DataDir,app1_app2,lib1]), Rel1 = create_and_install_fake_first_release(Dir,[{app1,"1.0",LibDir}]), - Rel2 = create_fake_upgrade_release(Dir,"after",[],{Rel1,Rel1,[LibDir]}), + Rel2 = create_fake_upgrade_release(Dir,"after",[],{[Rel1],[Rel1],[LibDir]}), Rel2Dir = filename:dirname(Rel2), %% Start a node with Rel1.boot and check that the app1 module is loaded @@ -559,13 +569,15 @@ otp_2760(Conf) -> %% Execute the relup script and check that app1 is unloaded {ok, [{"after", [{_Rel1Vsn, _Descr, Script}], _}]} = file:consult(filename:join(Rel2Dir, "relup")), - {ok, []} = rpc:call(Node, release_handler_1, eval_script, - [Script, [], []]), + {ok, []} = rpc:call(Node, release_handler_1, eval_script, [Script]), false = rpc:call(Node, code, is_loaded, [app1]), - true = stop_node(Node), ok. +otp_2760(cleanup,_Conf) -> + stop_node(node_name(otp_2760)). + + %% Test upgrade using other filesystem than the defined in OTP and %% option {update_paths, true} otp_5761(Conf) when is_list(Conf) -> @@ -591,7 +603,7 @@ otp_5761(Conf) when is_list(Conf) -> "2", [{app1,"2.0",LibDir2}, {app2,"1.0",LibDir2}], - {Rel1,Rel1,[LibDir1]}), + {[Rel1],[Rel1],[LibDir1]}), Rel1Dir = filename:dirname(Rel1), Rel2Dir = filename:dirname(Rel2), @@ -647,10 +659,410 @@ otp_5761(Conf) when is_list(Conf) -> App11Dir = rpc:call(Node, code, lib_dir, [app1]), App2aDir = rpc:call(Node, code, lib_dir, [app2]), - %% Stop the slave node - true = stop_node(Node), ok. +otp_5761(cleanup,_Conf) -> + stop_node(node_name(otp_5761)). + + +%% When a new version of an application is added, but no module is +%% changed - the path was not updated - i.e. code:priv_dir would point +%% to the old location. +otp_9402(Conf) when is_list(Conf) -> + %% Set some paths + PrivDir = priv_dir(Conf), + Dir = filename:join(PrivDir,"otp_9402"), + LibDir = filename:join(?config(data_dir, Conf), "lib"), + + %% Create the releases + Rel1 = create_and_install_fake_first_release(Dir, + [{a,"1.1",LibDir}]), + Rel2 = create_fake_upgrade_release(Dir, + "2", + [{a,"1.2",LibDir}], + {[Rel1],[Rel1],[LibDir]}), + Rel1Dir = filename:dirname(Rel1), + Rel2Dir = filename:dirname(Rel2), + + %% Start a slave node + {ok, Node} = t_start_node(otp_9402, Rel1, filename:join(Rel1Dir,"sys.config")), + + %% Check path + Dir1 = filename:join([LibDir, "a-1.1"]), + Dir1 = rpc:call(Node, code, lib_dir, [a]), + ABeam = rpc:call(Node, code, which, [a]), + + %% Install second release, with no changed modules + {ok, RelVsn2} = + rpc:call(Node, release_handler, set_unpacked, + [Rel2++".rel", [{a,"1.2",LibDir}]]), + ok = rpc:call(Node, release_handler, install_file, + [RelVsn2, filename:join(Rel2Dir, "relup")]), + ok = rpc:call(Node, release_handler, install_file, + [RelVsn2, filename:join(Rel2Dir, "start.boot")]), + ok = rpc:call(Node, release_handler, install_file, + [RelVsn2, filename:join(Rel2Dir, "sys.config")]), + + {ok, RelVsn1, []} = + rpc:call(Node, release_handler, install_release, [RelVsn2]), + + %% Check path + Dir2 = filename:join([LibDir, "a-1.2"]), + Dir2 = rpc:call(Node, code, lib_dir, [a]), + APrivDir2 = rpc:call(Node, code, priv_dir, [a]), + true = filelib:is_regular(filename:join(APrivDir2,"file")), + + %% Just to make sure no modules have been re-loaded + ABeam = rpc:call(Node, code, which, [a]), + + %% Install RelVsn1 again + {ok, _OtherVsn, []} = + rpc:call(Node, release_handler, install_release, [RelVsn1]), + + %% Check path + Dir1 = rpc:call(Node, code, lib_dir, [a]), + APrivDir1 = rpc:call(Node, code, priv_dir, [a]), + false = filelib:is_regular(filename:join(APrivDir1,"file")), + + %% Just to make sure no modules have been re-loaded + ABeam = rpc:call(Node, code, which, [a]), + + ok. + +otp_9402(cleanup,_Conf) -> + stop_node(node_name(otp_9402)). + + +%% When a module is deleted in an appup instruction, the upgrade +%% failed if the module was not loaded. +otp_9417(Conf) when is_list(Conf) -> + %% Set some paths + PrivDir = priv_dir(Conf), + Dir = filename:join(PrivDir,"otp_9417"), + LibDir = filename:join(?config(data_dir, Conf), "lib"), + + %% Create the releases + Rel1 = create_and_install_fake_first_release(Dir, + [{b,"1.0",LibDir}]), + Rel2 = create_fake_upgrade_release(Dir, + "2", + [{b,"2.0",LibDir}], + {[Rel1],[Rel1],[LibDir]}), + Rel1Dir = filename:dirname(Rel1), + Rel2Dir = filename:dirname(Rel2), + + %% Start a slave node + {ok, Node} = t_start_node(otp_9417, Rel1, filename:join(Rel1Dir,"sys.config")), + + %% Check paths + Dir1 = filename:join([LibDir, "b-1.0"]), + Dir1 = rpc:call(Node, code, lib_dir, [b]), + BLibBeam = filename:join([Dir1,"ebin","b_lib.beam"]), + BLibBeam = rpc:call(Node,code,which,[b_lib]), + false = rpc:call(Node,code,is_loaded,[b_lib]), + false = rpc:call(Node,code,is_loaded,[b_server]), + + %% Install second release, which removes b_lib module + {ok, RelVsn2} = + rpc:call(Node, release_handler, set_unpacked, + [Rel2++".rel", [{b,"2.0",LibDir}]]), + ok = rpc:call(Node, release_handler, install_file, + [RelVsn2, filename:join(Rel2Dir, "relup")]), + ok = rpc:call(Node, release_handler, install_file, + [RelVsn2, filename:join(Rel2Dir, "start.boot")]), + ok = rpc:call(Node, release_handler, install_file, + [RelVsn2, filename:join(Rel2Dir, "sys.config")]), + + {ok, _RelVsn1, []} = + rpc:call(Node, release_handler, install_release, [RelVsn2]), + + %% Check that the module does no longer exist + false = rpc:call(Node, code, is_loaded, [b_lib]), + non_existing = rpc:call(Node, code, which, [b_lib]), + + %% And check some paths + Dir2 = filename:join([LibDir, "b-2.0"]), + Dir2 = rpc:call(Node, code, lib_dir, [b]), + BServerBeam = filename:join([Dir2,"ebin","b_server.beam"]), + {file,BServerBeam} = rpc:call(Node,code,is_loaded,[b_server]), + ok. + +otp_9417(cleanup,_Conf) -> + stop_node(node_name(otp_9417)). + + +%% OTP-9395 - performance problems when there are MANY processes +%% Test that the procedure of checking for old code before an upgrade +%% can be started is "very much faster" when there is no old code in +%% the system. +otp_9395_check_old_code(Conf) when is_list(Conf) -> + + NProcs = 1000, + MPath = filename:join([?config(data_dir,Conf),"lib","many_mods-1.0","ebin"]), + code:add_path(MPath), + + %% Start NProc processes, each referencing each module + {Modules,Pids} = m:start(NProcs), + + %% Load each module again in order to get old code + [code:load_file(Mod) || Mod <- Modules], + true = erlang:check_old_code(m10), + + S = [point_of_no_return | + [{remove,{M,soft_purge,soft_purge}} || M <- Modules]], + + %% Do the old code check, then purge, and redo + {T1,{ok,PurgeMods}} = timer:tc(release_handler_1,check_script,[S,[]]), + true = (lists:sort(PurgeMods) == lists:sort(Modules)), + [code:purge(M) || M <- PurgeMods], + {T2,{ok,[]}} = timer:tc(release_handler_1,check_script,[S,[]]), + + %% Cleanup + lists:foreach(fun(Pid) -> Pid ! stop end, Pids), + lists:foreach(fun(Mod) -> code:purge(Mod), + code:delete(Mod), + code:purge(Mod) + end, Modules), + code:del_path(MPath), + + %% Test that second run was much faster than the first + if T2 > 0 -> + X = T1/T2, + ct:log("~p procs, ~p mods -> ~n" + "\tWith old code: ~.2f sec~n" + "\tAfter purge: ~.2f sec~n" + "\tT1/T2: ~.2f", + [NProcs,length(Modules),T1/1000000,T2/1000000,X]), + if X < 1000 -> + ct:fail({not_enough_improvement_after_purge,round(X)}); + true -> + ok + end; + T1 > 0 -> %% Means T1/T2 = infinite + ok; + true -> + ct:fail({unexpected_values,T1,T2}) + end, + ok. + + +%% OTP-9395 - performance problems when there are MANY processes +%% Added option 'purge' to check_install_release +otp_9395_check_and_purge(Conf) when is_list(Conf) -> + %% Set some paths + PrivDir = priv_dir(Conf), + Dir = filename:join(PrivDir,"otp_9395_check_and_purge"), + LibDir = filename:join(?config(data_dir, Conf), "lib"), + + %% Create the releases + Rel1 = create_and_install_fake_first_release(Dir, + [{b,"1.0",LibDir}]), + Rel2 = create_fake_upgrade_release(Dir, + "2", + [{b,"2.0",LibDir}], + {[Rel1],[Rel1],[LibDir]}), + Rel1Dir = filename:dirname(Rel1), + Rel2Dir = filename:dirname(Rel2), + + %% Start a slave node + {ok, Node} = t_start_node(otp_9395_check_and_purge, Rel1, + filename:join(Rel1Dir,"sys.config")), + + %% Make sure there is old code for b_lib and b_server + rpc:call(Node,code,load_file,[b_lib]), + rpc:call(Node,code,load_file,[b_lib]), + rpc:call(Node,code,load_file,[b_server]), + rpc:call(Node,code,load_file,[b_server]), + true = rpc:call(Node,erlang,check_old_code,[b_lib]), + true = rpc:call(Node,erlang,check_old_code,[b_server]), + + %% Unpack second release, which removes b_lib module and loads b_server + {ok, RelVsn2} = + rpc:call(Node, release_handler, set_unpacked, + [Rel2++".rel", [{b,"2.0",LibDir}]]), + ok = rpc:call(Node, release_handler, install_file, + [RelVsn2, filename:join(Rel2Dir, "relup")]), + ok = rpc:call(Node, release_handler, install_file, + [RelVsn2, filename:join(Rel2Dir, "start.boot")]), + ok = rpc:call(Node, release_handler, install_file, + [RelVsn2, filename:join(Rel2Dir, "sys.config")]), + + %% Do check_install_release, and check that old code still exists + {ok, _RelVsn1, []} = + rpc:call(Node, release_handler, check_install_release, [RelVsn2]), + true = rpc:call(Node,erlang,check_old_code,[b_lib]), + true = rpc:call(Node,erlang,check_old_code,[b_server]), + + %% Do check_install_release with option 'purge' and check that old + %% code is gone + {ok, _RelVsn1, []} = + rpc:call(Node, release_handler, check_install_release, [RelVsn2,[purge]]), + false = rpc:call(Node,erlang,check_old_code,[b_lib]), + false = rpc:call(Node,erlang,check_old_code,[b_server]), + + ok. + +otp_9395_check_and_purge(cleanup,_Conf) -> + stop_node(node_name(otp_9395_check_and_purge)). + + +%% OTP-9395 - performance problems when there are MANY processes +%% Upgrade which updates many modules (brutal_purge) +otp_9395_update_many_mods(Conf) when is_list(Conf) -> + %% Set some paths + PrivDir = priv_dir(Conf), + Dir = filename:join(PrivDir,"otp_9395_update_many_mods"), + LibDir = filename:join(?config(data_dir, Conf), "lib"), + + %% Create the releases + Rel1 = create_and_install_fake_first_release(Dir, + [{many_mods,"1.0",LibDir}]), + Rel2 = create_fake_upgrade_release(Dir, + "2", + [{many_mods,"1.1",LibDir}], + {[Rel1],[Rel1],[LibDir]}), + Rel1Dir = filename:dirname(Rel1), + Rel2Dir = filename:dirname(Rel2), + + %% Start a slave node + {ok, Node} = t_start_node(otp_9395_update_many_mods, Rel1, + filename:join(Rel1Dir,"sys.config")), + + %% Start a lot of processes on the new node, all with refs to each + %% module that will be updated + NProcs = 1000, + {Modules,Pids1} = rpc:call(Node,m,start,[NProcs]), + + %% Then load modules in order to get old code + [rpc:call(Node,code,load_file,[Mod]) || Mod <- Modules], + true = rpc:call(Node,erlang,check_old_code,[m10]), + + %% Unpack second release, which updates all mX modules + {ok, RelVsn2} = + rpc:call(Node, release_handler, set_unpacked, + [Rel2++".rel", [{many_mods,"1.1",LibDir}]]), + ok = rpc:call(Node, release_handler, install_file, + [RelVsn2, filename:join(Rel2Dir, "relup")]), + ok = rpc:call(Node, release_handler, install_file, + [RelVsn2, filename:join(Rel2Dir, "start.boot")]), + ok = rpc:call(Node, release_handler, install_file, + [RelVsn2, filename:join(Rel2Dir, "sys.config")]), + + %% First, install release directly and check how much time it takes + {TInst0,{ok, _, []}} = + timer:tc(rpc,call,[Node, release_handler, install_release, [RelVsn2]]), + ct:log("install_release: ~.2f",[TInst0/1000000]), + + %% Restore to old release, spawn processes again and load to get old code + {_,RelVsn1} = init:script_id(), + {_TInst1,{ok, _, []}} = + timer:tc(rpc,call,[Node, release_handler, install_release, [RelVsn1]]), +% ct:log("install_release: ~.2f",[_TInst1/1000000]), + + [exit(Pid,kill) || Pid <- Pids1], + {Modules,_Pids2} = rpc:call(Node,m,start,[NProcs]), + [rpc:call(Node,code,load_file,[Mod]) || Mod <- Modules], + true = rpc:call(Node,erlang,check_old_code,[m10]), + + %% Run check_install_release with purge before install this time + {TCheck,{ok, _RelVsn1, []}} = + timer:tc(rpc,call,[Node, release_handler, check_install_release, + [RelVsn2,[purge]]]), + ct:log("check_install_release with purge: ~.2f",[TCheck/1000000]), + + %% Finally install release after check and purge, and check that + %% this install was faster than the first. + {TInst2,{ok, _RelVsn1, []}} = + timer:tc(rpc,call,[Node, release_handler, install_release, [RelVsn2]]), + ct:log("install_release: ~.2f",[TInst2/1000000]), + + true = (TInst2 < TInst0), + + ok. + +otp_9395_update_many_mods(cleanup,_Conf) -> + stop_node(node_name(otp_9395_update_many_mods)). + + +%% OTP-9395 - performance problems when there are MANY processes +%% Upgrade which removes many modules (brutal_purge) +otp_9395_rm_many_mods(Conf) when is_list(Conf) -> + %% Set some paths + PrivDir = priv_dir(Conf), + Dir = filename:join(PrivDir,"otp_9395_rm_many_mods"), + LibDir = filename:join(?config(data_dir, Conf), "lib"), + + %% Create the releases + Rel1 = create_and_install_fake_first_release(Dir, + [{many_mods,"1.0",LibDir}]), + Rel2 = create_fake_upgrade_release(Dir, + "2", + [{many_mods,"2.0",LibDir}], + {[Rel1],[Rel1],[LibDir]}), + Rel1Dir = filename:dirname(Rel1), + Rel2Dir = filename:dirname(Rel2), + + %% Start a slave node + {ok, Node} = t_start_node(otp_9395_rm_many_mods, Rel1, + filename:join(Rel1Dir,"sys.config")), + + %% Start a lot of processes on the new node, all with refs to each + %% module that will be updated + NProcs = 1000, + {Modules,Pids1} = rpc:call(Node,m,start,[NProcs]), + + %% Then load modules in order to get old code + [rpc:call(Node,code,load_file,[Mod]) || Mod <- Modules], + true = rpc:call(Node,erlang,check_old_code,[m10]), + + %% Unpack second release, which removes all mX modules + {ok, RelVsn2} = + rpc:call(Node, release_handler, set_unpacked, + [Rel2++".rel", [{many_mods,"2.0",LibDir}]]), + ok = rpc:call(Node, release_handler, install_file, + [RelVsn2, filename:join(Rel2Dir, "relup")]), + ok = rpc:call(Node, release_handler, install_file, + [RelVsn2, filename:join(Rel2Dir, "start.boot")]), + ok = rpc:call(Node, release_handler, install_file, + [RelVsn2, filename:join(Rel2Dir, "sys.config")]), + + %% First, install release directly and check how much time it takes + {TInst0,{ok, _, []}} = + timer:tc(rpc,call,[Node, release_handler, install_release, [RelVsn2]]), + ct:log("install_release: ~.2f",[TInst0/1000000]), + + %% Restore to old release, spawn processes again and load to get old code + {_,RelVsn1} = init:script_id(), + {_TInst1,{ok, _, []}} = + timer:tc(rpc,call,[Node, release_handler, install_release, [RelVsn1]]), +% ct:log("install_release: ~.2f",[_TInst1/1000000]), + + [exit(Pid,kill) || Pid <- Pids1], + {Modules,_Pids2} = rpc:call(Node,m,start,[NProcs]), + [rpc:call(Node,code,load_file,[Mod]) || Mod <- Modules], + true = rpc:call(Node,erlang,check_old_code,[m10]), + + %% Run check_install_release with purge before install this time + {TCheck,{ok, _RelVsn1, []}} = + timer:tc(rpc,call,[Node, release_handler, check_install_release, + [RelVsn2,[purge]]]), + ct:log("check_install_release with purge: ~.2f",[TCheck/1000000]), + + %% Finally install release after check and purge, and check that + %% this install was faster than the first. + {TInst2,{ok, _RelVsn1, []}} = + timer:tc(rpc,call,[Node, release_handler, install_release, [RelVsn2]]), + ct:log("install_release: ~.2f",[TInst2/1000000]), + + true = (TInst2 =< TInst0), + + ok. + +otp_9395_rm_many_mods(cleanup,_Conf) -> + stop_node(node_name(otp_9395_rm_many_mods)). + + + %% Test upgrade and downgrade of applications eval_appup(Conf) when is_list(Conf) -> @@ -983,19 +1395,16 @@ stop_node(Node) -> ?t:stop_node(Node). -copy_client(Conf,Master,Sname,StartScript) -> +copy_client(Conf,Master,Sname,Client) -> io:format("copy_client(Conf)"), DataDir = ?config(data_dir, Conf), MasterDir = filename:join(priv_dir(Conf),Master), - {ok,Host} = inet:gethostname(), - {ok,IpTuple} = inet:getaddr(Host,inet), - IpAddr = inet_parse:ntoa(IpTuple), - - CliNode = node_name(Sname), + {ClientArgs,RelCliDir} = rh_test_lib:get_client_args(Client,Sname,MasterDir, + node_name(Master)), - Cli = filename:join([MasterDir, "clients", "type1", CliNode]), + Cli = filename:join([MasterDir, RelCliDir]), ok = filelib:ensure_dir(filename:join([Cli,"bin","."])), ok = filelib:ensure_dir(filename:join([Cli,"releases","."])), ok = filelib:ensure_dir(filename:join([Cli,"log","."])), @@ -1003,12 +1412,16 @@ copy_client(Conf,Master,Sname,StartScript) -> P1GOrig = filename:join([MasterDir, "releases", "P1G"]), ok = copy_tree(Conf,P1GOrig,filename:join(Cli,"releases")), - ok = subst_file(filename:join([DataDir, "clients", StartScript]), - filename:join([Cli,"bin","start"]), - [{"ROOT",MasterDir}, - {"MASTER",atom_to_list(Master)}, - {"IPADDR",IpAddr}], - [{chmod,8#0755}]), + case os:type() of + {unix,_} -> + ok = subst_file(filename:join([DataDir, "start_client"]), + filename:join([Cli,"bin","start"]), + [{"ROOT",MasterDir}, + {"CLIENTARGS",ClientArgs}], + [{chmod,8#0755}]); + _ -> + ok + end, StartErlData = filename:join([MasterDir, "releases", "start_erl.data"]), CliRelDir = filename:join([Cli, "releases"]), @@ -1030,21 +1443,32 @@ delete_release(Conf) -> {ok, Dirs} = file:list_dir(PrivDir), ?t:format("======== deleting ~p~n",[Dirs]), - ok = delete_release_os(Dirs), - ?t:format("======== remaining ~p~n",[file:list_dir(PrivDir)]), + ok = delete_release_os(Dirs--["save"]), + {ok,Remaining} = file:list_dir(PrivDir), + ?t:format("======== remaining ~p~n",[Remaining]), + + case Remaining of + [] -> + ok; + _ -> + delete_release_os(Remaining), + Remaining2 = file:list_dir(PrivDir), + ?t:format("======== remaining after second try ~p~n",[Remaining2]) + end, + ok = file:set_cwd(OrigWd), ok. delete_release_os(Dirs) -> case os:type() of - {unix, _} -> - delete_release_unix(Dirs); - {win32, _} -> - delete_release_win32(Dirs); - Os -> - test_server:fail({error, {not_yet_implemented_os, Os}}) - end. + {unix, _} -> + delete_release_unix(Dirs); + {win32, _} -> + delete_release_win32(Dirs); + Os -> + test_server:fail({error, {not_yet_implemented_os, Os}}) + end. delete_release_unix([]) -> @@ -1075,7 +1499,14 @@ delete_release_win32([]) -> delete_release_win32(["save"|Dirs]) -> delete_release_win32(Dirs); delete_release_win32([Dir|Dirs]) -> - Rm = string:concat("rmdir /s ", Dir), + Rm = + case filelib:is_dir(Dir) of + true -> + string:concat("rmdir /s /q ", Dir); + false -> + string:concat("del /q ", Dir) + end, + ?t:format("============== COMMAND ~p~n",[Rm]), [] = os:cmd(Rm), delete_release_win32(Dirs). @@ -1200,7 +1631,12 @@ subst_var([], Vars, Result, VarAcc) -> priv_dir(Conf) -> - filename:absname(?config(priv_dir, Conf)). % Get rid of trailing slash +%% filename:absname(?config(priv_dir, Conf)). % Get rid of trailing slash + %% Due to problem with long paths on windows => creating a new + %% priv_dir under data_dir + Dir = filename:absname(filename:join(?config(data_dir, Conf),priv_dir)), + filelib:ensure_dir(filename:join(Dir,"*")), + Dir. latest_version(Dir) -> List = filelib:wildcard(Dir ++ "*"), @@ -1256,12 +1692,28 @@ do_create_p1g(Conf,TargetDir) -> ErtsLatest = latest_version(filename:join(code:root_dir(),"erts")), ok = copy_tree(Conf, ErtsLatest, ErtsDir, TargetDir), ErtsBinDir = filename:join([TargetDir,ErtsDir,bin]), - copy_file(filename:join([ErtsBinDir, "epmd"]), BinDir, [preserve]), - copy_file(filename:join([ErtsBinDir, "run_erl"]), BinDir, [preserve]), - copy_file(filename:join([ErtsBinDir, "to_erl"]), BinDir, [preserve]), + + case os:type() of + {unix, _} -> + copy_file(filename:join([ErtsBinDir, "epmd"]), BinDir, [preserve]), + copy_file(filename:join([ErtsBinDir, "run_erl"]), BinDir, [preserve]), + copy_file(filename:join([ErtsBinDir, "to_erl"]), BinDir, [preserve]), + + %% Create the start_erl shell script + ok = subst_file(filename:join([ErtsBinDir,"start_erl.src"]), + filename:join([BinDir,"start_erl"]), + [{"EMU","beam"}], + [{chmod,8#0755}]); + {win32,_} -> + %% Add a batch file to use as HEART_COMMAND + ok = copy_file(filename:join(DataDir, "heart_restart.bat"), + ErtsBinDir,[preserve]) + end, copy_file(filename:join(DataDir, "../installer.beam"), filename:join([DataDir,lib,"installer-1.0",ebin])), + copy_file(filename:join(DataDir, "../rh_test_lib.beam"), + filename:join([DataDir,lib,"installer-1.0",ebin])), %% Create .rel, .script and .boot files RelName = "rel0", @@ -1272,7 +1724,7 @@ do_create_p1g(Conf,TargetDir) -> ok = filelib:ensure_dir(RelFile), LibPath = filename:join([DataDir,lib,"*",ebin]), - TarFile = create_basic_release(RelFile, RelVsn, {ErtsVsn,false}, + TarFile = create_basic_release(Conf, RelFile, RelVsn, {ErtsVsn,false}, LibPath, [], [], [], []), %% Extract tar file in target directory (i.e. same directory as erts etc.) @@ -1286,20 +1738,6 @@ do_create_p1g(Conf,TargetDir) -> %% Create RELEASES ok = release_handler:create_RELEASES(TargetDir,ReleasesDir,RelFile,[]), - %% Create start_erl - ok = subst_file(filename:join([ErtsBinDir,"start_erl.src"]), - filename:join([BinDir,"start_erl"]), - [{"EMU","beam"}], - [{chmod,8#0755}]), - - %% Create start script - %% Using a customized start script from DataDir where some options - %% (heart and nodename) are added compared to the start.src in the - %% erlang distribution. - ok = subst_file(filename:join(DataDir, "start"), - filename:join([BinDir, "start"]), - [{"ROOT",TargetDir}], - [preserve]), ok. %% Create version P1H - which is P1G + a-1.0 @@ -1336,12 +1774,12 @@ create_upgrade_release(Conf,RelName,RelVsn,Erts,Apps,Config,{UpFromName,Descr}) UpFrom = [{filename:join([PrivDir,UpFromName,UpFromName]),Descr}], - create_basic_release(RelFile, RelVsn, Erts, LibPath, + create_basic_release(Conf, RelFile, RelVsn, Erts, LibPath, Apps, Config, UpFrom, []), ok. %% Create .rel, .script, .boot, sys.config and tar -create_basic_release(RelFile,RelVsn,{ErtsVsn,ErtsDir},LibPath,ExtraApps,Config,UpFrom,DownTo) -> +create_basic_release(Conf, RelFile,RelVsn,{ErtsVsn,ErtsDir},LibPath,ExtraApps,Config,UpFrom,DownTo) -> RelDir = filename:dirname(RelFile), RelFileName = filename:rootname(RelFile), @@ -1370,7 +1808,14 @@ create_basic_release(RelFile,RelVsn,{ErtsVsn,ErtsDir},LibPath,ExtraApps,Config,U _ -> [{erts,ErtsDir}] end]), - RelFileName ++ ".tar.gz". + TarFileName = RelFileName ++ ".tar.gz", + + case os:type() of + {win32,_} when ErtsDir=/=false -> modify_tar_win32(Conf, TarFileName); + _ -> ok + end, + + TarFileName. %% Create a .rel file create_installer_rel_file(RelFile,RelVsn,ErtsVsn,ExtraApps) -> @@ -1470,21 +1915,70 @@ permanent_p1h(Node) -> copy_installed(Conf,FromNode,ToNodes) -> PrivDir = priv_dir(Conf), DataDir = ?config(data_dir,Conf), + + %% Instead of using copy_tree on the complete node directory, I'm + %% splitting this in separate tar files per subdirectory so the + %% log directory can be completely skipped. The reason for this is + %% that the tar file might become faulty if the node is alive and + %% writing to the log while the tar is created. + FromDir = filename:join(PrivDir,FromNode), + {ok,FromDirNames} = file:list_dir(FromDir), + TempTarFiles = + [begin + TempTarFile = filename:join(PrivDir,"temp_" ++ FDN ++ ".tar"), + {ok,Tar} = erl_tar:open(TempTarFile,[write]), + ok = erl_tar:add(Tar,filename:join(FromDir,FDN),FDN,[]), + ok = erl_tar:close(Tar), + TempTarFile + end || FDN <- FromDirNames, FDN=/="log"], lists:foreach( fun(Node) -> - ok = copy_tree(Conf,filename:join(PrivDir,FromNode),Node,PrivDir), NodeDir = filename:join(PrivDir,Node), - ok = subst_file(filename:join(DataDir, "start"), - filename:join([NodeDir, "bin", "start"]), - [{"ROOT",NodeDir}]), - LogDir = filename:join(NodeDir,log), - {ok,Logs} = file:list_dir(LogDir), - lists:foreach(fun(Log) -> - file:delete(filename:join(LogDir,Log)) - end, - Logs) + ok = filelib:ensure_dir(filename:join([NodeDir,"log","*"])), + lists:foreach( + fun(TempTarFile) -> + ok = erl_tar:extract(TempTarFile,[{cwd,NodeDir}]) + end, TempTarFiles), + case os:type() of + {unix,_} -> + %% Create start script + %% Using a customized start script from DataDir + %% where some options (heart and nodename) are + %% added compared to the start.src in the erlang + %% distribution. + ok = subst_file(filename:join(DataDir, "start"), + filename:join([NodeDir, "bin", "start"]), + [{"ROOT",NodeDir}], + [preserve]); + {win32,_} -> + %% Write erl.ini + ErtsDirs = + filelib:wildcard(filename:join(NodeDir,"erts-*")), + lists:foreach( + fun(ErtsDir) -> + ok = subst_file( + filename:join(DataDir, "erl.ini.src"), + filename:join([ErtsDir, "bin", "erl.ini"]), + [{"ROOTDIR",NodeDir}, + {"BINDIR",filename:join(ErtsDir,"bin")}]) + end, + ErtsDirs), + + %% The service on windows runs as local + %% administrator (not otptest user), so we need + %% to chmod the release in order to allow the + %% executing node to install releases, write + %% logs etc. + chmod_release_win32(NodeDir) + end end, - ToNodes). + ToNodes), + + lists:foreach(fun(TempTarFile) -> file:delete(TempTarFile) end, TempTarFiles), + ok. + +chmod_release_win32(Dir) -> + os:cmd("echo y|cacls " ++ Dir ++ " /T /E /G Administrators:F"). start_nodes(Conf,Snames,Tag) -> PrivDir = priv_dir(Conf), @@ -1493,19 +1987,42 @@ start_nodes(Conf,Snames,Tag) -> fun(Sname) -> NodeDir = filename:join(PrivDir,Sname), Node = node_name(Sname), - - Script = filename:join([NodeDir,"bin","start"]), - Cmd = "env NODENAME="++atom_to_list(Sname) ++ " " ++ Script, - %% {ok,StartFile} = file:read_file(Cmd), - %% io:format("~s:\n~s~n~n",[Start,binary_to_list(StartFile)]), - Res = os:cmd(Cmd), - io:format("Start ~p: ~p~n=>\t~p~n", [Sname,Cmd,Res]), + + case os:type() of + {unix,_} -> + start_node_unix(Sname,NodeDir); + {win32,_} -> + start_node_win32(Sname,NodeDir) + end, Node end, Snames), wait_nodes_up(Nodes,Tag), Nodes. +start_node_unix(Sname,NodeDir) -> + Script = filename:join([NodeDir,"bin","start"]), + Cmd = "env NODENAME="++atom_to_list(Sname) ++ " " ++ Script, + %% {ok,StartFile} = file:read_file(Cmd), + %% io:format("~s:\n~s~n~n",[Start,binary_to_list(StartFile)]), + Res = os:cmd(Cmd), + io:format("Start ~p: ~p~n=>\t~p~n", [Sname,Cmd,Res]). + +start_node_win32(Sname,NodeDir) -> + Name = atom_to_list(Sname) ++ "_P1G", + ErtsBinDir = filename:join(NodeDir,"erts-4.4/bin"), + + StartErlArgs = rh_test_lib:get_start_erl_args(NodeDir), + ServiceArgs = rh_test_lib:get_service_args(NodeDir, Sname, StartErlArgs), + + Erlsrv = filename:nativename(filename:join(ErtsBinDir,"erlsrv")), + rh_test_lib:erlsrv(Erlsrv,stop,Name), + rh_test_lib:erlsrv(Erlsrv,remove,Name), + ok = rh_test_lib:erlsrv(Erlsrv,add,Name,ServiceArgs), + ok = rh_test_lib:erlsrv(Erlsrv,start,Name), + ok. + +%% Create a unique node name for each test case tc_sname(Config) -> tc_sname(Config,""). tc_sname(Config,Fix) when is_atom(Fix) -> @@ -1607,9 +2124,8 @@ create_fake_upgrade_release(Dir,RelVsn,AppDirs,{UpFrom,DownTo,ExtraLibs}) -> %% And a relup file so it can be upgraded to RelupPath = Paths ++ [filename:join([Lib,"*","ebin"]) || Lib <- ExtraLibs], - ok = systools:make_relup(Rel,[UpFrom],[DownTo], - [{path,RelupPath}, - {outdir,RelDir}]), + ok = systools:make_relup(Rel,UpFrom,DownTo,[{path,RelupPath}, + {outdir,RelDir}]), Rel. @@ -1649,3 +2165,32 @@ create_fake_release(Dir,RelName,RelVsn,AppDirs) -> rpc_inst(Node,Func,Args) -> rpc:call(Node,installer,Func,[node()|Args]). + +delete_all_services() -> + ErlSrv = erlsrv:erlsrv(erlang:system_info(version)), + [_|Serviceinfo] = string:tokens(os:cmd(ErlSrv ++ " list"),"\n"), + Services = + [lists:takewhile(fun($\t) -> false; (_) -> true end,S) + || S <- Serviceinfo], + ?t:format("Services to remove: ~p~n",[Services]), + lists:foreach(fun(S) -> + rh_test_lib:erlsrv(ErlSrv,stop,S), + rh_test_lib:erlsrv(ErlSrv,remove,S) + end, + Services). + +modify_tar_win32(Conf, TarFileName) -> + DataDir = ?config(data_dir,Conf), + PrivDir = priv_dir(Conf), + TmpDir = filename:join(PrivDir,"tmp_modify_tar_win32"), + ok = erl_tar:extract(TarFileName,[{cwd,TmpDir},compressed]), + + ErtsBinDir = filelib:wildcard(filename:join([TmpDir,"erts-*","bin"])), + ok = copy_file(filename:join(DataDir, "heart_restart.bat"), + ErtsBinDir,[preserve]), + + {ok,Fs} = file:list_dir(TmpDir), + {ok,T} = erl_tar:open(TarFileName,[write,compressed]), + [ok = erl_tar:add(T,filename:join(TmpDir,F),F,[]) || F <- Fs], + ok = erl_tar:close(T), + ok. diff --git a/lib/sasl/test/release_handler_SUITE_data/Makefile.src b/lib/sasl/test/release_handler_SUITE_data/Makefile.src index 85e25fdc2f..9b07e7ce0a 100644 --- a/lib/sasl/test/release_handler_SUITE_data/Makefile.src +++ b/lib/sasl/test/release_handler_SUITE_data/Makefile.src @@ -1,14 +1,42 @@ EFLAGS=+debug_info P2B= \ - P2B/a-2.0/ebin/a.beam \ - P2B/a-2.0/ebin/a_sup.beam + P2B/a-2.0/ebin/a.@EMULATOR@ \ + P2B/a-2.0/ebin/a_sup.@EMULATOR@ LIB= \ - lib/a-1.1/ebin/a.beam \ - lib/a-1.1/ebin/a_sup.beam \ - lib/a-1.0/ebin/a.beam \ - lib/a-1.0/ebin/a_sup.beam \ + lib/a-1.2/ebin/a.@EMULATOR@ \ + lib/a-1.2/ebin/a_sup.@EMULATOR@ \ + lib/a-1.1/ebin/a.@EMULATOR@ \ + lib/a-1.1/ebin/a_sup.@EMULATOR@ \ + lib/a-1.0/ebin/a.@EMULATOR@ \ + lib/a-1.0/ebin/a_sup.@EMULATOR@ \ + lib/b-1.0/ebin/b_server.@EMULATOR@ \ + lib/b-1.0/ebin/b_lib.@EMULATOR@ \ + lib/b-2.0/ebin/b_server.@EMULATOR@ \ + lib/many_mods-1.0/ebin/m.@EMULATOR@ \ + lib/many_mods-1.0/ebin/m1.@EMULATOR@ \ + lib/many_mods-1.0/ebin/m2.@EMULATOR@ \ + lib/many_mods-1.0/ebin/m3.@EMULATOR@ \ + lib/many_mods-1.0/ebin/m4.@EMULATOR@ \ + lib/many_mods-1.0/ebin/m5.@EMULATOR@ \ + lib/many_mods-1.0/ebin/m6.@EMULATOR@ \ + lib/many_mods-1.0/ebin/m7.@EMULATOR@ \ + lib/many_mods-1.0/ebin/m8.@EMULATOR@ \ + lib/many_mods-1.0/ebin/m9.@EMULATOR@ \ + lib/many_mods-1.0/ebin/m10.@EMULATOR@ \ + lib/many_mods-1.1/ebin/m.@EMULATOR@ \ + lib/many_mods-1.1/ebin/m1.@EMULATOR@ \ + lib/many_mods-1.1/ebin/m2.@EMULATOR@ \ + lib/many_mods-1.1/ebin/m3.@EMULATOR@ \ + lib/many_mods-1.1/ebin/m4.@EMULATOR@ \ + lib/many_mods-1.1/ebin/m5.@EMULATOR@ \ + lib/many_mods-1.1/ebin/m6.@EMULATOR@ \ + lib/many_mods-1.1/ebin/m7.@EMULATOR@ \ + lib/many_mods-1.1/ebin/m8.@EMULATOR@ \ + lib/many_mods-1.1/ebin/m9.@EMULATOR@ \ + lib/many_mods-1.1/ebin/m10.@EMULATOR@ \ + lib/many_mods-2.0/ebin/m.@EMULATOR@ APP= \ app1_app2/lib1/app1-1.0/ebin/app1_sup.@EMULATOR@ \ @@ -57,6 +85,67 @@ lib/a-1.1/ebin/a_sup.@EMULATOR@: lib/a-1.1/src/a_sup.erl erlc $(EFLAGS) -olib/a-1.1/ebin lib/a-1.1/src/a_sup.erl +lib/a-1.2/ebin/a.@EMULATOR@: lib/a-1.2/src/a.erl + erlc $(EFLAGS) -olib/a-1.2/ebin lib/a-1.2/src/a.erl +lib/a-1.2/ebin/a_sup.@EMULATOR@: lib/a-1.2/src/a_sup.erl + erlc $(EFLAGS) -olib/a-1.2/ebin lib/a-1.2/src/a_sup.erl + +lib/b-1.0/ebin/b_server.@EMULATOR@: lib/b-1.0/src/b_server.erl + erlc $(EFLAGS) -olib/b-1.0/ebin lib/b-1.0/src/b_server.erl +lib/b-1.0/ebin/b_lib.@EMULATOR@: lib/b-1.0/src/b_lib.erl + erlc $(EFLAGS) -olib/b-1.0/ebin lib/b-1.0/src/b_lib.erl + +lib/b-2.0/ebin/b_server.@EMULATOR@: lib/b-2.0/src/b_server.erl + erlc $(EFLAGS) -olib/b-2.0/ebin lib/b-2.0/src/b_server.erl + +lib/many_mods-1.0/ebin/m.@EMULATOR@: lib/many_mods-1.0/src/m.erl + erlc $(EFLAGS) -olib/many_mods-1.0/ebin lib/many_mods-1.0/src/m.erl +lib/many_mods-1.0/ebin/m1.@EMULATOR@: lib/many_mods-1.0/src/m1.erl + erlc $(EFLAGS) -olib/many_mods-1.0/ebin lib/many_mods-1.0/src/m1.erl +lib/many_mods-1.0/ebin/m2.@EMULATOR@: lib/many_mods-1.0/src/m2.erl + erlc $(EFLAGS) -olib/many_mods-1.0/ebin lib/many_mods-1.0/src/m2.erl +lib/many_mods-1.0/ebin/m3.@EMULATOR@: lib/many_mods-1.0/src/m3.erl + erlc $(EFLAGS) -olib/many_mods-1.0/ebin lib/many_mods-1.0/src/m3.erl +lib/many_mods-1.0/ebin/m4.@EMULATOR@: lib/many_mods-1.0/src/m4.erl + erlc $(EFLAGS) -olib/many_mods-1.0/ebin lib/many_mods-1.0/src/m4.erl +lib/many_mods-1.0/ebin/m5.@EMULATOR@: lib/many_mods-1.0/src/m5.erl + erlc $(EFLAGS) -olib/many_mods-1.0/ebin lib/many_mods-1.0/src/m5.erl +lib/many_mods-1.0/ebin/m6.@EMULATOR@: lib/many_mods-1.0/src/m6.erl + erlc $(EFLAGS) -olib/many_mods-1.0/ebin lib/many_mods-1.0/src/m6.erl +lib/many_mods-1.0/ebin/m7.@EMULATOR@: lib/many_mods-1.0/src/m7.erl + erlc $(EFLAGS) -olib/many_mods-1.0/ebin lib/many_mods-1.0/src/m7.erl +lib/many_mods-1.0/ebin/m8.@EMULATOR@: lib/many_mods-1.0/src/m8.erl + erlc $(EFLAGS) -olib/many_mods-1.0/ebin lib/many_mods-1.0/src/m8.erl +lib/many_mods-1.0/ebin/m9.@EMULATOR@: lib/many_mods-1.0/src/m9.erl + erlc $(EFLAGS) -olib/many_mods-1.0/ebin lib/many_mods-1.0/src/m9.erl +lib/many_mods-1.0/ebin/m10.@EMULATOR@: lib/many_mods-1.0/src/m10.erl + erlc $(EFLAGS) -olib/many_mods-1.0/ebin lib/many_mods-1.0/src/m10.erl +lib/many_mods-1.1/ebin/m.@EMULATOR@: lib/many_mods-1.1/src/m.erl + erlc $(EFLAGS) -olib/many_mods-1.1/ebin lib/many_mods-1.1/src/m.erl +lib/many_mods-1.1/ebin/m1.@EMULATOR@: lib/many_mods-1.1/src/m1.erl + erlc $(EFLAGS) -olib/many_mods-1.1/ebin lib/many_mods-1.1/src/m1.erl +lib/many_mods-1.1/ebin/m2.@EMULATOR@: lib/many_mods-1.1/src/m2.erl + erlc $(EFLAGS) -olib/many_mods-1.1/ebin lib/many_mods-1.1/src/m2.erl +lib/many_mods-1.1/ebin/m3.@EMULATOR@: lib/many_mods-1.1/src/m3.erl + erlc $(EFLAGS) -olib/many_mods-1.1/ebin lib/many_mods-1.1/src/m3.erl +lib/many_mods-1.1/ebin/m4.@EMULATOR@: lib/many_mods-1.1/src/m4.erl + erlc $(EFLAGS) -olib/many_mods-1.1/ebin lib/many_mods-1.1/src/m4.erl +lib/many_mods-1.1/ebin/m5.@EMULATOR@: lib/many_mods-1.1/src/m5.erl + erlc $(EFLAGS) -olib/many_mods-1.1/ebin lib/many_mods-1.1/src/m5.erl +lib/many_mods-1.1/ebin/m6.@EMULATOR@: lib/many_mods-1.1/src/m6.erl + erlc $(EFLAGS) -olib/many_mods-1.1/ebin lib/many_mods-1.1/src/m6.erl +lib/many_mods-1.1/ebin/m7.@EMULATOR@: lib/many_mods-1.1/src/m7.erl + erlc $(EFLAGS) -olib/many_mods-1.1/ebin lib/many_mods-1.1/src/m7.erl +lib/many_mods-1.1/ebin/m8.@EMULATOR@: lib/many_mods-1.1/src/m8.erl + erlc $(EFLAGS) -olib/many_mods-1.1/ebin lib/many_mods-1.1/src/m8.erl +lib/many_mods-1.1/ebin/m9.@EMULATOR@: lib/many_mods-1.1/src/m9.erl + erlc $(EFLAGS) -olib/many_mods-1.1/ebin lib/many_mods-1.1/src/m9.erl +lib/many_mods-1.1/ebin/m10.@EMULATOR@: lib/many_mods-1.1/src/m10.erl + erlc $(EFLAGS) -olib/many_mods-1.1/ebin lib/many_mods-1.1/src/m10.erl +lib/many_mods-2.0/ebin/m.@EMULATOR@: lib/many_mods-2.0/src/m.erl + erlc $(EFLAGS) -olib/many_mods-2.0/ebin lib/many_mods-2.0/src/m.erl + + app1_app2/lib1/app1-1.0/ebin/app1_sup.@EMULATOR@: app1_app2/lib1/app1-1.0/src/app1_sup.erl erlc $(EFLAGS) -oapp1_app2/lib1/app1-1.0/ebin app1_app2/lib1/app1-1.0/src/app1_sup.erl app1_app2/lib1/app1-1.0/ebin/app1_server.@EMULATOR@: app1_app2/lib1/app1-1.0/src/app1_server.erl diff --git a/lib/sasl/test/release_handler_SUITE_data/clients/start_cli1 b/lib/sasl/test/release_handler_SUITE_data/clients/start_cli1 deleted file mode 100755 index ee3d8c97cf..0000000000 --- a/lib/sasl/test/release_handler_SUITE_data/clients/start_cli1 +++ /dev/null @@ -1,38 +0,0 @@ -#!/bin/sh -# -# This program invokes the erlang emulator by calling run_erl. -# It should only be used at an embedded target system. -# It should be modified to give the correct flags to erl (via start_erl), -# e.g -mode embedded -sname XXX -# -# Usage: start [Data] -# - -if [ "x${NODENAME}" = "x" ] -then - echo "ERROR: Variable \$NODENAME is not set!!" - exit 1 -fi - -TESTHOST=`hostname | sed 's/[.].*//'` -IPADDR=%IPADDR% - -ROOTDIR=%ROOT% -CLIENTDIR=$ROOTDIR/clients/type1/$NODENAME@$TESTHOST - -RELDIR=$CLIENTDIR/releases - -# Note that this scripts is modified an copied to $CLIENTDIR/bin/start -# in release_handler_SUITE:copy_client - therefore HEART_COMMAND is as follows: -HEART_COMMAND=$CLIENTDIR/bin/start -HW_WD_DISABLE=true -export HW_WD_DISABLE HEART_COMMAND - -START_ERL_DATA=${1:-$RELDIR/start_erl.data} - -if [ ! -d /tmp/$NODENAME@$TESTHOST ] -then - mkdir /tmp/$NODENAME@$TESTHOST -fi - -$ROOTDIR/bin/run_erl /tmp/$NODENAME@$TESTHOST/ $CLIENTDIR/log "exec $ROOTDIR/bin/start_erl $ROOTDIR $RELDIR $START_ERL_DATA -heart -sname $NODENAME -sasl start_prg \\\"$CLIENTDIR/bin/start\\\" masters \[\\'%MASTER%@$TESTHOST\\'\] client_directory \\\"$CLIENTDIR\\\" -loader inet -id $NODENAME -hosts $IPADDR" > $CLIENTDIR/log/run_erl.out 2>&1 & diff --git a/lib/sasl/test/release_handler_SUITE_data/erl.ini.src b/lib/sasl/test/release_handler_SUITE_data/erl.ini.src new file mode 100644 index 0000000000..b8791e75a5 --- /dev/null +++ b/lib/sasl/test/release_handler_SUITE_data/erl.ini.src @@ -0,0 +1,4 @@ +[erlang] +Bindir=%BINDIR% +Progname=erl +Rootdir=%ROOTDIR% diff --git a/lib/sasl/test/release_handler_SUITE_data/heart_restart.bat b/lib/sasl/test/release_handler_SUITE_data/heart_restart.bat new file mode 100755 index 0000000000..ede1ad4ff3 --- /dev/null +++ b/lib/sasl/test/release_handler_SUITE_data/heart_restart.bat @@ -0,0 +1,3 @@ +@echo off +%ERLSRV_EXECUTABLE% stop %ERLSRV_SERVICE_NAME% +%ERLSRV_EXECUTABLE% start %ERLSRV_SERVICE_NAME%
\ No newline at end of file diff --git a/lib/sasl/test/release_handler_SUITE_data/lib/README b/lib/sasl/test/release_handler_SUITE_data/lib/README new file mode 100644 index 0000000000..639a4ca0fb --- /dev/null +++ b/lib/sasl/test/release_handler_SUITE_data/lib/README @@ -0,0 +1,33 @@ +a-1.0: +start version + +a-1.1: +can be upgraded to from a-1.0. Module a has changed + +a-1.2: +can be upgraded to from a-1.1. +No module have changed, but priv dir is added including one 'file' + +b-1.0: +start version, includes b_lib and b_server + +b-2.0: +can be upgraded to from b-1.0. +Removes b_lib (soft_purge) and updates b_server (brutal_purge) +* The diff in purge method is important for test "check_and_purge", in + order to check that the purge option to check_install_release works + for both methods. + +many_mods-1.0: +start version. +m:start/1 starts N procs, each calling Mod:bar() in all other modules (m1-m10). +m1-m10: implements bar() which returns a big constant. +The point is to get many processes with references to many modules, +and then load the modules again so that old code exists. See tests +otp_9395_update_many_mods and otp_9395_rm_many_mods. + +many_mods-1.1: +can be upgraded to from many_mods-1.0. Updates modules m1-m10. + +many_mods-2.0: +can be upgraded to from many_mods-1.0. Removes modules m1-m10.
\ No newline at end of file diff --git a/lib/sasl/test/release_handler_SUITE_data/lib/a-1.0/src/a.app b/lib/sasl/test/release_handler_SUITE_data/lib/a-1.2/ebin/a.app index e938137f67..b38722f06d 100644 --- a/lib/sasl/test/release_handler_SUITE_data/lib/a-1.0/src/a.app +++ b/lib/sasl/test/release_handler_SUITE_data/lib/a-1.2/ebin/a.app @@ -1,7 +1,7 @@ {application, a, [{description, "A CXC 138 11"}, - {vsn, "1.0"}, - {modules, [{a, 1}, {a_sup,1}]}, + {vsn, "1.2"}, + {modules, [{a, 2}, {a_sup,1}]}, {registered, [a_sup]}, {applications, [kernel, stdlib]}, {env, [{key1, val1}]}, diff --git a/lib/sasl/test/release_handler_SUITE_data/lib/a-1.2/ebin/a.appup b/lib/sasl/test/release_handler_SUITE_data/lib/a-1.2/ebin/a.appup new file mode 100644 index 0000000000..3df0546316 --- /dev/null +++ b/lib/sasl/test/release_handler_SUITE_data/lib/a-1.2/ebin/a.appup @@ -0,0 +1,3 @@ +{"1.2", + [{"1.1",[]}], + [{"1.1",[]}]}. diff --git a/lib/sasl/test/release_handler_SUITE_data/lib/a-1.2/priv/file b/lib/sasl/test/release_handler_SUITE_data/lib/a-1.2/priv/file new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/sasl/test/release_handler_SUITE_data/lib/a-1.2/priv/file diff --git a/lib/sasl/test/release_handler_SUITE_data/lib/a-1.2/src/a.erl b/lib/sasl/test/release_handler_SUITE_data/lib/a-1.2/src/a.erl new file mode 100644 index 0000000000..c082ad5339 --- /dev/null +++ b/lib/sasl/test/release_handler_SUITE_data/lib/a-1.2/src/a.erl @@ -0,0 +1,54 @@ +%% ``The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved via the world wide web at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% The Initial Developer of the Original Code is Ericsson Utvecklings AB. +%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings +%% AB. All Rights Reserved.'' +%% +%% $Id$ +%% +-module(a). + + +-behaviour(gen_server). + +%% External exports +-export([start_link/0, a/0, b/0]). +%% Internal exports +-export([init/1, handle_call/3, handle_info/2, terminate/2, code_change/3]). + +start_link() -> gen_server:start_link({local, aa}, a, [], []). + +a() -> gen_server:call(aa, a). +b() -> gen_server:call(aa, b). + +%%----------------------------------------------------------------- +%% Callback functions from gen_server +%%----------------------------------------------------------------- +init([]) -> + process_flag(trap_exit, true), + {ok, {state, bval}}. + +handle_call(a, _From, State) -> + X = application:get_all_env(a), + {reply, X, State}; + +handle_call(b, _From, State) -> + {reply, {ok, element(2, State)}, State}. + +handle_info(_, State) -> + {noreply, State}. + +terminate(_Reason, _State) -> + ok. + +code_change(1, Extra, State) -> + {ok, {state, bval}}. diff --git a/lib/sasl/test/release_handler_SUITE_data/lib/a-1.2/src/a_sup.erl b/lib/sasl/test/release_handler_SUITE_data/lib/a-1.2/src/a_sup.erl new file mode 100644 index 0000000000..a141c1767b --- /dev/null +++ b/lib/sasl/test/release_handler_SUITE_data/lib/a-1.2/src/a_sup.erl @@ -0,0 +1,37 @@ +%% ``The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved via the world wide web at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% The Initial Developer of the Original Code is Ericsson Utvecklings AB. +%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings +%% AB. All Rights Reserved.'' +%% +%% $Id$ +%% +-module(a_sup). + + +-behaviour(supervisor). + +%% External exports +-export([start/2]). + +%% Internal exports +-export([init/1]). + +start(_, _) -> + supervisor:start_link({local, a_sup}, a_sup, []). + +init([]) -> + SupFlags = {one_for_one, 4, 3600}, + Config = {a, + {a, start_link, []}, + permanent, 2000, worker, [a]}, + {ok, {SupFlags, [Config]}}. diff --git a/lib/sasl/test/release_handler_SUITE_data/lib/b-1.0/ebin/b.app b/lib/sasl/test/release_handler_SUITE_data/lib/b-1.0/ebin/b.app new file mode 100644 index 0000000000..00347b2754 --- /dev/null +++ b/lib/sasl/test/release_handler_SUITE_data/lib/b-1.0/ebin/b.app @@ -0,0 +1,7 @@ +%% -*- erlang -*- +{application, b, + [{description, "B CXC 138 12"}, + {vsn, "1.0"}, + {modules, [{b_server, 1},{b_lib, 1}]}, + {registered, [b_server]}, + {applications, [kernel, stdlib]}]}. diff --git a/lib/sasl/test/release_handler_SUITE_data/lib/b-1.0/src/b_lib.erl b/lib/sasl/test/release_handler_SUITE_data/lib/b-1.0/src/b_lib.erl new file mode 100644 index 0000000000..7e8a308a5e --- /dev/null +++ b/lib/sasl/test/release_handler_SUITE_data/lib/b-1.0/src/b_lib.erl @@ -0,0 +1,3 @@ +-module(b_lib). +-compile(export_all). +foo() -> ok. diff --git a/lib/sasl/test/release_handler_SUITE_data/lib/b-1.0/src/b_server.erl b/lib/sasl/test/release_handler_SUITE_data/lib/b-1.0/src/b_server.erl new file mode 100644 index 0000000000..e1a80a076f --- /dev/null +++ b/lib/sasl/test/release_handler_SUITE_data/lib/b-1.0/src/b_server.erl @@ -0,0 +1,37 @@ +-module(b_server). + +-behaviour(gen_server). + +%% API +-export([start_link/0]). + +%% gen_server callbacks +-export([init/1, handle_call/3, handle_cast/2, handle_info/2, + terminate/2, code_change/3]). + +-define(SERVER, ?MODULE). + +-record(state, {}). + +start_link() -> + gen_server:start_link({local, ?SERVER}, ?MODULE, [], []). + +init([]) -> + {ok, #state{}}. + +handle_call(_Request, _From, State) -> + Reply = ok, + {reply, Reply, State}. + +handle_cast(_Msg, State) -> + {noreply, State}. + +handle_info(_Info, State) -> + {noreply, State}. + +terminate(_Reason, _State) -> + ok. + +code_change(OldVsn, State, Extra) -> + file:write_file("/tmp/b_server",io_lib:format("~p~n",[{"1.0",OldVsn,Extra}])), + {ok, State}. diff --git a/lib/sasl/test/release_handler_SUITE_data/lib/b-2.0/ebin/b.app b/lib/sasl/test/release_handler_SUITE_data/lib/b-2.0/ebin/b.app new file mode 100644 index 0000000000..73c8e42b32 --- /dev/null +++ b/lib/sasl/test/release_handler_SUITE_data/lib/b-2.0/ebin/b.app @@ -0,0 +1,7 @@ +%% -*- erlang -*- +{application, b, + [{description, "B CXC 138 12"}, + {vsn, "2.0"}, + {modules, [{b_server, 1}]}, + {registered, [b_server]}, + {applications, [kernel, stdlib]}]}. diff --git a/lib/sasl/test/release_handler_SUITE_data/lib/b-2.0/ebin/b.appup b/lib/sasl/test/release_handler_SUITE_data/lib/b-2.0/ebin/b.appup new file mode 100644 index 0000000000..001255a88c --- /dev/null +++ b/lib/sasl/test/release_handler_SUITE_data/lib/b-2.0/ebin/b.appup @@ -0,0 +1,6 @@ +%% -*- erlang -*- +{"2.0", + [{"1.0",[{remove_module,b_lib,soft_purge,soft_purge,[]}, + {update,b_server,{advanced,[]}}]}], + [{"1.0",[{add_module,b_lib}, + {update,b_server,{advanced,[]}}]}]}. diff --git a/lib/sasl/test/release_handler_SUITE_data/lib/b-2.0/src/b_lib.erl b/lib/sasl/test/release_handler_SUITE_data/lib/b-2.0/src/b_lib.erl new file mode 100644 index 0000000000..7e8a308a5e --- /dev/null +++ b/lib/sasl/test/release_handler_SUITE_data/lib/b-2.0/src/b_lib.erl @@ -0,0 +1,3 @@ +-module(b_lib). +-compile(export_all). +foo() -> ok. diff --git a/lib/sasl/test/release_handler_SUITE_data/lib/b-2.0/src/b_server.erl b/lib/sasl/test/release_handler_SUITE_data/lib/b-2.0/src/b_server.erl new file mode 100644 index 0000000000..f8bfbdaff7 --- /dev/null +++ b/lib/sasl/test/release_handler_SUITE_data/lib/b-2.0/src/b_server.erl @@ -0,0 +1,37 @@ +-module(b_server). + +-behaviour(gen_server). + +%% API +-export([start_link/0]). + +%% gen_server callbacks +-export([init/1, handle_call/3, handle_cast/2, handle_info/2, + terminate/2, code_change/3]). + +-define(SERVER, ?MODULE). + +-record(state, {}). + +start_link() -> + gen_server:start_link({local, ?SERVER}, ?MODULE, [], []). + +init([]) -> + {ok, #state{}}. + +handle_call(_Request, _From, State) -> + Reply = ok, + {reply, Reply, State}. + +handle_cast(_Msg, State) -> + {noreply, State}. + +handle_info(_Info, State) -> + {noreply, State}. + +terminate(_Reason, _State) -> + ok. + +code_change(OldVsn, State, Extra) -> + file:write_file("/tmp/b_server",io_lib:format("~p~n",[{"2.0",OldVsn,Extra}])), + {ok, State}. diff --git a/lib/sasl/test/release_handler_SUITE_data/lib/installer-1.0/ebin/installer.app b/lib/sasl/test/release_handler_SUITE_data/lib/installer-1.0/ebin/installer.app index 6f77317f6a..e1391c0605 100644 --- a/lib/sasl/test/release_handler_SUITE_data/lib/installer-1.0/ebin/installer.app +++ b/lib/sasl/test/release_handler_SUITE_data/lib/installer-1.0/ebin/installer.app @@ -1,6 +1,6 @@ {application, installer, [{description, "Installer application"}, {vsn, "1.0"}, - {modules, [{installer, 1}]}, + {modules, [installer,rh_test_lib]}, {registered, []}, {applications, [kernel, stdlib, sasl]}]}. diff --git a/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.0/ebin/many_mods.app b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.0/ebin/many_mods.app new file mode 100644 index 0000000000..aa39adfffa --- /dev/null +++ b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.0/ebin/many_mods.app @@ -0,0 +1,17 @@ +%% -*- erlang -*- +{application, many_mods, + [{description, "Application with many modules CXC 138 11"}, + {vsn, "1.0"}, + {modules, [{m, 1}, + {m1,1}, + {m2,1}, + {m3,1}, + {m4,1}, + {m5,1}, + {m6,1}, + {m7,1}, + {m8,1}, + {m9,1}, + {m10,1}]}, + {registered, []}, + {applications, [kernel, stdlib]}]}. diff --git a/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.0/src/m.erl b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.0/src/m.erl new file mode 100644 index 0000000000..418102bebb --- /dev/null +++ b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.0/src/m.erl @@ -0,0 +1,11 @@ +-module(m). +-compile(export_all). + +start(NProcs) -> + Modules = [m1,m2,m3,m4,m5,m6,m7,m8,m9,m10], + Pids = [spawn_link(fun() -> + Cs = [M:bar() || M <- Modules], + receive stop -> Cs end + end) || + _ <- lists:seq(1,NProcs)], + {Modules,Pids}. diff --git a/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.0/src/m1.erl b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.0/src/m1.erl new file mode 100644 index 0000000000..cacc13f5d7 --- /dev/null +++ b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.0/src/m1.erl @@ -0,0 +1,4 @@ +-module(m1). +-compile(export_all). +%% A module with a big constant... +bar() -> {now(),[{1,'1',"1"},{2,'2',"2"},{3,'3',"3"},{4,'4',"4"},{5,'5',"5"},{6,'6',"6"},{7,'7',"7"},{8,'8',"8"},{9,'9',"9"},{10,'10',"10"},{11,'11',"11"},{12,'12',"12"},{13,'13',"13"},{14,'14',"14"},{15,'15',"15"},{16,'16',"16"},{17,'17',"17"},{18,'18',"18"},{19,'19',"19"},{20,'20',"20"},{21,'21',"21"},{22,'22',"22"},{23,'23',"23"},{24,'24',"24"},{25,'25',"25"},{26,'26',"26"},{27,'27',"27"},{28,'28',"28"},{29,'29',"29"},{30,'30',"30"},{31,'31',"31"},{32,'32',"32"},{33,'33',"33"},{34,'34',"34"},{35,'35',"35"},{36,'36',"36"},{37,'37',"37"},{38,'38',"38"},{39,'39',"39"},{40,'40',"40"},{41,'41',"41"},{42,'42',"42"},{43,'43',"43"},{44,'44',"44"},{45,'45',"45"},{46,'46',"46"},{47,'47',"47"},{48,'48',"48"},{49,'49',"49"},{50,'50',"50"},{51,'51',"51"},{52,'52',"52"},{53,'53',"53"},{54,'54',"54"},{55,'55',"55"},{56,'56',"56"},{57,'57',"57"},{58,'58',"58"},{59,'59',"59"},{60,'60',"60"},{61,'61',"61"},{62,'62',"62"},{63,'63',"63"},{64,'64',"64"},{65,'65',"65"},{66,'66',"66"},{67,'67',"67"},{68,'68',"68"},{69,'69',"69"},{70,'70',"70"},{71,'71',"71"},{72,'72',"72"},{73,'73',"73"},{74,'74',"74"},{75,'75',"75"},{76,'76',"76"},{77,'77',"77"},{78,'78',"78"},{79,'79',"79"},{80,'80',"80"},{81,'81',"81"},{82,'82',"82"},{83,'83',"83"},{84,'84',"84"},{85,'85',"85"},{86,'86',"86"},{87,'87',"87"},{88,'88',"88"},{89,'89',"89"},{90,'90',"90"},{91,'91',"91"},{92,'92',"92"},{93,'93',"93"},{94,'94',"94"},{95,'95',"95"},{96,'96',"96"},{97,'97',"97"},{98,'98',"98"},{99,'99',"99"},{100,'100',"100"}]}. diff --git a/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.0/src/m10.erl b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.0/src/m10.erl new file mode 100644 index 0000000000..81e120b891 --- /dev/null +++ b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.0/src/m10.erl @@ -0,0 +1,4 @@ +-module(m10). +-compile(export_all). +%% A module with a big constant... +bar() -> {now(),[{1,'1',"1"},{2,'2',"2"},{3,'3',"3"},{4,'4',"4"},{5,'5',"5"},{6,'6',"6"},{7,'7',"7"},{8,'8',"8"},{9,'9',"9"},{10,'10',"10"},{11,'11',"11"},{12,'12',"12"},{13,'13',"13"},{14,'14',"14"},{15,'15',"15"},{16,'16',"16"},{17,'17',"17"},{18,'18',"18"},{19,'19',"19"},{20,'20',"20"},{21,'21',"21"},{22,'22',"22"},{23,'23',"23"},{24,'24',"24"},{25,'25',"25"},{26,'26',"26"},{27,'27',"27"},{28,'28',"28"},{29,'29',"29"},{30,'30',"30"},{31,'31',"31"},{32,'32',"32"},{33,'33',"33"},{34,'34',"34"},{35,'35',"35"},{36,'36',"36"},{37,'37',"37"},{38,'38',"38"},{39,'39',"39"},{40,'40',"40"},{41,'41',"41"},{42,'42',"42"},{43,'43',"43"},{44,'44',"44"},{45,'45',"45"},{46,'46',"46"},{47,'47',"47"},{48,'48',"48"},{49,'49',"49"},{50,'50',"50"},{51,'51',"51"},{52,'52',"52"},{53,'53',"53"},{54,'54',"54"},{55,'55',"55"},{56,'56',"56"},{57,'57',"57"},{58,'58',"58"},{59,'59',"59"},{60,'60',"60"},{61,'61',"61"},{62,'62',"62"},{63,'63',"63"},{64,'64',"64"},{65,'65',"65"},{66,'66',"66"},{67,'67',"67"},{68,'68',"68"},{69,'69',"69"},{70,'70',"70"},{71,'71',"71"},{72,'72',"72"},{73,'73',"73"},{74,'74',"74"},{75,'75',"75"},{76,'76',"76"},{77,'77',"77"},{78,'78',"78"},{79,'79',"79"},{80,'80',"80"},{81,'81',"81"},{82,'82',"82"},{83,'83',"83"},{84,'84',"84"},{85,'85',"85"},{86,'86',"86"},{87,'87',"87"},{88,'88',"88"},{89,'89',"89"},{90,'90',"90"},{91,'91',"91"},{92,'92',"92"},{93,'93',"93"},{94,'94',"94"},{95,'95',"95"},{96,'96',"96"},{97,'97',"97"},{98,'98',"98"},{99,'99',"99"},{100,'100',"100"}]}. diff --git a/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.0/src/m2.erl b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.0/src/m2.erl new file mode 100644 index 0000000000..481276ba7b --- /dev/null +++ b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.0/src/m2.erl @@ -0,0 +1,4 @@ +-module(m2). +-compile(export_all). +%% A module with a big constant... +bar() -> {now(),[{1,'1',"1"},{2,'2',"2"},{3,'3',"3"},{4,'4',"4"},{5,'5',"5"},{6,'6',"6"},{7,'7',"7"},{8,'8',"8"},{9,'9',"9"},{10,'10',"10"},{11,'11',"11"},{12,'12',"12"},{13,'13',"13"},{14,'14',"14"},{15,'15',"15"},{16,'16',"16"},{17,'17',"17"},{18,'18',"18"},{19,'19',"19"},{20,'20',"20"},{21,'21',"21"},{22,'22',"22"},{23,'23',"23"},{24,'24',"24"},{25,'25',"25"},{26,'26',"26"},{27,'27',"27"},{28,'28',"28"},{29,'29',"29"},{30,'30',"30"},{31,'31',"31"},{32,'32',"32"},{33,'33',"33"},{34,'34',"34"},{35,'35',"35"},{36,'36',"36"},{37,'37',"37"},{38,'38',"38"},{39,'39',"39"},{40,'40',"40"},{41,'41',"41"},{42,'42',"42"},{43,'43',"43"},{44,'44',"44"},{45,'45',"45"},{46,'46',"46"},{47,'47',"47"},{48,'48',"48"},{49,'49',"49"},{50,'50',"50"},{51,'51',"51"},{52,'52',"52"},{53,'53',"53"},{54,'54',"54"},{55,'55',"55"},{56,'56',"56"},{57,'57',"57"},{58,'58',"58"},{59,'59',"59"},{60,'60',"60"},{61,'61',"61"},{62,'62',"62"},{63,'63',"63"},{64,'64',"64"},{65,'65',"65"},{66,'66',"66"},{67,'67',"67"},{68,'68',"68"},{69,'69',"69"},{70,'70',"70"},{71,'71',"71"},{72,'72',"72"},{73,'73',"73"},{74,'74',"74"},{75,'75',"75"},{76,'76',"76"},{77,'77',"77"},{78,'78',"78"},{79,'79',"79"},{80,'80',"80"},{81,'81',"81"},{82,'82',"82"},{83,'83',"83"},{84,'84',"84"},{85,'85',"85"},{86,'86',"86"},{87,'87',"87"},{88,'88',"88"},{89,'89',"89"},{90,'90',"90"},{91,'91',"91"},{92,'92',"92"},{93,'93',"93"},{94,'94',"94"},{95,'95',"95"},{96,'96',"96"},{97,'97',"97"},{98,'98',"98"},{99,'99',"99"},{100,'100',"100"}]}. diff --git a/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.0/src/m3.erl b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.0/src/m3.erl new file mode 100644 index 0000000000..9a04ed5fc9 --- /dev/null +++ b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.0/src/m3.erl @@ -0,0 +1,4 @@ +-module(m3). +-compile(export_all). +%% A module with a big constant... +bar() -> {now(),[{1,'1',"1"},{2,'2',"2"},{3,'3',"3"},{4,'4',"4"},{5,'5',"5"},{6,'6',"6"},{7,'7',"7"},{8,'8',"8"},{9,'9',"9"},{10,'10',"10"},{11,'11',"11"},{12,'12',"12"},{13,'13',"13"},{14,'14',"14"},{15,'15',"15"},{16,'16',"16"},{17,'17',"17"},{18,'18',"18"},{19,'19',"19"},{20,'20',"20"},{21,'21',"21"},{22,'22',"22"},{23,'23',"23"},{24,'24',"24"},{25,'25',"25"},{26,'26',"26"},{27,'27',"27"},{28,'28',"28"},{29,'29',"29"},{30,'30',"30"},{31,'31',"31"},{32,'32',"32"},{33,'33',"33"},{34,'34',"34"},{35,'35',"35"},{36,'36',"36"},{37,'37',"37"},{38,'38',"38"},{39,'39',"39"},{40,'40',"40"},{41,'41',"41"},{42,'42',"42"},{43,'43',"43"},{44,'44',"44"},{45,'45',"45"},{46,'46',"46"},{47,'47',"47"},{48,'48',"48"},{49,'49',"49"},{50,'50',"50"},{51,'51',"51"},{52,'52',"52"},{53,'53',"53"},{54,'54',"54"},{55,'55',"55"},{56,'56',"56"},{57,'57',"57"},{58,'58',"58"},{59,'59',"59"},{60,'60',"60"},{61,'61',"61"},{62,'62',"62"},{63,'63',"63"},{64,'64',"64"},{65,'65',"65"},{66,'66',"66"},{67,'67',"67"},{68,'68',"68"},{69,'69',"69"},{70,'70',"70"},{71,'71',"71"},{72,'72',"72"},{73,'73',"73"},{74,'74',"74"},{75,'75',"75"},{76,'76',"76"},{77,'77',"77"},{78,'78',"78"},{79,'79',"79"},{80,'80',"80"},{81,'81',"81"},{82,'82',"82"},{83,'83',"83"},{84,'84',"84"},{85,'85',"85"},{86,'86',"86"},{87,'87',"87"},{88,'88',"88"},{89,'89',"89"},{90,'90',"90"},{91,'91',"91"},{92,'92',"92"},{93,'93',"93"},{94,'94',"94"},{95,'95',"95"},{96,'96',"96"},{97,'97',"97"},{98,'98',"98"},{99,'99',"99"},{100,'100',"100"}]}. diff --git a/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.0/src/m4.erl b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.0/src/m4.erl new file mode 100644 index 0000000000..90de9a30c9 --- /dev/null +++ b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.0/src/m4.erl @@ -0,0 +1,4 @@ +-module(m4). +-compile(export_all). +%% A module with a big constant... +bar() -> {now(),[{1,'1',"1"},{2,'2',"2"},{3,'3',"3"},{4,'4',"4"},{5,'5',"5"},{6,'6',"6"},{7,'7',"7"},{8,'8',"8"},{9,'9',"9"},{10,'10',"10"},{11,'11',"11"},{12,'12',"12"},{13,'13',"13"},{14,'14',"14"},{15,'15',"15"},{16,'16',"16"},{17,'17',"17"},{18,'18',"18"},{19,'19',"19"},{20,'20',"20"},{21,'21',"21"},{22,'22',"22"},{23,'23',"23"},{24,'24',"24"},{25,'25',"25"},{26,'26',"26"},{27,'27',"27"},{28,'28',"28"},{29,'29',"29"},{30,'30',"30"},{31,'31',"31"},{32,'32',"32"},{33,'33',"33"},{34,'34',"34"},{35,'35',"35"},{36,'36',"36"},{37,'37',"37"},{38,'38',"38"},{39,'39',"39"},{40,'40',"40"},{41,'41',"41"},{42,'42',"42"},{43,'43',"43"},{44,'44',"44"},{45,'45',"45"},{46,'46',"46"},{47,'47',"47"},{48,'48',"48"},{49,'49',"49"},{50,'50',"50"},{51,'51',"51"},{52,'52',"52"},{53,'53',"53"},{54,'54',"54"},{55,'55',"55"},{56,'56',"56"},{57,'57',"57"},{58,'58',"58"},{59,'59',"59"},{60,'60',"60"},{61,'61',"61"},{62,'62',"62"},{63,'63',"63"},{64,'64',"64"},{65,'65',"65"},{66,'66',"66"},{67,'67',"67"},{68,'68',"68"},{69,'69',"69"},{70,'70',"70"},{71,'71',"71"},{72,'72',"72"},{73,'73',"73"},{74,'74',"74"},{75,'75',"75"},{76,'76',"76"},{77,'77',"77"},{78,'78',"78"},{79,'79',"79"},{80,'80',"80"},{81,'81',"81"},{82,'82',"82"},{83,'83',"83"},{84,'84',"84"},{85,'85',"85"},{86,'86',"86"},{87,'87',"87"},{88,'88',"88"},{89,'89',"89"},{90,'90',"90"},{91,'91',"91"},{92,'92',"92"},{93,'93',"93"},{94,'94',"94"},{95,'95',"95"},{96,'96',"96"},{97,'97',"97"},{98,'98',"98"},{99,'99',"99"},{100,'100',"100"}]}. diff --git a/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.0/src/m5.erl b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.0/src/m5.erl new file mode 100644 index 0000000000..8a9b690dfa --- /dev/null +++ b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.0/src/m5.erl @@ -0,0 +1,4 @@ +-module(m5). +-compile(export_all). +%% A module with a big constant... +bar() -> {now(),[{1,'1',"1"},{2,'2',"2"},{3,'3',"3"},{4,'4',"4"},{5,'5',"5"},{6,'6',"6"},{7,'7',"7"},{8,'8',"8"},{9,'9',"9"},{10,'10',"10"},{11,'11',"11"},{12,'12',"12"},{13,'13',"13"},{14,'14',"14"},{15,'15',"15"},{16,'16',"16"},{17,'17',"17"},{18,'18',"18"},{19,'19',"19"},{20,'20',"20"},{21,'21',"21"},{22,'22',"22"},{23,'23',"23"},{24,'24',"24"},{25,'25',"25"},{26,'26',"26"},{27,'27',"27"},{28,'28',"28"},{29,'29',"29"},{30,'30',"30"},{31,'31',"31"},{32,'32',"32"},{33,'33',"33"},{34,'34',"34"},{35,'35',"35"},{36,'36',"36"},{37,'37',"37"},{38,'38',"38"},{39,'39',"39"},{40,'40',"40"},{41,'41',"41"},{42,'42',"42"},{43,'43',"43"},{44,'44',"44"},{45,'45',"45"},{46,'46',"46"},{47,'47',"47"},{48,'48',"48"},{49,'49',"49"},{50,'50',"50"},{51,'51',"51"},{52,'52',"52"},{53,'53',"53"},{54,'54',"54"},{55,'55',"55"},{56,'56',"56"},{57,'57',"57"},{58,'58',"58"},{59,'59',"59"},{60,'60',"60"},{61,'61',"61"},{62,'62',"62"},{63,'63',"63"},{64,'64',"64"},{65,'65',"65"},{66,'66',"66"},{67,'67',"67"},{68,'68',"68"},{69,'69',"69"},{70,'70',"70"},{71,'71',"71"},{72,'72',"72"},{73,'73',"73"},{74,'74',"74"},{75,'75',"75"},{76,'76',"76"},{77,'77',"77"},{78,'78',"78"},{79,'79',"79"},{80,'80',"80"},{81,'81',"81"},{82,'82',"82"},{83,'83',"83"},{84,'84',"84"},{85,'85',"85"},{86,'86',"86"},{87,'87',"87"},{88,'88',"88"},{89,'89',"89"},{90,'90',"90"},{91,'91',"91"},{92,'92',"92"},{93,'93',"93"},{94,'94',"94"},{95,'95',"95"},{96,'96',"96"},{97,'97',"97"},{98,'98',"98"},{99,'99',"99"},{100,'100',"100"}]}. diff --git a/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.0/src/m6.erl b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.0/src/m6.erl new file mode 100644 index 0000000000..cd0d3977ed --- /dev/null +++ b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.0/src/m6.erl @@ -0,0 +1,4 @@ +-module(m6). +-compile(export_all). +%% A module with a big constant... +bar() -> {now(),[{1,'1',"1"},{2,'2',"2"},{3,'3',"3"},{4,'4',"4"},{5,'5',"5"},{6,'6',"6"},{7,'7',"7"},{8,'8',"8"},{9,'9',"9"},{10,'10',"10"},{11,'11',"11"},{12,'12',"12"},{13,'13',"13"},{14,'14',"14"},{15,'15',"15"},{16,'16',"16"},{17,'17',"17"},{18,'18',"18"},{19,'19',"19"},{20,'20',"20"},{21,'21',"21"},{22,'22',"22"},{23,'23',"23"},{24,'24',"24"},{25,'25',"25"},{26,'26',"26"},{27,'27',"27"},{28,'28',"28"},{29,'29',"29"},{30,'30',"30"},{31,'31',"31"},{32,'32',"32"},{33,'33',"33"},{34,'34',"34"},{35,'35',"35"},{36,'36',"36"},{37,'37',"37"},{38,'38',"38"},{39,'39',"39"},{40,'40',"40"},{41,'41',"41"},{42,'42',"42"},{43,'43',"43"},{44,'44',"44"},{45,'45',"45"},{46,'46',"46"},{47,'47',"47"},{48,'48',"48"},{49,'49',"49"},{50,'50',"50"},{51,'51',"51"},{52,'52',"52"},{53,'53',"53"},{54,'54',"54"},{55,'55',"55"},{56,'56',"56"},{57,'57',"57"},{58,'58',"58"},{59,'59',"59"},{60,'60',"60"},{61,'61',"61"},{62,'62',"62"},{63,'63',"63"},{64,'64',"64"},{65,'65',"65"},{66,'66',"66"},{67,'67',"67"},{68,'68',"68"},{69,'69',"69"},{70,'70',"70"},{71,'71',"71"},{72,'72',"72"},{73,'73',"73"},{74,'74',"74"},{75,'75',"75"},{76,'76',"76"},{77,'77',"77"},{78,'78',"78"},{79,'79',"79"},{80,'80',"80"},{81,'81',"81"},{82,'82',"82"},{83,'83',"83"},{84,'84',"84"},{85,'85',"85"},{86,'86',"86"},{87,'87',"87"},{88,'88',"88"},{89,'89',"89"},{90,'90',"90"},{91,'91',"91"},{92,'92',"92"},{93,'93',"93"},{94,'94',"94"},{95,'95',"95"},{96,'96',"96"},{97,'97',"97"},{98,'98',"98"},{99,'99',"99"},{100,'100',"100"}]}. diff --git a/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.0/src/m7.erl b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.0/src/m7.erl new file mode 100644 index 0000000000..1f79918d6e --- /dev/null +++ b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.0/src/m7.erl @@ -0,0 +1,4 @@ +-module(m7). +-compile(export_all). +%% A module with a big constant... +bar() -> {now(),[{1,'1',"1"},{2,'2',"2"},{3,'3',"3"},{4,'4',"4"},{5,'5',"5"},{6,'6',"6"},{7,'7',"7"},{8,'8',"8"},{9,'9',"9"},{10,'10',"10"},{11,'11',"11"},{12,'12',"12"},{13,'13',"13"},{14,'14',"14"},{15,'15',"15"},{16,'16',"16"},{17,'17',"17"},{18,'18',"18"},{19,'19',"19"},{20,'20',"20"},{21,'21',"21"},{22,'22',"22"},{23,'23',"23"},{24,'24',"24"},{25,'25',"25"},{26,'26',"26"},{27,'27',"27"},{28,'28',"28"},{29,'29',"29"},{30,'30',"30"},{31,'31',"31"},{32,'32',"32"},{33,'33',"33"},{34,'34',"34"},{35,'35',"35"},{36,'36',"36"},{37,'37',"37"},{38,'38',"38"},{39,'39',"39"},{40,'40',"40"},{41,'41',"41"},{42,'42',"42"},{43,'43',"43"},{44,'44',"44"},{45,'45',"45"},{46,'46',"46"},{47,'47',"47"},{48,'48',"48"},{49,'49',"49"},{50,'50',"50"},{51,'51',"51"},{52,'52',"52"},{53,'53',"53"},{54,'54',"54"},{55,'55',"55"},{56,'56',"56"},{57,'57',"57"},{58,'58',"58"},{59,'59',"59"},{60,'60',"60"},{61,'61',"61"},{62,'62',"62"},{63,'63',"63"},{64,'64',"64"},{65,'65',"65"},{66,'66',"66"},{67,'67',"67"},{68,'68',"68"},{69,'69',"69"},{70,'70',"70"},{71,'71',"71"},{72,'72',"72"},{73,'73',"73"},{74,'74',"74"},{75,'75',"75"},{76,'76',"76"},{77,'77',"77"},{78,'78',"78"},{79,'79',"79"},{80,'80',"80"},{81,'81',"81"},{82,'82',"82"},{83,'83',"83"},{84,'84',"84"},{85,'85',"85"},{86,'86',"86"},{87,'87',"87"},{88,'88',"88"},{89,'89',"89"},{90,'90',"90"},{91,'91',"91"},{92,'92',"92"},{93,'93',"93"},{94,'94',"94"},{95,'95',"95"},{96,'96',"96"},{97,'97',"97"},{98,'98',"98"},{99,'99',"99"},{100,'100',"100"}]}. diff --git a/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.0/src/m8.erl b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.0/src/m8.erl new file mode 100644 index 0000000000..2ce03a0b7e --- /dev/null +++ b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.0/src/m8.erl @@ -0,0 +1,4 @@ +-module(m8). +-compile(export_all). +%% A module with a big constant... +bar() -> {now(),[{1,'1',"1"},{2,'2',"2"},{3,'3',"3"},{4,'4',"4"},{5,'5',"5"},{6,'6',"6"},{7,'7',"7"},{8,'8',"8"},{9,'9',"9"},{10,'10',"10"},{11,'11',"11"},{12,'12',"12"},{13,'13',"13"},{14,'14',"14"},{15,'15',"15"},{16,'16',"16"},{17,'17',"17"},{18,'18',"18"},{19,'19',"19"},{20,'20',"20"},{21,'21',"21"},{22,'22',"22"},{23,'23',"23"},{24,'24',"24"},{25,'25',"25"},{26,'26',"26"},{27,'27',"27"},{28,'28',"28"},{29,'29',"29"},{30,'30',"30"},{31,'31',"31"},{32,'32',"32"},{33,'33',"33"},{34,'34',"34"},{35,'35',"35"},{36,'36',"36"},{37,'37',"37"},{38,'38',"38"},{39,'39',"39"},{40,'40',"40"},{41,'41',"41"},{42,'42',"42"},{43,'43',"43"},{44,'44',"44"},{45,'45',"45"},{46,'46',"46"},{47,'47',"47"},{48,'48',"48"},{49,'49',"49"},{50,'50',"50"},{51,'51',"51"},{52,'52',"52"},{53,'53',"53"},{54,'54',"54"},{55,'55',"55"},{56,'56',"56"},{57,'57',"57"},{58,'58',"58"},{59,'59',"59"},{60,'60',"60"},{61,'61',"61"},{62,'62',"62"},{63,'63',"63"},{64,'64',"64"},{65,'65',"65"},{66,'66',"66"},{67,'67',"67"},{68,'68',"68"},{69,'69',"69"},{70,'70',"70"},{71,'71',"71"},{72,'72',"72"},{73,'73',"73"},{74,'74',"74"},{75,'75',"75"},{76,'76',"76"},{77,'77',"77"},{78,'78',"78"},{79,'79',"79"},{80,'80',"80"},{81,'81',"81"},{82,'82',"82"},{83,'83',"83"},{84,'84',"84"},{85,'85',"85"},{86,'86',"86"},{87,'87',"87"},{88,'88',"88"},{89,'89',"89"},{90,'90',"90"},{91,'91',"91"},{92,'92',"92"},{93,'93',"93"},{94,'94',"94"},{95,'95',"95"},{96,'96',"96"},{97,'97',"97"},{98,'98',"98"},{99,'99',"99"},{100,'100',"100"}]}. diff --git a/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.0/src/m9.erl b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.0/src/m9.erl new file mode 100644 index 0000000000..1c5f72e628 --- /dev/null +++ b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.0/src/m9.erl @@ -0,0 +1,4 @@ +-module(m9). +-compile(export_all). +%% A module with a big constant... +bar() -> {now(),[{1,'1',"1"},{2,'2',"2"},{3,'3',"3"},{4,'4',"4"},{5,'5',"5"},{6,'6',"6"},{7,'7',"7"},{8,'8',"8"},{9,'9',"9"},{10,'10',"10"},{11,'11',"11"},{12,'12',"12"},{13,'13',"13"},{14,'14',"14"},{15,'15',"15"},{16,'16',"16"},{17,'17',"17"},{18,'18',"18"},{19,'19',"19"},{20,'20',"20"},{21,'21',"21"},{22,'22',"22"},{23,'23',"23"},{24,'24',"24"},{25,'25',"25"},{26,'26',"26"},{27,'27',"27"},{28,'28',"28"},{29,'29',"29"},{30,'30',"30"},{31,'31',"31"},{32,'32',"32"},{33,'33',"33"},{34,'34',"34"},{35,'35',"35"},{36,'36',"36"},{37,'37',"37"},{38,'38',"38"},{39,'39',"39"},{40,'40',"40"},{41,'41',"41"},{42,'42',"42"},{43,'43',"43"},{44,'44',"44"},{45,'45',"45"},{46,'46',"46"},{47,'47',"47"},{48,'48',"48"},{49,'49',"49"},{50,'50',"50"},{51,'51',"51"},{52,'52',"52"},{53,'53',"53"},{54,'54',"54"},{55,'55',"55"},{56,'56',"56"},{57,'57',"57"},{58,'58',"58"},{59,'59',"59"},{60,'60',"60"},{61,'61',"61"},{62,'62',"62"},{63,'63',"63"},{64,'64',"64"},{65,'65',"65"},{66,'66',"66"},{67,'67',"67"},{68,'68',"68"},{69,'69',"69"},{70,'70',"70"},{71,'71',"71"},{72,'72',"72"},{73,'73',"73"},{74,'74',"74"},{75,'75',"75"},{76,'76',"76"},{77,'77',"77"},{78,'78',"78"},{79,'79',"79"},{80,'80',"80"},{81,'81',"81"},{82,'82',"82"},{83,'83',"83"},{84,'84',"84"},{85,'85',"85"},{86,'86',"86"},{87,'87',"87"},{88,'88',"88"},{89,'89',"89"},{90,'90',"90"},{91,'91',"91"},{92,'92',"92"},{93,'93',"93"},{94,'94',"94"},{95,'95',"95"},{96,'96',"96"},{97,'97',"97"},{98,'98',"98"},{99,'99',"99"},{100,'100',"100"}]}. diff --git a/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.1/ebin/many_mods.app b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.1/ebin/many_mods.app new file mode 100644 index 0000000000..36c50caf2f --- /dev/null +++ b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.1/ebin/many_mods.app @@ -0,0 +1,17 @@ +%% -*- erlang -*- +{application, many_mods, + [{description, "Application with many modules CXC 138 11"}, + {vsn, "1.1"}, + {modules, [{m, 1}, + {m1,1}, + {m2,1}, + {m3,1}, + {m4,1}, + {m5,1}, + {m6,1}, + {m7,1}, + {m8,1}, + {m9,1}, + {m10,1}]}, + {registered, []}, + {applications, [kernel, stdlib]}]}. diff --git a/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.1/ebin/many_mods.appup b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.1/ebin/many_mods.appup new file mode 100644 index 0000000000..696435e06f --- /dev/null +++ b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.1/ebin/many_mods.appup @@ -0,0 +1,22 @@ +%% -*- erlang -*- +{"1.1", + [{"1.0",[{update,m1}, + {update,m2}, + {update,m3}, + {update,m4}, + {update,m5}, + {update,m6}, + {update,m7}, + {update,m8}, + {update,m9}, + {update,m10}]}], + [{"1.0",[{update,m1}, + {update,m2}, + {update,m3}, + {update,m4}, + {update,m5}, + {update,m6}, + {update,m7}, + {update,m8}, + {update,m9}, + {update,m10}]}]}. diff --git a/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.1/src/m.erl b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.1/src/m.erl new file mode 100644 index 0000000000..418102bebb --- /dev/null +++ b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.1/src/m.erl @@ -0,0 +1,11 @@ +-module(m). +-compile(export_all). + +start(NProcs) -> + Modules = [m1,m2,m3,m4,m5,m6,m7,m8,m9,m10], + Pids = [spawn_link(fun() -> + Cs = [M:bar() || M <- Modules], + receive stop -> Cs end + end) || + _ <- lists:seq(1,NProcs)], + {Modules,Pids}. diff --git a/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.1/src/m1.erl b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.1/src/m1.erl new file mode 100644 index 0000000000..cacc13f5d7 --- /dev/null +++ b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.1/src/m1.erl @@ -0,0 +1,4 @@ +-module(m1). +-compile(export_all). +%% A module with a big constant... +bar() -> {now(),[{1,'1',"1"},{2,'2',"2"},{3,'3',"3"},{4,'4',"4"},{5,'5',"5"},{6,'6',"6"},{7,'7',"7"},{8,'8',"8"},{9,'9',"9"},{10,'10',"10"},{11,'11',"11"},{12,'12',"12"},{13,'13',"13"},{14,'14',"14"},{15,'15',"15"},{16,'16',"16"},{17,'17',"17"},{18,'18',"18"},{19,'19',"19"},{20,'20',"20"},{21,'21',"21"},{22,'22',"22"},{23,'23',"23"},{24,'24',"24"},{25,'25',"25"},{26,'26',"26"},{27,'27',"27"},{28,'28',"28"},{29,'29',"29"},{30,'30',"30"},{31,'31',"31"},{32,'32',"32"},{33,'33',"33"},{34,'34',"34"},{35,'35',"35"},{36,'36',"36"},{37,'37',"37"},{38,'38',"38"},{39,'39',"39"},{40,'40',"40"},{41,'41',"41"},{42,'42',"42"},{43,'43',"43"},{44,'44',"44"},{45,'45',"45"},{46,'46',"46"},{47,'47',"47"},{48,'48',"48"},{49,'49',"49"},{50,'50',"50"},{51,'51',"51"},{52,'52',"52"},{53,'53',"53"},{54,'54',"54"},{55,'55',"55"},{56,'56',"56"},{57,'57',"57"},{58,'58',"58"},{59,'59',"59"},{60,'60',"60"},{61,'61',"61"},{62,'62',"62"},{63,'63',"63"},{64,'64',"64"},{65,'65',"65"},{66,'66',"66"},{67,'67',"67"},{68,'68',"68"},{69,'69',"69"},{70,'70',"70"},{71,'71',"71"},{72,'72',"72"},{73,'73',"73"},{74,'74',"74"},{75,'75',"75"},{76,'76',"76"},{77,'77',"77"},{78,'78',"78"},{79,'79',"79"},{80,'80',"80"},{81,'81',"81"},{82,'82',"82"},{83,'83',"83"},{84,'84',"84"},{85,'85',"85"},{86,'86',"86"},{87,'87',"87"},{88,'88',"88"},{89,'89',"89"},{90,'90',"90"},{91,'91',"91"},{92,'92',"92"},{93,'93',"93"},{94,'94',"94"},{95,'95',"95"},{96,'96',"96"},{97,'97',"97"},{98,'98',"98"},{99,'99',"99"},{100,'100',"100"}]}. diff --git a/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.1/src/m10.erl b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.1/src/m10.erl new file mode 100644 index 0000000000..81e120b891 --- /dev/null +++ b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.1/src/m10.erl @@ -0,0 +1,4 @@ +-module(m10). +-compile(export_all). +%% A module with a big constant... +bar() -> {now(),[{1,'1',"1"},{2,'2',"2"},{3,'3',"3"},{4,'4',"4"},{5,'5',"5"},{6,'6',"6"},{7,'7',"7"},{8,'8',"8"},{9,'9',"9"},{10,'10',"10"},{11,'11',"11"},{12,'12',"12"},{13,'13',"13"},{14,'14',"14"},{15,'15',"15"},{16,'16',"16"},{17,'17',"17"},{18,'18',"18"},{19,'19',"19"},{20,'20',"20"},{21,'21',"21"},{22,'22',"22"},{23,'23',"23"},{24,'24',"24"},{25,'25',"25"},{26,'26',"26"},{27,'27',"27"},{28,'28',"28"},{29,'29',"29"},{30,'30',"30"},{31,'31',"31"},{32,'32',"32"},{33,'33',"33"},{34,'34',"34"},{35,'35',"35"},{36,'36',"36"},{37,'37',"37"},{38,'38',"38"},{39,'39',"39"},{40,'40',"40"},{41,'41',"41"},{42,'42',"42"},{43,'43',"43"},{44,'44',"44"},{45,'45',"45"},{46,'46',"46"},{47,'47',"47"},{48,'48',"48"},{49,'49',"49"},{50,'50',"50"},{51,'51',"51"},{52,'52',"52"},{53,'53',"53"},{54,'54',"54"},{55,'55',"55"},{56,'56',"56"},{57,'57',"57"},{58,'58',"58"},{59,'59',"59"},{60,'60',"60"},{61,'61',"61"},{62,'62',"62"},{63,'63',"63"},{64,'64',"64"},{65,'65',"65"},{66,'66',"66"},{67,'67',"67"},{68,'68',"68"},{69,'69',"69"},{70,'70',"70"},{71,'71',"71"},{72,'72',"72"},{73,'73',"73"},{74,'74',"74"},{75,'75',"75"},{76,'76',"76"},{77,'77',"77"},{78,'78',"78"},{79,'79',"79"},{80,'80',"80"},{81,'81',"81"},{82,'82',"82"},{83,'83',"83"},{84,'84',"84"},{85,'85',"85"},{86,'86',"86"},{87,'87',"87"},{88,'88',"88"},{89,'89',"89"},{90,'90',"90"},{91,'91',"91"},{92,'92',"92"},{93,'93',"93"},{94,'94',"94"},{95,'95',"95"},{96,'96',"96"},{97,'97',"97"},{98,'98',"98"},{99,'99',"99"},{100,'100',"100"}]}. diff --git a/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.1/src/m2.erl b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.1/src/m2.erl new file mode 100644 index 0000000000..481276ba7b --- /dev/null +++ b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.1/src/m2.erl @@ -0,0 +1,4 @@ +-module(m2). +-compile(export_all). +%% A module with a big constant... +bar() -> {now(),[{1,'1',"1"},{2,'2',"2"},{3,'3',"3"},{4,'4',"4"},{5,'5',"5"},{6,'6',"6"},{7,'7',"7"},{8,'8',"8"},{9,'9',"9"},{10,'10',"10"},{11,'11',"11"},{12,'12',"12"},{13,'13',"13"},{14,'14',"14"},{15,'15',"15"},{16,'16',"16"},{17,'17',"17"},{18,'18',"18"},{19,'19',"19"},{20,'20',"20"},{21,'21',"21"},{22,'22',"22"},{23,'23',"23"},{24,'24',"24"},{25,'25',"25"},{26,'26',"26"},{27,'27',"27"},{28,'28',"28"},{29,'29',"29"},{30,'30',"30"},{31,'31',"31"},{32,'32',"32"},{33,'33',"33"},{34,'34',"34"},{35,'35',"35"},{36,'36',"36"},{37,'37',"37"},{38,'38',"38"},{39,'39',"39"},{40,'40',"40"},{41,'41',"41"},{42,'42',"42"},{43,'43',"43"},{44,'44',"44"},{45,'45',"45"},{46,'46',"46"},{47,'47',"47"},{48,'48',"48"},{49,'49',"49"},{50,'50',"50"},{51,'51',"51"},{52,'52',"52"},{53,'53',"53"},{54,'54',"54"},{55,'55',"55"},{56,'56',"56"},{57,'57',"57"},{58,'58',"58"},{59,'59',"59"},{60,'60',"60"},{61,'61',"61"},{62,'62',"62"},{63,'63',"63"},{64,'64',"64"},{65,'65',"65"},{66,'66',"66"},{67,'67',"67"},{68,'68',"68"},{69,'69',"69"},{70,'70',"70"},{71,'71',"71"},{72,'72',"72"},{73,'73',"73"},{74,'74',"74"},{75,'75',"75"},{76,'76',"76"},{77,'77',"77"},{78,'78',"78"},{79,'79',"79"},{80,'80',"80"},{81,'81',"81"},{82,'82',"82"},{83,'83',"83"},{84,'84',"84"},{85,'85',"85"},{86,'86',"86"},{87,'87',"87"},{88,'88',"88"},{89,'89',"89"},{90,'90',"90"},{91,'91',"91"},{92,'92',"92"},{93,'93',"93"},{94,'94',"94"},{95,'95',"95"},{96,'96',"96"},{97,'97',"97"},{98,'98',"98"},{99,'99',"99"},{100,'100',"100"}]}. diff --git a/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.1/src/m3.erl b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.1/src/m3.erl new file mode 100644 index 0000000000..9a04ed5fc9 --- /dev/null +++ b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.1/src/m3.erl @@ -0,0 +1,4 @@ +-module(m3). +-compile(export_all). +%% A module with a big constant... +bar() -> {now(),[{1,'1',"1"},{2,'2',"2"},{3,'3',"3"},{4,'4',"4"},{5,'5',"5"},{6,'6',"6"},{7,'7',"7"},{8,'8',"8"},{9,'9',"9"},{10,'10',"10"},{11,'11',"11"},{12,'12',"12"},{13,'13',"13"},{14,'14',"14"},{15,'15',"15"},{16,'16',"16"},{17,'17',"17"},{18,'18',"18"},{19,'19',"19"},{20,'20',"20"},{21,'21',"21"},{22,'22',"22"},{23,'23',"23"},{24,'24',"24"},{25,'25',"25"},{26,'26',"26"},{27,'27',"27"},{28,'28',"28"},{29,'29',"29"},{30,'30',"30"},{31,'31',"31"},{32,'32',"32"},{33,'33',"33"},{34,'34',"34"},{35,'35',"35"},{36,'36',"36"},{37,'37',"37"},{38,'38',"38"},{39,'39',"39"},{40,'40',"40"},{41,'41',"41"},{42,'42',"42"},{43,'43',"43"},{44,'44',"44"},{45,'45',"45"},{46,'46',"46"},{47,'47',"47"},{48,'48',"48"},{49,'49',"49"},{50,'50',"50"},{51,'51',"51"},{52,'52',"52"},{53,'53',"53"},{54,'54',"54"},{55,'55',"55"},{56,'56',"56"},{57,'57',"57"},{58,'58',"58"},{59,'59',"59"},{60,'60',"60"},{61,'61',"61"},{62,'62',"62"},{63,'63',"63"},{64,'64',"64"},{65,'65',"65"},{66,'66',"66"},{67,'67',"67"},{68,'68',"68"},{69,'69',"69"},{70,'70',"70"},{71,'71',"71"},{72,'72',"72"},{73,'73',"73"},{74,'74',"74"},{75,'75',"75"},{76,'76',"76"},{77,'77',"77"},{78,'78',"78"},{79,'79',"79"},{80,'80',"80"},{81,'81',"81"},{82,'82',"82"},{83,'83',"83"},{84,'84',"84"},{85,'85',"85"},{86,'86',"86"},{87,'87',"87"},{88,'88',"88"},{89,'89',"89"},{90,'90',"90"},{91,'91',"91"},{92,'92',"92"},{93,'93',"93"},{94,'94',"94"},{95,'95',"95"},{96,'96',"96"},{97,'97',"97"},{98,'98',"98"},{99,'99',"99"},{100,'100',"100"}]}. diff --git a/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.1/src/m4.erl b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.1/src/m4.erl new file mode 100644 index 0000000000..90de9a30c9 --- /dev/null +++ b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.1/src/m4.erl @@ -0,0 +1,4 @@ +-module(m4). +-compile(export_all). +%% A module with a big constant... +bar() -> {now(),[{1,'1',"1"},{2,'2',"2"},{3,'3',"3"},{4,'4',"4"},{5,'5',"5"},{6,'6',"6"},{7,'7',"7"},{8,'8',"8"},{9,'9',"9"},{10,'10',"10"},{11,'11',"11"},{12,'12',"12"},{13,'13',"13"},{14,'14',"14"},{15,'15',"15"},{16,'16',"16"},{17,'17',"17"},{18,'18',"18"},{19,'19',"19"},{20,'20',"20"},{21,'21',"21"},{22,'22',"22"},{23,'23',"23"},{24,'24',"24"},{25,'25',"25"},{26,'26',"26"},{27,'27',"27"},{28,'28',"28"},{29,'29',"29"},{30,'30',"30"},{31,'31',"31"},{32,'32',"32"},{33,'33',"33"},{34,'34',"34"},{35,'35',"35"},{36,'36',"36"},{37,'37',"37"},{38,'38',"38"},{39,'39',"39"},{40,'40',"40"},{41,'41',"41"},{42,'42',"42"},{43,'43',"43"},{44,'44',"44"},{45,'45',"45"},{46,'46',"46"},{47,'47',"47"},{48,'48',"48"},{49,'49',"49"},{50,'50',"50"},{51,'51',"51"},{52,'52',"52"},{53,'53',"53"},{54,'54',"54"},{55,'55',"55"},{56,'56',"56"},{57,'57',"57"},{58,'58',"58"},{59,'59',"59"},{60,'60',"60"},{61,'61',"61"},{62,'62',"62"},{63,'63',"63"},{64,'64',"64"},{65,'65',"65"},{66,'66',"66"},{67,'67',"67"},{68,'68',"68"},{69,'69',"69"},{70,'70',"70"},{71,'71',"71"},{72,'72',"72"},{73,'73',"73"},{74,'74',"74"},{75,'75',"75"},{76,'76',"76"},{77,'77',"77"},{78,'78',"78"},{79,'79',"79"},{80,'80',"80"},{81,'81',"81"},{82,'82',"82"},{83,'83',"83"},{84,'84',"84"},{85,'85',"85"},{86,'86',"86"},{87,'87',"87"},{88,'88',"88"},{89,'89',"89"},{90,'90',"90"},{91,'91',"91"},{92,'92',"92"},{93,'93',"93"},{94,'94',"94"},{95,'95',"95"},{96,'96',"96"},{97,'97',"97"},{98,'98',"98"},{99,'99',"99"},{100,'100',"100"}]}. diff --git a/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.1/src/m5.erl b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.1/src/m5.erl new file mode 100644 index 0000000000..8a9b690dfa --- /dev/null +++ b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.1/src/m5.erl @@ -0,0 +1,4 @@ +-module(m5). +-compile(export_all). +%% A module with a big constant... +bar() -> {now(),[{1,'1',"1"},{2,'2',"2"},{3,'3',"3"},{4,'4',"4"},{5,'5',"5"},{6,'6',"6"},{7,'7',"7"},{8,'8',"8"},{9,'9',"9"},{10,'10',"10"},{11,'11',"11"},{12,'12',"12"},{13,'13',"13"},{14,'14',"14"},{15,'15',"15"},{16,'16',"16"},{17,'17',"17"},{18,'18',"18"},{19,'19',"19"},{20,'20',"20"},{21,'21',"21"},{22,'22',"22"},{23,'23',"23"},{24,'24',"24"},{25,'25',"25"},{26,'26',"26"},{27,'27',"27"},{28,'28',"28"},{29,'29',"29"},{30,'30',"30"},{31,'31',"31"},{32,'32',"32"},{33,'33',"33"},{34,'34',"34"},{35,'35',"35"},{36,'36',"36"},{37,'37',"37"},{38,'38',"38"},{39,'39',"39"},{40,'40',"40"},{41,'41',"41"},{42,'42',"42"},{43,'43',"43"},{44,'44',"44"},{45,'45',"45"},{46,'46',"46"},{47,'47',"47"},{48,'48',"48"},{49,'49',"49"},{50,'50',"50"},{51,'51',"51"},{52,'52',"52"},{53,'53',"53"},{54,'54',"54"},{55,'55',"55"},{56,'56',"56"},{57,'57',"57"},{58,'58',"58"},{59,'59',"59"},{60,'60',"60"},{61,'61',"61"},{62,'62',"62"},{63,'63',"63"},{64,'64',"64"},{65,'65',"65"},{66,'66',"66"},{67,'67',"67"},{68,'68',"68"},{69,'69',"69"},{70,'70',"70"},{71,'71',"71"},{72,'72',"72"},{73,'73',"73"},{74,'74',"74"},{75,'75',"75"},{76,'76',"76"},{77,'77',"77"},{78,'78',"78"},{79,'79',"79"},{80,'80',"80"},{81,'81',"81"},{82,'82',"82"},{83,'83',"83"},{84,'84',"84"},{85,'85',"85"},{86,'86',"86"},{87,'87',"87"},{88,'88',"88"},{89,'89',"89"},{90,'90',"90"},{91,'91',"91"},{92,'92',"92"},{93,'93',"93"},{94,'94',"94"},{95,'95',"95"},{96,'96',"96"},{97,'97',"97"},{98,'98',"98"},{99,'99',"99"},{100,'100',"100"}]}. diff --git a/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.1/src/m6.erl b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.1/src/m6.erl new file mode 100644 index 0000000000..cd0d3977ed --- /dev/null +++ b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.1/src/m6.erl @@ -0,0 +1,4 @@ +-module(m6). +-compile(export_all). +%% A module with a big constant... +bar() -> {now(),[{1,'1',"1"},{2,'2',"2"},{3,'3',"3"},{4,'4',"4"},{5,'5',"5"},{6,'6',"6"},{7,'7',"7"},{8,'8',"8"},{9,'9',"9"},{10,'10',"10"},{11,'11',"11"},{12,'12',"12"},{13,'13',"13"},{14,'14',"14"},{15,'15',"15"},{16,'16',"16"},{17,'17',"17"},{18,'18',"18"},{19,'19',"19"},{20,'20',"20"},{21,'21',"21"},{22,'22',"22"},{23,'23',"23"},{24,'24',"24"},{25,'25',"25"},{26,'26',"26"},{27,'27',"27"},{28,'28',"28"},{29,'29',"29"},{30,'30',"30"},{31,'31',"31"},{32,'32',"32"},{33,'33',"33"},{34,'34',"34"},{35,'35',"35"},{36,'36',"36"},{37,'37',"37"},{38,'38',"38"},{39,'39',"39"},{40,'40',"40"},{41,'41',"41"},{42,'42',"42"},{43,'43',"43"},{44,'44',"44"},{45,'45',"45"},{46,'46',"46"},{47,'47',"47"},{48,'48',"48"},{49,'49',"49"},{50,'50',"50"},{51,'51',"51"},{52,'52',"52"},{53,'53',"53"},{54,'54',"54"},{55,'55',"55"},{56,'56',"56"},{57,'57',"57"},{58,'58',"58"},{59,'59',"59"},{60,'60',"60"},{61,'61',"61"},{62,'62',"62"},{63,'63',"63"},{64,'64',"64"},{65,'65',"65"},{66,'66',"66"},{67,'67',"67"},{68,'68',"68"},{69,'69',"69"},{70,'70',"70"},{71,'71',"71"},{72,'72',"72"},{73,'73',"73"},{74,'74',"74"},{75,'75',"75"},{76,'76',"76"},{77,'77',"77"},{78,'78',"78"},{79,'79',"79"},{80,'80',"80"},{81,'81',"81"},{82,'82',"82"},{83,'83',"83"},{84,'84',"84"},{85,'85',"85"},{86,'86',"86"},{87,'87',"87"},{88,'88',"88"},{89,'89',"89"},{90,'90',"90"},{91,'91',"91"},{92,'92',"92"},{93,'93',"93"},{94,'94',"94"},{95,'95',"95"},{96,'96',"96"},{97,'97',"97"},{98,'98',"98"},{99,'99',"99"},{100,'100',"100"}]}. diff --git a/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.1/src/m7.erl b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.1/src/m7.erl new file mode 100644 index 0000000000..1f79918d6e --- /dev/null +++ b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.1/src/m7.erl @@ -0,0 +1,4 @@ +-module(m7). +-compile(export_all). +%% A module with a big constant... +bar() -> {now(),[{1,'1',"1"},{2,'2',"2"},{3,'3',"3"},{4,'4',"4"},{5,'5',"5"},{6,'6',"6"},{7,'7',"7"},{8,'8',"8"},{9,'9',"9"},{10,'10',"10"},{11,'11',"11"},{12,'12',"12"},{13,'13',"13"},{14,'14',"14"},{15,'15',"15"},{16,'16',"16"},{17,'17',"17"},{18,'18',"18"},{19,'19',"19"},{20,'20',"20"},{21,'21',"21"},{22,'22',"22"},{23,'23',"23"},{24,'24',"24"},{25,'25',"25"},{26,'26',"26"},{27,'27',"27"},{28,'28',"28"},{29,'29',"29"},{30,'30',"30"},{31,'31',"31"},{32,'32',"32"},{33,'33',"33"},{34,'34',"34"},{35,'35',"35"},{36,'36',"36"},{37,'37',"37"},{38,'38',"38"},{39,'39',"39"},{40,'40',"40"},{41,'41',"41"},{42,'42',"42"},{43,'43',"43"},{44,'44',"44"},{45,'45',"45"},{46,'46',"46"},{47,'47',"47"},{48,'48',"48"},{49,'49',"49"},{50,'50',"50"},{51,'51',"51"},{52,'52',"52"},{53,'53',"53"},{54,'54',"54"},{55,'55',"55"},{56,'56',"56"},{57,'57',"57"},{58,'58',"58"},{59,'59',"59"},{60,'60',"60"},{61,'61',"61"},{62,'62',"62"},{63,'63',"63"},{64,'64',"64"},{65,'65',"65"},{66,'66',"66"},{67,'67',"67"},{68,'68',"68"},{69,'69',"69"},{70,'70',"70"},{71,'71',"71"},{72,'72',"72"},{73,'73',"73"},{74,'74',"74"},{75,'75',"75"},{76,'76',"76"},{77,'77',"77"},{78,'78',"78"},{79,'79',"79"},{80,'80',"80"},{81,'81',"81"},{82,'82',"82"},{83,'83',"83"},{84,'84',"84"},{85,'85',"85"},{86,'86',"86"},{87,'87',"87"},{88,'88',"88"},{89,'89',"89"},{90,'90',"90"},{91,'91',"91"},{92,'92',"92"},{93,'93',"93"},{94,'94',"94"},{95,'95',"95"},{96,'96',"96"},{97,'97',"97"},{98,'98',"98"},{99,'99',"99"},{100,'100',"100"}]}. diff --git a/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.1/src/m8.erl b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.1/src/m8.erl new file mode 100644 index 0000000000..2ce03a0b7e --- /dev/null +++ b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.1/src/m8.erl @@ -0,0 +1,4 @@ +-module(m8). +-compile(export_all). +%% A module with a big constant... +bar() -> {now(),[{1,'1',"1"},{2,'2',"2"},{3,'3',"3"},{4,'4',"4"},{5,'5',"5"},{6,'6',"6"},{7,'7',"7"},{8,'8',"8"},{9,'9',"9"},{10,'10',"10"},{11,'11',"11"},{12,'12',"12"},{13,'13',"13"},{14,'14',"14"},{15,'15',"15"},{16,'16',"16"},{17,'17',"17"},{18,'18',"18"},{19,'19',"19"},{20,'20',"20"},{21,'21',"21"},{22,'22',"22"},{23,'23',"23"},{24,'24',"24"},{25,'25',"25"},{26,'26',"26"},{27,'27',"27"},{28,'28',"28"},{29,'29',"29"},{30,'30',"30"},{31,'31',"31"},{32,'32',"32"},{33,'33',"33"},{34,'34',"34"},{35,'35',"35"},{36,'36',"36"},{37,'37',"37"},{38,'38',"38"},{39,'39',"39"},{40,'40',"40"},{41,'41',"41"},{42,'42',"42"},{43,'43',"43"},{44,'44',"44"},{45,'45',"45"},{46,'46',"46"},{47,'47',"47"},{48,'48',"48"},{49,'49',"49"},{50,'50',"50"},{51,'51',"51"},{52,'52',"52"},{53,'53',"53"},{54,'54',"54"},{55,'55',"55"},{56,'56',"56"},{57,'57',"57"},{58,'58',"58"},{59,'59',"59"},{60,'60',"60"},{61,'61',"61"},{62,'62',"62"},{63,'63',"63"},{64,'64',"64"},{65,'65',"65"},{66,'66',"66"},{67,'67',"67"},{68,'68',"68"},{69,'69',"69"},{70,'70',"70"},{71,'71',"71"},{72,'72',"72"},{73,'73',"73"},{74,'74',"74"},{75,'75',"75"},{76,'76',"76"},{77,'77',"77"},{78,'78',"78"},{79,'79',"79"},{80,'80',"80"},{81,'81',"81"},{82,'82',"82"},{83,'83',"83"},{84,'84',"84"},{85,'85',"85"},{86,'86',"86"},{87,'87',"87"},{88,'88',"88"},{89,'89',"89"},{90,'90',"90"},{91,'91',"91"},{92,'92',"92"},{93,'93',"93"},{94,'94',"94"},{95,'95',"95"},{96,'96',"96"},{97,'97',"97"},{98,'98',"98"},{99,'99',"99"},{100,'100',"100"}]}. diff --git a/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.1/src/m9.erl b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.1/src/m9.erl new file mode 100644 index 0000000000..1c5f72e628 --- /dev/null +++ b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.1/src/m9.erl @@ -0,0 +1,4 @@ +-module(m9). +-compile(export_all). +%% A module with a big constant... +bar() -> {now(),[{1,'1',"1"},{2,'2',"2"},{3,'3',"3"},{4,'4',"4"},{5,'5',"5"},{6,'6',"6"},{7,'7',"7"},{8,'8',"8"},{9,'9',"9"},{10,'10',"10"},{11,'11',"11"},{12,'12',"12"},{13,'13',"13"},{14,'14',"14"},{15,'15',"15"},{16,'16',"16"},{17,'17',"17"},{18,'18',"18"},{19,'19',"19"},{20,'20',"20"},{21,'21',"21"},{22,'22',"22"},{23,'23',"23"},{24,'24',"24"},{25,'25',"25"},{26,'26',"26"},{27,'27',"27"},{28,'28',"28"},{29,'29',"29"},{30,'30',"30"},{31,'31',"31"},{32,'32',"32"},{33,'33',"33"},{34,'34',"34"},{35,'35',"35"},{36,'36',"36"},{37,'37',"37"},{38,'38',"38"},{39,'39',"39"},{40,'40',"40"},{41,'41',"41"},{42,'42',"42"},{43,'43',"43"},{44,'44',"44"},{45,'45',"45"},{46,'46',"46"},{47,'47',"47"},{48,'48',"48"},{49,'49',"49"},{50,'50',"50"},{51,'51',"51"},{52,'52',"52"},{53,'53',"53"},{54,'54',"54"},{55,'55',"55"},{56,'56',"56"},{57,'57',"57"},{58,'58',"58"},{59,'59',"59"},{60,'60',"60"},{61,'61',"61"},{62,'62',"62"},{63,'63',"63"},{64,'64',"64"},{65,'65',"65"},{66,'66',"66"},{67,'67',"67"},{68,'68',"68"},{69,'69',"69"},{70,'70',"70"},{71,'71',"71"},{72,'72',"72"},{73,'73',"73"},{74,'74',"74"},{75,'75',"75"},{76,'76',"76"},{77,'77',"77"},{78,'78',"78"},{79,'79',"79"},{80,'80',"80"},{81,'81',"81"},{82,'82',"82"},{83,'83',"83"},{84,'84',"84"},{85,'85',"85"},{86,'86',"86"},{87,'87',"87"},{88,'88',"88"},{89,'89',"89"},{90,'90',"90"},{91,'91',"91"},{92,'92',"92"},{93,'93',"93"},{94,'94',"94"},{95,'95',"95"},{96,'96',"96"},{97,'97',"97"},{98,'98',"98"},{99,'99',"99"},{100,'100',"100"}]}. diff --git a/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-2.0/ebin/many_mods.app b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-2.0/ebin/many_mods.app new file mode 100644 index 0000000000..98f6527750 --- /dev/null +++ b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-2.0/ebin/many_mods.app @@ -0,0 +1,7 @@ +%% -*- erlang -*- +{application, many_mods, + [{description, "Application with many modules CXC 138 11"}, + {vsn, "2.0"}, + {modules, [{m, 1}]}, + {registered, []}, + {applications, [kernel, stdlib]}]}. diff --git a/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-2.0/ebin/many_mods.appup b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-2.0/ebin/many_mods.appup new file mode 100644 index 0000000000..3a34db78c1 --- /dev/null +++ b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-2.0/ebin/many_mods.appup @@ -0,0 +1,24 @@ +%% -*- erlang -*- +{"2.0", + [{"1.0",[{update,m}, + {delete_module,m1}, + {delete_module,m2}, + {delete_module,m3}, + {delete_module,m4}, + {delete_module,m5}, + {delete_module,m6}, + {delete_module,m7}, + {delete_module,m8}, + {delete_module,m9}, + {delete_module,m10}]}], + [{"1.0",[{update,m}, + {add_module,m1}, + {add_module,m2}, + {add_module,m3}, + {add_module,m4}, + {add_module,m5}, + {add_module,m6}, + {add_module,m7}, + {add_module,m8}, + {add_module,m9}, + {add_module,m10}]}]}. diff --git a/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-2.0/src/m.erl b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-2.0/src/m.erl new file mode 100644 index 0000000000..2edc1e6be4 --- /dev/null +++ b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-2.0/src/m.erl @@ -0,0 +1,11 @@ +-module(m). +-compile(export_all). + +start(NProcs) -> + Modules = [], + Pids = [spawn_link(fun() -> + Cs = [M:bar() || M <- Modules], + receive stop -> Cs end + end) || + _ <- lists:seq(1,NProcs)], + {Modules,Pids}. diff --git a/lib/sasl/test/release_handler_SUITE_data/clients/start_cli2 b/lib/sasl/test/release_handler_SUITE_data/start_client index 88912cf884..5ea94d6f7c 100755 --- a/lib/sasl/test/release_handler_SUITE_data/clients/start_cli2 +++ b/lib/sasl/test/release_handler_SUITE_data/start_client @@ -34,4 +34,4 @@ then mkdir /tmp/$NODENAME@$TESTHOST fi -$ROOTDIR/bin/run_erl /tmp/$NODENAME@$TESTHOST/ $CLIENTDIR/log "exec $ROOTDIR/bin/start_erl $ROOTDIR $RELDIR $START_ERL_DATA -heart -sname $NODENAME -sasl start_prg \\\"$CLIENTDIR/bin/start\\\" masters \[\\'%MASTER%@$TESTHOST\\',\\'master2@$TESTHOST\\'\] client_directory \\\"$CLIENTDIR\\\"" > /dev/null 2>&1 & +$ROOTDIR/bin/run_erl /tmp/$NODENAME@$TESTHOST/ $CLIENTDIR/log "exec $ROOTDIR/bin/start_erl $ROOTDIR $RELDIR $START_ERL_DATA -heart -sname $NODENAME %CLIENTARGS%" > $CLIENTDIR/log/run_erl.out 2>&1 & diff --git a/lib/sasl/test/rh_test_lib.erl b/lib/sasl/test/rh_test_lib.erl new file mode 100644 index 0000000000..99a7f919a7 --- /dev/null +++ b/lib/sasl/test/rh_test_lib.erl @@ -0,0 +1,100 @@ +-module(rh_test_lib). + +-export([erlsrv/3, + erlsrv/4]). +-export([get_service_args/3, + get_service_args/4, + get_start_erl_args/1, + get_start_erl_args/3, + get_client_args/3, + get_client_args/4]). + + +erlsrv(Erlsrv,Action,Name) -> + erlsrv(Erlsrv,Action,Name,""). +erlsrv(Erlsrv,Action,Name,Rest) -> + Cmd = Erlsrv ++ " " ++ atom_to_list(Action) ++ " " ++ Name ++ " " ++ Rest, + io:format("erlsrv cmd: ~p~n",[Cmd]), + Port = open_port({spawn, Cmd}, [stream, {line, 100}, eof, in]), + Res = recv_prog_output(Port), + case Res of + [] -> + failed; + _Y -> + io:format("erlsrv res: ~p~n",[_Y]), + ok + end. + +recv_prog_output(Port) -> + receive + {Port, {data, {eol,Data}}} -> + %%io:format("Got data: ~s~n", [Data]), + [ Data, "\n" | recv_prog_output(Port)]; + {Port, {data, {noeol,Data}}} -> + %%io:format("Got data: ~s~n", [Data]), + [ Data | recv_prog_output(Port)]; + {Port, _Other} -> + %%io:format("Got ~p from port~n", [_Other]), + Port ! {self(), close}, + receive + {Port,closed} -> + [] + end + end. + +get_service_args(RootDir, Sname, StartErlArgs) -> + get_service_args(RootDir, "", Sname, StartErlArgs). +get_service_args(RootDir, RelClientDir, Sname, StartErlArgs) -> + LogDir = filename:nativename(filename:join([RootDir,RelClientDir,"log"])), + %% start_erl.exe will be found since it is in the same directory as erlsrv.exe + %% And heart_restart.bat will be found since the erts bin dir is + %% always in the path for the erlang virtual machine. + " -machine start_erl.exe -workdir " ++ LogDir ++ + " -debugtype new -sname " ++ atom_to_list(Sname) ++ + " -env HEART_COMMAND=heart_restart.bat -args \"" ++ StartErlArgs ++ "\"". + +get_start_erl_args(RootDir) -> + get_start_erl_args(RootDir,"",""). +get_start_erl_args(RootDir,RelClientDir,ExtraArgs) -> + Cookie = atom_to_list(erlang:get_cookie()), + RelDir = filename:join([RootDir,RelClientDir,"releases"]), + ExtraArgs ++ " -setcookie " ++ Cookie ++ + " -heart ++ -rootdir " ++ filename:nativename(RootDir) ++ + " -reldir " ++ filename:nativename(RelDir). + +%% Must be called on the master node +get_client_args(Client,Sname,RootDir) -> + get_client_args(Client,Sname,RootDir,node()). +get_client_args(Client,Sname,RootDir,Master) -> + {ok,Host} = inet:gethostname(), + Node = atom_to_list(Sname) ++ "@" ++ Host, + RelClientDir = filename:join(["clients","type1",Node]), + ClientDir = filename:join([RootDir,RelClientDir]), + StartPrg = filename:join([ClientDir,"bin","start"]), + {" -sasl start_prg \\\\\\\"" ++ StartPrg ++ "\\\\\\\" masters \[" ++ + single_quote() ++ atom_to_list(Master) ++ single_quote() ++ + get_client_extra_master(Client,Host) ++ + "\] client_directory \\\\\\\"" ++ ClientDir ++ "\\\\\\\"" ++ + get_client_loader_args(Client,Sname,Host), + RelClientDir}. + +get_client_loader_args(client1,Sname,Host) -> + {ok,IpTuple} = inet:getaddr(Host,inet), + IpAddr = inet_parse:ntoa(IpTuple), + " -loader inet -id " ++ + atom_to_list(Sname) ++ " -hosts " ++ IpAddr; +get_client_loader_args(_,_,_) -> + "". + +get_client_extra_master(client2,Host) -> + "," ++ single_quote() ++ "master2@" ++ Host ++ single_quote(); +get_client_extra_master(_,_) -> + "". + +single_quote() -> + case os:type() of + {win32,_} -> + "\'"; + _ -> + "\\'" + end. diff --git a/lib/sasl/test/systools_SUITE.erl b/lib/sasl/test/systools_SUITE.erl index 9190b111ef..e352247d44 100644 --- a/lib/sasl/test/systools_SUITE.erl +++ b/lib/sasl/test/systools_SUITE.erl @@ -48,7 +48,7 @@ included_fail_script/1, included_bug_script/1, exref_script/1]). -export([ tar_options/1, normal_tar/1, no_mod_vsn_tar/1, variable_tar/1, src_tests_tar/1, shadow_tar/1, var_tar/1, - exref_tar/1, link_tar/1]). + exref_tar/1, link_tar/1, otp_9507/1]). -export([ normal_relup/1, abnormal_relup/1, no_appup_relup/1, bad_appup_relup/1, app_start_type_relup/1, otp_3065/1]). -export([ @@ -81,7 +81,7 @@ groups() -> {tar, [], [tar_options, normal_tar, no_mod_vsn_tar, variable_tar, src_tests_tar, shadow_tar, var_tar, - exref_tar, link_tar]}, + exref_tar, link_tar, otp_9507]}, {relup, [], [normal_relup, abnormal_relup, no_appup_relup, bad_appup_relup, app_start_type_relup]}, @@ -396,6 +396,7 @@ src_tests_script(Config) when is_list(Config) -> ?line PSAVE = code:get_path(), % Save path ?line {LatestDir, LatestName} = create_script(latest,Config), + ?line BootFile = LatestName ++ ".boot", ?line DataDir = filename:absname(?copydir), ?line LibDir = fname([DataDir, d_missing_src, lib]), @@ -416,14 +417,32 @@ src_tests_script(Config) when is_list(Config) -> ?line Erl2 = filename:join([P1,"..","src","db2.erl"]), ?line file:delete(Erl2), - %% Then make script - two warnings should be issued when - %% src_tests is given + %% Then make script + + %% .boot file should not exist + ?line ok = file:delete(BootFile), + ?line false = filelib:is_regular(BootFile), + %% With warnings_as_errors and src_tests option, an error should be issued + ?line error = + systools:make_script(LatestName, [silent, {path, N}, src_tests, + warnings_as_errors]), + ?line error = + systools:make_script(LatestName, [{path, N}, src_tests, + warnings_as_errors]), + + %% due to warnings_as_errors .boot file should still not exist + ?line false = filelib:is_regular(BootFile), + + %% Two warnings should be issued when src_tests is given %% 1. old object code for db1.beam %% 2. missing source code for db2.beam ?line {ok, _, [{warning,{obj_out_of_date,_}}, {warning,{source_not_found,_}}]} = systools:make_script(LatestName, [silent, {path, N}, src_tests]), + %% .boot file should exist now + ?line true = filelib:is_regular(BootFile), + %% Without the src_tests option, no warning should be issued ?line {ok, _, []} = systools:make_script(LatestName, [silent, {path, N}]), @@ -1066,6 +1085,48 @@ exref_tar(Config) when is_list(Config) -> ?line ok = file:set_cwd(OldDir), ok. + + +%% otp_9507 +%% +otp_9507(suite) -> []; +otp_9507(doc) -> + ["make_tar failed when path given as just 'ebin'."]; +otp_9507(Config) when is_list(Config) -> + ?line {ok, OldDir} = file:get_cwd(), + + ?line {LatestDir, LatestName} = create_script(latest_small,Config), + + ?line DataDir = filename:absname(?copydir), + ?line LibDir = fname([DataDir, d_normal, lib]), + ?line FeDir = fname([LibDir, 'fe-3.1']), + + ?line ok = file:set_cwd(FeDir), + + RelName = fname([LatestDir,LatestName]), + + ?line P1 = ["./ebin", + fname([DataDir, lib, kernel, ebin]), + fname([DataDir, lib, stdlib, ebin])], + ?line {ok, _, _} = systools:make_script(RelName, [silent, {path, P1}]), + ?line ok = systools:make_tar(RelName, [{path, P1}]), + ?line Content1 = tar_contents(RelName), + + ?line P2 = ["ebin", + fname([DataDir, lib, kernel, ebin]), + fname([DataDir, lib, stdlib, ebin])], + + %% Tickets solves the following line - it used to fail with + %% {function_clause,[{filename,join,[[]]},...} + ?line ok = systools:make_tar(RelName, [{path, P2}]), + ?line Content2 = tar_contents(RelName), + true = (Content1 == Content2), + + ?line ok = file:set_cwd(OldDir), + + ok. + + %% The relup stuff. %% %% @@ -1108,6 +1169,21 @@ normal_relup(Config) when is_list(Config) -> [{path, P}, silent]), ?line ok = check_relup([{db, "2.1"}], [{db, "1.0"}]), + %% file should not be written if warnings_as_errors is enabled. + %% delete before running tests. + ?line ok = file:delete("relup"), + + %% Check that warnings are treated as errors + ?line error = + systools:make_relup(LatestName, [LatestName2], [LatestName1], + [{path, P}, warnings_as_errors]), + ?line error = + systools:make_relup(LatestName, [LatestName2], [LatestName1], + [{path, P}, silent, warnings_as_errors]), + + %% relup file should not exist + ?line false = filelib:is_regular("relup"), + %% Check that warnings get through ?line ok = systools:make_relup(LatestName, [LatestName2], [LatestName1], [{path, P}]), @@ -1117,6 +1193,9 @@ normal_relup(Config) when is_list(Config) -> [{path, P}, silent]), ?line ok = check_relup([{fe, "3.1"}, {db, "2.1"}], [{db, "1.0"}]), + %% relup file should exist now + ?line true = filelib:is_regular("relup"), + ?line ok = file:set_cwd(OldDir), ok. diff --git a/lib/snmp/Makefile b/lib/snmp/Makefile index 20e3d4692a..c55eff04c6 100644 --- a/lib/snmp/Makefile +++ b/lib/snmp/Makefile @@ -67,7 +67,7 @@ do_configure: configure configure: configure.in autoconf -.PHONY: info +.PHONY: info gclean info: @echo "OS: $(OS)" @@ -76,6 +76,9 @@ info: @echo "SNMP_VSN: $(SNMP_VSN)" @echo "APP_VSN: $(APP_VSN)" +gclean: + git clean -fXd + # ---------------------------------------------------- # Application (source) release targets diff --git a/lib/snmp/doc/src/Makefile b/lib/snmp/doc/src/Makefile index 35ed63e103..aa9431477c 100644 --- a/lib/snmp/doc/src/Makefile +++ b/lib/snmp/doc/src/Makefile @@ -152,6 +152,7 @@ $(TOP_PDF_FILE): $(XML_FILES) pdf: $(TOP_PDF_FILE) html: gifs $(HTML_REF_MAN_FILE) +html2: html $(INDEX_TARGET) clean clean_docs: clean_html clean_man clean_pdf rm -f errs core *~ @@ -228,6 +229,7 @@ clean_man: clean_html: @echo "cleaning html:" rm -rf $(HTMLDIR)/* + rm -f $(INDEX_TARGET) $(MAN7DIR)/%.7: $(MIBSDIR)/%.mib @echo "processing $*" @@ -286,7 +288,7 @@ release_docs_spec: docs $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) $(INSTALL_DIR) $(RELEASE_PATH)/man/man1 $(INSTALL_DATA) $(MAN1_FILES) $(RELEASE_PATH)/man/man1 - $(INSTALL_DIR) $(RELEASE_PATH)/man/man + $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 $(INSTALL_DATA) $(MAN3_FILES) $(RELEASE_PATH)/man/man3 $(INSTALL_DIR) $(RELEASE_PATH)/man/man6 $(INSTALL_DATA) $(MAN6_FILES) $(RELEASE_PATH)/man/man6 diff --git a/lib/snmp/doc/src/notes.xml b/lib/snmp/doc/src/notes.xml index 6a20d8ee3a..4178192120 100644 --- a/lib/snmp/doc/src/notes.xml +++ b/lib/snmp/doc/src/notes.xml @@ -33,6 +33,136 @@ </header> <section> + <title>SNMP Development Toolkit 4.21</title> + <p>Version 4.21 supports code replacement in runtime from/to + version 4.20.1, 4.20 and 4.19. </p> + + <section> + <title>Improvements and new features</title> +<!-- + <p>-</p> +--> + <list type="bulleted"> + <item> + <p>[manager] There was no way to specify transport domain. + The transport domains was assumed to be IPv4 (transportDomainUdpIpv4). + This has now been changed so that it can also be IPv6 + (transportDomainUdpIpv6). + To facilitate this, the transport domain, <c>tdomain</c>, + is now a (new) valid option when + <seealso marker="snmpm#register_agent">registering</seealso> + a new agent (and + <seealso marker="snmpm#update_agent_info">updating</seealso> + agent info). </p> + <p>This also mean that the transport behaviour has changed. </p> + <p>Own Id: OTP-9305</p> + <p>Aux Id: Seq 11847</p> + </item> + + <item> + <p>[compiler] Added the option + <seealso marker="snmpc#compile">warnings_as_errors</seealso> + (for the SNMP MIB compiler (escript) frontend, the option + <seealso marker="snmpc(command)#option_wae">--wae</seealso> is used) + which specifies whether warnings should be treated as errors. </p> + <p>Tuncer Ayaz</p> + <p>Own Id: OTP-9437</p> + </item> + </list> + + </section> + + <section> + <title>Fixed Bugs and Malfunctions</title> +<!-- + <p>-</p> +--> + + <list type="bulleted"> + <item> + <p>The snmp config tool could not handle (manager) audit trail config + because the option seqno was not handled. </p> + <p>Own Id: OTP-9354</p> + </item> + + <item> + <p>[agent] The SNMP ACM cache was not properly updated when + changes where made to the VACM security-to-group, access and + view-tree-family tables. </p> + <p>Own Id: OTP-9367</p> + <p>Aux Id: Seq 11858</p> + </item> + + <item> + <p>Fixed install directory typo for man3. </p> + <p>Peter Lemenkov</p> + <p>Hans Ulrich Niedermann</p> + <p>Own Id: OTP-9442</p> + </item> + + </list> + </section> + + + <section> + <title>Incompatibilities</title> + <p>-</p> + </section> + + </section> <!-- 4.21 --> + + + <section> + <title>SNMP Development Toolkit 4.20.1</title> + <p>Version 4.20.1 supports code replacement in runtime from/to + version 4.20, 4.19 and 4.18.</p> + + <section> + <title>Improvements and new features</title> + <p>-</p> +<!-- + <list type="bulleted"> + <item> + <p>Added type specs for functions that do not return. </p> + <p>Kostis Sagonas</p> + <p>Own Id: OTP-9208</p> + </item> + </list> +--> + </section> + + <section> + <title>Fixed Bugs and Malfunctions</title> +<!-- + <p>-</p> +--> + <list type="bulleted"> + <item> + <p>[agent] Did not handle transport domains properly in some cases, + for instance trap sending. </p> + <p>Own Id: OTP-9400</p> + </item> + + <item> + <p>[agent] Wrong default transport domain, snmpUDPDomain, instead + of transportDomainUdpIpv4. </p> + <p>Own Id: OTP-9425</p> + <p>Aux Id: Seq 11874</p> + </item> + + </list> + </section> + + + <section> + <title>Incompatibilities</title> + <p>-</p> + </section> + + </section> <!-- 4.20.1 --> + + + <section> <title>SNMP Development Toolkit 4.20</title> <p>Version 4.20 supports code replacement in runtime from/to version 4.19 and 4.18.</p> diff --git a/lib/snmp/doc/src/snmpc.xml b/lib/snmp/doc/src/snmpc.xml index 771629492d..61d19251c5 100644 --- a/lib/snmp/doc/src/snmpc.xml +++ b/lib/snmp/doc/src/snmpc.xml @@ -48,7 +48,11 @@ <type> <v>File = string()</v> <v>Options = [opt()]</v> - <v>opt() = db() | relaxed_row_name_assign_check() | deprecated() | description() | reference() | group_check() | i() | il() | imports() | module() | module_identity() | module_compliance() | agent_capabilities() | outdir() | no_defs() | verbosity() | warnings()</v> + <v>opt() = db() | relaxed_row_name_assign_check() | deprecated() | + description() | reference() | group_check() | i() | il() | + imports() | module() | module_identity() | module_compliance() | + agent_capabilities() | outdir() | no_defs() | verbosity() | + warnings() | warnings_as_errors()</v> <v>db() = {db, volatile|persistent|mnesia}</v> <v>deprecated() = {deprecated, bool()}</v> <v>relaxed_row_name_assign_check() = relaxed_row_name_assign_check</v> @@ -66,6 +70,7 @@ <v>outdir() = {outdir, dir()}</v> <v>verbosity() = {verbosity, silence|warning|info|log|debug|trace}</v> <v>warnings() = {warnings, bool()}</v> + <v>warnings_as_errors() = warnings_as_errors</v> <v>dir() = string()</v> <v>BinFileName = string()</v> </type> @@ -200,11 +205,17 @@ <item> <p>The option <c>warnings</c> specifies whether warning - messages should be shown. </p> + messages should be shown. </p> <p>Default is <c>true</c>. </p> </item> + <item> + <p>The option <c>warnings_as_errors</c>, if present, specifies + whether warnings should be treated as errors.</p> + </item> + </list> + <p>The MIB compiler understands both SMIv1 and SMIv2 MIBs. It uses the <c>MODULE-IDENTITY</c> statement to determine if the MIB is version 1 or 2. diff --git a/lib/snmp/doc/src/snmpc_cmd.xml b/lib/snmp/doc/src/snmpc_cmd.xml index 9358382a10..72116f8981 100644 --- a/lib/snmp/doc/src/snmpc_cmd.xml +++ b/lib/snmp/doc/src/snmpc_cmd.xml @@ -50,6 +50,8 @@ with definitions of Erlang constants for the objects in the MIB, see <seealso marker="snmpc#mib_to_hrl">mib_to_hrl/1</seealso>. </p> + + <marker id="options"></marker> </desc> </func> </funcs> @@ -58,15 +60,18 @@ <title>Compiler options</title> <p>The following options are supported (note that most of these relate to the compilation of the MIB file):</p> + <marker id="option_help"></marker> <taglist> <tag>--help</tag> <item> <p>Prints help info.</p> + <marker id="option_version"></marker> </item> <tag>--version</tag> <item> <p>Prints application and mib format version.</p> + <marker id="option_verbosity"></marker> </item> <tag>--verbosity <em>verbosity</em></tag> @@ -74,11 +79,20 @@ <p>Print debug info. </p> <p><c>verbosity</c> = <c>trace</c> | <c>debug</c> | <c>log</c> | <c>info</c> | <c>silence</c></p> <p>Defaults to <c>silence</c>.</p> + <marker id="option_warnings"></marker> </item> <tag>--warnings</tag> <item> <p>Print warning messages. </p> + <marker id="option_wae"></marker> + </item> + + <tag>--wae</tag> + <item> + <p>Warnings as errors. + Indicates that warnings shall be treated as errors. </p> + <marker id="option_odir"></marker> </item> <tag>--o <em>directory</em></tag> @@ -86,6 +100,7 @@ <p>The directory where the compiler should place the output files. If not specified, output files will be placed in the current working directory.</p> + <marker id="option_idir"></marker> </item> <tag>--i <em>Directory</em></tag> @@ -94,6 +109,7 @@ By default, the current working directory is always included. </p> <p>This option can be present several times, each time specifying <em>one</em> path. </p> + <marker id="option_ildir"></marker> </item> <tag>--il <em>Directory</em></tag> @@ -106,6 +122,7 @@ the current version may be in the system). The current directory and the "snmp-home"/priv/mibs/ are always listed last in the include path. </p> + <marker id="option_sgc"></marker> </item> <tag>--sgc</tag> @@ -114,42 +131,50 @@ group check of the mib compiler. That is, should the OBJECT-GROUP and the NOTIFICATION-GROUP macro(s) be checked for correctness or not. </p> + <marker id="option_dep"></marker> </item> <tag>--dep</tag> <item> <p>Keep deprecated definition(s). If not specified the compiler will ignore deprecated definitions. </p> + <marker id="option_desc"></marker> </item> <tag>--desc</tag> <item> <p>The DESCRIPTION field will be included. </p> + <marker id="option_ref"></marker> </item> <tag>--ref</tag> <item> <p>The REFERENCE field will be included. </p> + <marker id="option_imp"></marker> </item> <tag>--imp</tag> <item> <p>The IMPORTS field will be included. </p> + <marker id="option_mi"></marker> </item> <tag>--mi</tag> <item> <p>The MODULE-IDENTITY field will be included. </p> + <marker id="option_mc"></marker> </item> <tag>--mc</tag> <item> <p>The MODULE-COMPLIANCE field will be included. </p> + <marker id="option_ac"></marker> </item> <tag>--ac</tag> <item> <p>The AGENT-CAPABILITIES field will be included. </p> + <marker id="option_mod"></marker> </item> <tag>--mod <em>module</em></tag> @@ -157,6 +182,7 @@ <p>The module which implements all the instrumentation functions. </p> <p>The name of all instrumentation functions must be the same as the corresponding managed object it implements. </p> + <marker id="option_nd"></marker> </item> <tag>--nd</tag> @@ -165,6 +191,7 @@ used if a managed object have no instrumentation function. Instead this will be reported as an error, and the compilation aborts. </p> + <marker id="option_rrnac"></marker> </item> <tag>--rrnac</tag> @@ -176,6 +203,7 @@ This means that the error will be converted to a warning. </p> <p>By default it is not included, but if this option is present it will be. </p> + <marker id="see_also"></marker> </item> </taglist> diff --git a/lib/snmp/doc/src/snmpm.xml b/lib/snmp/doc/src/snmpm.xml index b527d171b0..c36a1b2a24 100644 --- a/lib/snmp/doc/src/snmpm.xml +++ b/lib/snmp/doc/src/snmpm.xml @@ -283,27 +283,27 @@ sec_level = noAuthNoPriv | authNoPriv | authPriv <v>TargetName = target_name()</v> <v>Config = [agent_config()]</v> <v>agent_config() = {Item, Val}</v> - <v>Item = engine_id | address | port | community | timeout | max_message_size | version | sec_model | sec_name | sec_level</v> + <v>Item = engine_id | address | port | community | timeout | max_message_size | version | sec_model | sec_name | sec_level | tdomain</v> <v>Val = term()</v> <v>Reason = term()</v> </type> <desc> <p>Explicitly instruct the manager to handle this agent, with - <c>UserId</c> as the responsible user. </p> - <p>Called to instruct the manager that this agent - shall be handled. This function is used when - the user knows in advance which agents the - manager shall handle. - Note that there is an alternate way to do the same thing: - Add the agent to the manager config files (see - <seealso marker="snmp_manager_config_files#agents">agents.conf</seealso>).</p> + <c>UserId</c> as the responsible user. </p> + <p>Called to instruct the manager that this agent shall be handled. + This function is used when the user knows in advance which agents + the manager shall handle. + Note that there is an alternate way to do the same thing: + Add the agent to the manager config files (see + <seealso marker="snmp_manager_config_files#agents">agents.conf</seealso>).</p> <p><c>TargetName</c> is a non-empty string, - uniquely identifying the agent. </p> - <p>The type of <c>Val</c> depends on <c>Item</c>: </p> + uniquely identifying the agent. </p> + <p>The type of <c>Val</c> depends on <c>Item</c>: </p> <code type="none"><![CDATA[ [mandatory] engine_id = string() [mandatory] address = ip_address() [optional] port = integer() +[optional] tdomain = transportDomainUdpIpv4 | transportDomainUdpIpv6 [optional] community = string() [optional] timeout = integer() | snmp_timer() [optional] max_message_size = integer() @@ -312,7 +312,9 @@ sec_level = noAuthNoPriv | authNoPriv | authPriv [optional] sec_name = string() [optional] sec_level = noAuthNoPriv | authNoPriv | authPriv ]]></code> - <p>Note that if no <c>Port</c> is given, the default value is used.</p> + <p>Note that if no <c>tdomain</c> is given, the default value, + <c>transportDomainUdpIpv4</c>, is used.</p> + <p>Note that if no <c>port</c> is given, the default value is used.</p> <marker id="unregister_agent"></marker> </desc> @@ -348,17 +350,25 @@ sec_level = noAuthNoPriv | authNoPriv | authPriv </func> <func> + <name>update_agent_info(UserId, TargetName, Info) -> ok | {error, Reason}</name> <name>update_agent_info(UserId, TargetName, Item, Val) -> ok | {error, Reason}</name> <fsummary>Update agent config</fsummary> <type> <v>UserId = term()</v> <v>TargetName = target_name()</v> - <v>Item = atom()</v> - <v>Val = term()</v> + <v>Info = [{item(), item_value()}]</v> + <v>Item = item()</v> + <v>item() = atom()</v> + <v>Val = item_value()</v> + <v>item_value() = term()</v> <v>Reason = term()</v> </type> <desc> - <p>Update agent config.</p> + <p>Update agent config. The function <c>update_agent_info/3</c> + should be used when several values needs to be updated atomically. </p> + <p>See function + <seealso marker="#register_agent">register_agent</seealso>) + for more info about what kind of items are allowed. </p> <marker id="which_agents"></marker> </desc> diff --git a/lib/snmp/src/agent/snmp_view_based_acm_mib.erl b/lib/snmp/src/agent/snmp_view_based_acm_mib.erl index 28469a7b4e..37f6dd3f26 100644 --- a/lib/snmp/src/agent/snmp_view_based_acm_mib.erl +++ b/lib/snmp/src/agent/snmp_view_based_acm_mib.erl @@ -247,6 +247,7 @@ add_sec2group(SecModel, SecName, GroupName) -> Key = [Key1, length(Key2) | Key2], case table_cre_row(vacmSecurityToGroupTable, Key, Row) of true -> + snmpa_agent:invalidate_ca_cache(), {ok, Key}; false -> {error, create_failed} @@ -260,6 +261,7 @@ add_sec2group(SecModel, SecName, GroupName) -> delete_sec2group(Key) -> case table_del_row(vacmSecurityToGroupTable, Key) of true -> + snmpa_agent:invalidate_ca_cache(), ok; false -> {error, delete_failed} @@ -279,6 +281,7 @@ add_access(GroupName, Prefix, SecModel, SecLevel, Match, RV, WV, NV) -> Key3 = [SM, SL], Key = Key1 ++ Key2 ++ Key3, snmpa_vacm:insert([{Key, Row}], false), + snmpa_agent:invalidate_ca_cache(), {ok, Key}; {error, Reason} -> {error, Reason}; @@ -287,6 +290,7 @@ add_access(GroupName, Prefix, SecModel, SecLevel, Match, RV, WV, NV) -> end. delete_access(Key) -> + snmpa_agent:invalidate_ca_cache(), snmpa_vacm:delete(Key). @@ -299,6 +303,7 @@ add_view_tree_fam(ViewIndex, SubTree, Status, Mask) -> Key = [length(Key1) | Key1] ++ [length(Key2) | Key2], case table_cre_row(vacmViewTreeFamilyTable, Key, Row) of true -> + snmpa_agent:invalidate_ca_cache(), {ok, Key}; false -> {error, create_failed} @@ -312,6 +317,7 @@ add_view_tree_fam(ViewIndex, SubTree, Status, Mask) -> delete_view_tree_fam(Key) -> case table_del_row(vacmViewTreeFamilyTable, Key) of true -> + snmpa_agent:invalidate_ca_cache(), ok; false -> {error, delete_failed} diff --git a/lib/snmp/src/agent/snmpa_agent.erl b/lib/snmp/src/agent/snmpa_agent.erl index 82a7ec647b..6322f0f21d 100644 --- a/lib/snmp/src/agent/snmpa_agent.erl +++ b/lib/snmp/src/agent/snmpa_agent.erl @@ -1626,7 +1626,7 @@ invalidate_ca_cache() -> MasterAgent ! invalidate_ca_cache; false -> %% This is running on a sub-agent node, - %% so sent skip it + %% so skip it ok end; _ -> % Not on this node diff --git a/lib/snmp/src/agent/snmpa_conf.erl b/lib/snmp/src/agent/snmpa_conf.erl index 4b88eb69f7..c17a6abbd7 100644 --- a/lib/snmp/src/agent/snmpa_conf.erl +++ b/lib/snmp/src/agent/snmpa_conf.erl @@ -424,7 +424,8 @@ target_addr_entry(Name, EngineId, TMask) -> target_addr_entry(Name, Ip, 162, TagList, - ParamsName, EngineId, TMask, 2048). + ParamsName, EngineId, + TMask, 2048). target_addr_entry(Name, Ip, @@ -435,7 +436,8 @@ target_addr_entry(Name, TMask, MaxMessageSize) -> target_addr_entry(Name, Ip, Udp, 1500, 3, TagList, - ParamsName, EngineId, TMask, MaxMessageSize). + ParamsName, EngineId, + TMask, MaxMessageSize). target_addr_entry(Name, Ip, @@ -448,7 +450,8 @@ target_addr_entry(Name, TMask, MaxMessageSize) -> target_addr_entry(Name, snmp_target_mib:default_domain(), Ip, Udp, - Timeout, RetryCount, TagList, ParamsName, + Timeout, RetryCount, TagList, + ParamsName, EngineId, TMask, MaxMessageSize). target_addr_entry(Name, diff --git a/lib/snmp/src/agent/snmpa_mpd.erl b/lib/snmp/src/agent/snmpa_mpd.erl index 14f62b12f3..4f50b1a674 100644 --- a/lib/snmp/src/agent/snmpa_mpd.erl +++ b/lib/snmp/src/agent/snmpa_mpd.erl @@ -32,6 +32,7 @@ -include("SNMP-MPD-MIB.hrl"). -include("SNMPv2-TM.hrl"). -include("SNMP-FRAMEWORK-MIB.hrl"). +-include("TRANSPORT-ADDRESS-MIB.hrl"). -define(VMODULE,"MPD"). -include("snmp_verbosity.hrl"). @@ -981,12 +982,15 @@ generate_discovery_msg2(NoteStore, Pdu, discovery_note_timeout(Timeout) -> (Timeout div 100) + 1. -generate_discovery_msg(NoteStore, {?snmpUDPDomain, [A,B,C,D,U1,U2]}, +generate_discovery_msg(NoteStore, {TDomain, TAddress}, Pdu, ScopedPduBytes, ContextEngineID, ManagerEngineID, SecModel, SecName, SecLevelFlag, InitialUserName, ContextName, Timeout) -> + + {ok, {_Domain, Address}} = transform_taddr(TDomain, TAddress), + %% 7.1.7 ?vdebug("generate_discovery_msg -> 7.1.7 (~w)", [ManagerEngineID]), MsgID = generate_msg_id(), @@ -1027,7 +1031,7 @@ generate_discovery_msg(NoteStore, {?snmpUDPDomain, [A,B,C,D,U1,U2]}, %% Log(Packet), inc_snmp_out_vars(Pdu), ?vdebug("generate_discovery_msg -> done", []), - {Packet, {{A,B,C,D}, U1 bsl 8 + U2}}; + {Packet, Address}; Error -> throw(Error) @@ -1057,6 +1061,34 @@ generate_sec_discovery_msg(Message, SecModule, end. +transform_taddr(?snmpUDPDomain, TAddress) -> + transform_taddr(?transportDomainUdpIpv4, TAddress); +transform_taddr(?transportDomainUdpIpv4, [A, B, C, D, P1, P2]) -> + Domain = transportDomainUdpIpv4, + Addr = {A,B,C,D}, + Port = P1 bsl 8 + P2, + Address = {Addr, Port}, + {ok, {Domain, Address}}; +transform_taddr(?transportDomainUdpIpv4, BadAddr) -> + {error, {bad_transportDomainUdpIpv4_address, BadAddr}}; +transform_taddr(?transportDomainUdpIpv6, + [A1, A2, A3, A4, A5, A6, A7, A8, P1, P2]) -> + Domain = transportDomainUdpIpv6, + Addr = {A1, A2, A3, A4, A5, A6, A7, A8}, + Port = P1 bsl 8 + P2, + Address = {Addr, Port}, + {ok, {Domain, Address}}; +transform_taddr(?transportDomainUdpIpv6, BadAddr) -> + {error, {bad_transportDomainUdpIpv6_address, BadAddr}}; +transform_taddr(BadTDomain, TAddress) -> + case lists:member(BadTDomain, snmp_conf:all_tdomains()) of + true -> + {error, {unsupported_tdomain, BadTDomain, TAddress}}; + false -> + {error, {unknown_tdomain, BadTDomain, TAddress}} + end. + + process_taddrs(Dests) -> ?vtrace("process_taddrs -> entry with" "~n Dests: ~p", [Dests]), @@ -1066,46 +1098,44 @@ process_taddrs([], Acc) -> ?vtrace("process_taddrs -> entry when done with" "~n Acc: ~p", [Acc]), lists:reverse(Acc); - + %% v3 -process_taddrs([{{?snmpUDPDomain, [A,B,C,D,U1,U2]}, SecData} | T], Acc) -> +process_taddrs([{{TDomain, TAddress}, SecData} | T], Acc) -> ?vtrace("process_taddrs -> entry when v3 with" - "~n A: ~p" - "~n B: ~p" - "~n C: ~p" - "~n D: ~p" - "~n U1: ~p" - "~n U2: ~p" - "~n SecData: ~p", [A, B, C, D, U1, U2, SecData]), - Entry = {{snmpUDPDomain, {{A,B,C,D}, U1 bsl 8 + U2}}, SecData}, - process_taddrs(T, [Entry | Acc]); -%% Bad v3 -process_taddrs([{{TDomain, TAddr}, _SecData} | T], Acc) -> - ?vtrace("process_taddrs -> entry when bad v3 with" - "~n TDomain: ~p" - "~n TAddr: ~p", [TDomain, TAddr]), - user_err("Bad TDomain/TAddr: ~w/~w", [TDomain, TAddr]), - process_taddrs(T, Acc); + "~n TDomain: ~p" + "~n TAddress: ~p" + "~n SecData: ~p", [TDomain, TAddress, SecData]), + case transform_taddr(TDomain, TAddress) of + {ok, DestAddr} -> + ?vtrace("process_taddrs -> transformed: " + "~n DestAddr: ~p", [DestAddr]), + Entry = {DestAddr, SecData}, + process_taddrs(T, [Entry | Acc]); + {error, Reason} -> + ?vinfo("Failed transforming v3 domain and address" + "~n Reason: ~p", [Reason]), + user_err("Bad TDomain/TAddress: ~w/~w", [TDomain, TAddress]), + process_taddrs(T, Acc) + end; %% v1 & v2 -process_taddrs([{?snmpUDPDomain, [A,B,C,D,U1,U2]} | T], Acc) -> +process_taddrs([{TDomain, TAddress} | T], Acc) -> ?vtrace("process_taddrs -> entry when v1/v2 with" - "~n A: ~p" - "~n B: ~p" - "~n C: ~p" - "~n D: ~p" - "~n U1: ~p" - "~n U2: ~p", [A, B, C, D, U1, U2]), - Entry = {snmpUDPDomain, {{A,B,C,D}, U1 bsl 8 + U2}}, - process_taddrs(T, [Entry | Acc]); -%% Bad v1 or v2 -process_taddrs([{TDomain, TAddr} | T], Acc) -> - ?vtrace("process_taddrs -> entry when bad v1/v2 with" - "~n TDomain: ~p" - "~n TAddr: ~p", [TDomain, TAddr]), - user_err("Bad TDomain/TAddr: ~w/~w", [TDomain, TAddr]), - process_taddrs(T, Acc); + "~n TDomain: ~p" + "~n TAddress: ~p", [TDomain, TAddress]), + case transform_taddr(TDomain, TAddress) of + {ok, DestAddr} -> + ?vtrace("process_taddrs -> transformed: " + "~n DestAddr: ~p", [DestAddr]), + Entry = DestAddr, + process_taddrs(T, [Entry | Acc]); + {error, Reason} -> + ?vinfo("Failed transforming v1/v2 domain and address: " + "~n Reason: ~p", [Reason]), + user_err("Bad TDomain/TAddress: ~w/~w", [TDomain, TAddress]), + process_taddrs(T, Acc) + end; process_taddrs(Crap, Acc) -> - throw({error, {taddrs_crap, Crap, Acc}}). + throw({error, {bad_taddrs, Crap, Acc}}). mk_v1_v2_packet_list(To, Packet, Len, Pdu) -> diff --git a/lib/snmp/src/app/snmp.appup.src b/lib/snmp/src/app/snmp.appup.src index 5deb40be0f..8e1855b4df 100644 --- a/lib/snmp/src/app/snmp.appup.src +++ b/lib/snmp/src/app/snmp.appup.src @@ -22,82 +22,82 @@ %% ----- U p g r a d e ------------------------------------------------------- [ + {"4.20.1", + [ + {load_module, snmp_view_based_acm_mib, soft_purge, soft_purge, []}, + {load_module, snmpm, soft_purge, soft_purge, + [snmpm_server, snmpm_config, snmp_config]}, + {load_module, snmp_conf, soft_purge, soft_purge, []}, + {load_module, snmp_config, soft_purge, soft_purge, []}, + {load_module, snmpm_mpd, soft_purge, soft_purge, + [snmp_conf, snmp_config, snmpm_config]}, + {load_module, snmpa_mpd, soft_purge, soft_purge, + [snmp_conf, snmp_config]}, + {load_module, snmpa_conf, soft_purge, soft_purge, [snmp_config]}, + {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mpd]}, + {update, snmpm_config, soft, soft_purge, soft_purge, [snmp_conf]}, + {update, snmpm_server, soft, soft_purge, soft_purge, + [snmpm_net_if, snmpm_mpd, snmpm_config]}, + {update, snmpm_net_if, soft, soft_purge, soft_purge, + [snmp_conf, snmpm_mpd, snmpm_config]} + ] + }, + {"4.20", + [ + {load_module, snmp_view_based_acm_mib, soft_purge, soft_purge, []}, + {load_module, snmp_target_mib, soft_purge, soft_purge, [snmp_conf]}, + {load_module, snmpm, soft_purge, soft_purge, + [snmpm_server, snmpm_config, snmp_config]}, + {load_module, snmp_conf, soft_purge, soft_purge, []}, + {load_module, snmp_config, soft_purge, soft_purge, []}, + {load_module, snmpm_mpd, soft_purge, soft_purge, + [snmp_conf, snmp_config, snmpm_config]}, + {load_module, snmpa_mpd, soft_purge, soft_purge, + [snmp_conf, snmp_config]}, + {load_module, snmpa_conf, soft_purge, soft_purge, [snmp_config]}, + {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mpd]}, + {update, snmpm_config, soft, soft_purge, soft_purge, [snmp_conf]}, + {update, snmpm_server, soft, soft_purge, soft_purge, + [snmpm_net_if, snmpm_mpd, snmpm_config]}, + {update, snmpm_net_if, soft, soft_purge, soft_purge, + [snmp_conf, snmpm_mpd, snmpm_config]} + ] + }, {"4.19", [ {load_module, snmpa, soft_purge, soft_purge, []}, - {load_module, snmpm, soft_purge, soft_purge, [snmpm_server]}, + {load_module, snmpm, soft_purge, soft_purge, + [snmpm_server, snmpm_config, snmp_config]}, {load_module, snmpa_usm, soft_purge, soft_purge, []}, {load_module, snmpm_usm, soft_purge, soft_purge, []}, {load_module, snmp_log, soft_purge, soft_purge, []}, {load_module, snmp_pdus, soft_purge, soft_purge, []}, {load_module, snmp_conf, soft_purge, soft_purge, []}, - {load_module, snmpa_conf, soft_purge, soft_purge, [snmp_conf]}, + {load_module, snmpa_conf, soft_purge, soft_purge, + [snmp_conf, snmp_config]}, {load_module, snmp_misc, soft_purge, soft_purge, []}, {load_module, snmp_config, soft_purge, soft_purge, []}, - {load_module, snmpa_mpd, soft_purge, soft_purge, [snmp_conf]}, + {load_module, snmpa_mpd, soft_purge, soft_purge, + [snmp_conf, snmp_config]}, + {load_module, snmpm_mpd, soft_purge, soft_purge, + [snmp_conf, snmp_config, snmpm_config]}, {load_module, snmpa_trap, soft_purge, soft_purge, [snmpa_mpd, snmp_notification_mib, snmp_target_mib, snmpa_net_if]}, {load_module, snmpa_acm, soft_purge, soft_purge, [snmp_conf, snmpa_mpd, snmp_target_mib]}, {load_module, snmpa_conf, soft_purge, soft_purge, - [snmp_notification_mib]}, + [snmp_config, snmp_notification_mib]}, + {load_module, snmp_view_based_acm_mib, soft_purge, soft_purge, []}, {load_module, snmp_notification_mib, soft_purge, soft_purge, [snmp_conf, snmp_target_mib]}, {load_module, snmp_community_mib, soft_purge, soft_purge, []}, {load_module, snmp_target_mib, soft_purge, soft_purge, [snmp_conf]}, - {update, snmpm_net_if, soft, soft_purge, soft_purge, []}, - {update, snmpm_server, soft, soft_purge, soft_purge, [snmpm_net_if]}, - {update, snmpa_net_if, soft, soft_purge, soft_purge, - [snmp_conf, snmpa_mpd]}, - {update, snmpa_agent, soft, soft_purge, soft_purge, - [snmpa_acm, snmpa_mpd, snmpa_trap]} - ] - }, - {"4.18", - [ - {load_module, snmpa, soft_purge, soft_purge, []}, - {load_module, snmpm, soft_purge, soft_purge, [snmpm_server]}, - {load_module, snmpa_usm, soft_purge, soft_purge, []}, - {load_module, snmpm_usm, soft_purge, soft_purge, []}, - {load_module, snmp_misc, soft_purge, soft_purge, []}, - {load_module, snmp_log, soft_purge, soft_purge, []}, - {load_module, snmp_pdus, soft_purge, soft_purge, []}, - {load_module, snmp_conf, soft_purge, soft_purge, []}, - {load_module, snmp_config, soft_purge, soft_purge, [snmp_conf]}, - {load_module, snmpa_conf, soft_purge, soft_purge, []}, - {load_module, snmpa_mpd, soft_purge, soft_purge, [snmp_conf]}, - {load_module, snmpa_vacm, soft_purge, soft_purge, []}, - {load_module, snmpa_trap, soft_purge, soft_purge, - [snmpa_mpd, snmp_notification_mib, snmp_target_mib, snmpa_net_if]}, - {load_module, snmpa_acm, soft_purge, soft_purge, - [snmp_conf, snmpa_mpd, snmp_target_mib]}, - {load_module, snmpa, soft_purge, soft_purge, - [snmp_community_mib, - snmp_framework_mib, - snmp_standard_mib, - snmp_target_mib, - snmp_user_based_sm_mib, - snmp_view_based_acm_mib]}, - {load_module, snmp_notification_mib, soft_purge, soft_purge, - [snmp_conf, snmp_target_mib, snmpa_mib_lib]}, - {load_module, snmp_community_mib, soft_purge, soft_purge, - [snmpa_mib_lib]}, - {load_module, snmp_framework_mib, soft_purge, soft_purge, - [snmpa_mib_lib]}, - {load_module, snmp_standard_mib, soft_purge, soft_purge, - [snmpa_mib_lib]}, - {load_module, snmp_target_mib, soft_purge, soft_purge, - [snmpa_mib_lib]}, - {load_module, snmp_user_based_sm_mib, soft_purge, soft_purge, - [snmpa_mib_lib]}, - {load_module, snmp_view_based_acm_mib, soft_purge, soft_purge, - [snmpa_mib_lib, snmpa_vacm]}, - {load_module, snmpa_mib_lib, soft_purge, soft_purge, []}, - - {update, snmpm_net_if, soft, soft_purge, soft_purge, []}, - {update, snmpm_server, soft, soft_purge, soft_purge, [snmpm_net_if]}, - + {update, snmpm_net_if, soft, soft_purge, soft_purge, + [snmp_conf, snmpm_mpd, snmpm_config]}, + {update, snmpm_config, soft, soft_purge, soft_purge, [snmp_conf]}, + {update, snmpm_server, soft, soft_purge, soft_purge, + [snmpm_net_if, snmpm_mpd, snmpm_config]}, {update, snmpa_net_if, soft, soft_purge, soft_purge, [snmp_conf, snmpa_mpd]}, {update, snmpa_agent, soft, soft_purge, soft_purge, @@ -109,84 +109,82 @@ %% ------D o w n g r a d e --------------------------------------------------- [ + {"4.20.1", + [ + {load_module, snmp_view_based_acm_mib, soft_purge, soft_purge, []}, + {load_module, snmpm, soft_purge, soft_purge, + [snmpm_server, snmpm_config, snmp_config]}, + {load_module, snmp_conf, soft_purge, soft_purge, []}, + {load_module, snmp_config, soft_purge, soft_purge, []}, + {load_module, snmpm_mpd, soft_purge, soft_purge, + [snmp_conf, snmp_config, snmpm_config]}, + {load_module, snmpa_mpd, soft_purge, soft_purge, + [snmp_conf, snmp_config]}, + {load_module, snmpa_conf, soft_purge, soft_purge, [snmp_config]}, + {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mpd]}, + {update, snmpm_config, soft, soft_purge, soft_purge, [snmp_conf]}, + {update, snmpm_server, soft, soft_purge, soft_purge, + [snmpm_net_if, snmpm_mpd, snmpm_config]}, + {update, snmpm_net_if, soft, soft_purge, soft_purge, + [snmp_conf, snmpm_mpd, snmpm_config]} + ] + }, + {"4.20", + [ + {load_module, snmp_view_based_acm_mib, soft_purge, soft_purge, []}, + {load_module, snmp_target_mib, soft_purge, soft_purge, [snmp_conf]}, + {load_module, snmpm, soft_purge, soft_purge, + [snmpm_server, snmpm_config, snmp_config]}, + {load_module, snmp_conf, soft_purge, soft_purge, []}, + {load_module, snmp_config, soft_purge, soft_purge, []}, + {load_module, snmpm_mpd, soft_purge, soft_purge, + [snmp_conf, snmp_config, snmpm_config]}, + {load_module, snmpa_mpd, soft_purge, soft_purge, + [snmp_conf, snmp_config]}, + {load_module, snmpa_conf, soft_purge, soft_purge, [snmp_config]}, + {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mpd]}, + {update, snmpm_config, soft, soft_purge, soft_purge, [snmp_conf]}, + {update, snmpm_server, soft, soft_purge, soft_purge, + [snmpm_net_if, snmpm_mpd, snmpm_config]}, + {update, snmpm_net_if, soft, soft_purge, soft_purge, + [snmp_conf, snmpm_mpd, snmpm_config]} + ] + }, {"4.19", [ {load_module, snmpa, soft_purge, soft_purge, []}, - {load_module, snmpm, soft_purge, soft_purge, [snmpm_server]}, + {load_module, snmpm, soft_purge, soft_purge, + [snmpm_server, snmpm_config, snmp_config]}, {load_module, snmpa_usm, soft_purge, soft_purge, []}, {load_module, snmpm_usm, soft_purge, soft_purge, []}, {load_module, snmp_log, soft_purge, soft_purge, []}, {load_module, snmp_pdus, soft_purge, soft_purge, []}, {load_module, snmp_conf, soft_purge, soft_purge, []}, - {load_module, snmpa_conf, soft_purge, soft_purge, [snmp_conf]}, + {load_module, snmpa_conf, soft_purge, soft_purge, + [snmp_conf, snmp_config]}, {load_module, snmp_misc, soft_purge, soft_purge, []}, {load_module, snmp_config, soft_purge, soft_purge, []}, - {load_module, snmpa_mpd, soft_purge, soft_purge, [snmp_conf]}, + {load_module, snmpa_mpd, soft_purge, soft_purge, + [snmp_conf, snmp_config]}, + {load_module, snmpm_mpd, soft_purge, soft_purge, + [snmp_conf, snmp_config, snmpm_config]}, {load_module, snmpa_trap, soft_purge, soft_purge, [snmpa_mpd, snmp_notification_mib, snmp_target_mib, snmpa_net_if]}, {load_module, snmpa_acm, soft_purge, soft_purge, [snmp_conf, snmpa_mpd, snmp_target_mib]}, {load_module, snmpa_conf, soft_purge, soft_purge, - [snmp_notification_mib]}, + [snmp_config, snmp_notification_mib]}, + {load_module, snmp_view_based_acm_mib, soft_purge, soft_purge, []}, {load_module, snmp_notification_mib, soft_purge, soft_purge, [snmp_conf, snmp_target_mib]}, {load_module, snmp_community_mib, soft_purge, soft_purge, []}, {load_module, snmp_target_mib, soft_purge, soft_purge, [snmp_conf]}, - - {update, snmpm_net_if, soft, soft_purge, soft_purge, []}, - {update, snmpm_server, soft, soft_purge, soft_purge, [snmpm_net_if]}, - - {update, snmpa_net_if, soft, soft_purge, soft_purge, - [snmp_conf, snmpa_mpd]}, - {update, snmpa_agent, soft, soft_purge, soft_purge, - [snmpa_acm, snmpa_mpd, snmpa_trap]} - ] - }, - {"4.18", - [ - {load_module, snmpa, soft_purge, soft_purge, []}, - {load_module, snmpm, soft_purge, soft_purge, [snmpm_server]}, - {load_module, snmpa_usm, soft_purge, soft_purge, []}, - {load_module, snmpm_usm, soft_purge, soft_purge, []}, - {load_module, snmp_misc, soft_purge, soft_purge, []}, - {load_module, snmp_log, soft_purge, soft_purge, []}, - {load_module, snmp_pdus, soft_purge, soft_purge, []}, - {load_module, snmp_conf, soft_purge, soft_purge, []}, - {load_module, snmpa_conf, soft_purge, soft_purge, [snmp_conf]}, - {load_module, snmp_config, soft_purge, soft_purge, []}, - {load_module, snmpa_mpd, soft_purge, soft_purge, [snmp_conf]}, - {load_module, snmpa_vacm, soft_purge, soft_purge, []}, - {load_module, snmpa_trap, soft_purge, soft_purge, - [snmpa_mpd, snmp_notification_mib, snmp_target_mib, snmpa_net_if]}, - {load_module, snmpa_acm, soft_purge, soft_purge, - [snmp_conf, snmpa_mpd, snmp_target_mib]}, - {load_module, snmpa, soft_purge, soft_purge, - [snmp_community_mib, - snmp_framework_mib, - snmp_standard_mib, - snmp_target_mib, - snmp_user_based_sm_mib, - snmp_view_based_acm_mib]}, - {load_module, snmp_notification_mib, soft_purge, soft_purge, - [snmp_conf, snmp_target_mib, snmpa_mib_lib]}, - {load_module, snmp_community_mib, soft_purge, soft_purge, - [snmpa_mib_lib]}, - {load_module, snmp_framework_mib, soft_purge, soft_purge, - [snmpa_mib_lib]}, - {load_module, snmp_standard_mib, soft_purge, soft_purge, - [snmpa_mib_lib]}, - {load_module, snmp_target_mib, soft_purge, soft_purge, - [snmpa_mib_lib]}, - {load_module, snmp_user_based_sm_mib, soft_purge, soft_purge, - [snmpa_mib_lib]}, - {load_module, snmp_view_based_acm_mib, soft_purge, soft_purge, - [snmpa_mib_lib, snmpa_vacm]}, - {load_module, snmpa_mib_lib, soft_purge, soft_purge, []}, - - {update, snmpm_net_if, soft, soft_purge, soft_purge, []}, - {update, snmpm_server, soft, soft_purge, soft_purge, [snmpm_net_if]}, - + {update, snmpm_net_if, soft, soft_purge, soft_purge, + [snmp_conf, snmpm_mpd, snmpm_config]}, + {update, snmpm_config, soft, soft_purge, soft_purge, [snmp_conf]}, + {update, snmpm_server, soft, soft_purge, soft_purge, + [snmpm_net_if, snmpm_mpd, snmpm_config]}, {update, snmpa_net_if, soft, soft_purge, soft_purge, [snmp_conf, snmpa_mpd]}, {update, snmpa_agent, soft, soft_purge, soft_purge, diff --git a/lib/snmp/src/compile/Makefile b/lib/snmp/src/compile/Makefile index 0ceaf276a6..627af6f185 100644 --- a/lib/snmp/src/compile/Makefile +++ b/lib/snmp/src/compile/Makefile @@ -45,11 +45,10 @@ RELSYSDIR = $(RELEASE_PATH)/lib/snmp-$(VSN) include modules.mk -ESCRIPT_BIN = $(ESCRIPT_SRC:%.src=$(BIN)/%) - -ERL_FILES = $(MODULES:%=%.erl) - -TARGET_FILES = $(MODULES:%=$(EBIN)/%.$(EMULATOR)) $(ESCRIPT_BIN) +ESCRIPT_BIN = $(ESCRIPT_SRC:%.src=$(BIN)/%) +ERL_FILES = $(MODULES:%=%.erl) +EBIN_FILES = $(MODULES:%=$(EBIN)/%.$(EMULATOR)) +TARGET_FILES = $(EBIN_FILES) $(ESCRIPT_BIN) GENERATED_PARSER = $(PARSER_MODULE:%=%.erl) @@ -125,7 +124,7 @@ release_spec: opt $(INSTALL_DIR) $(RELSYSDIR)/src/compiler $(INSTALL_DATA) $(ESCRIPT_SRC) $(PARSER_SRC) $(ERL_FILES) $(INTERNAL_HRL_FILES) $(RELSYSDIR)/src/compiler $(INSTALL_DIR) $(RELSYSDIR)/ebin - $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin + $(INSTALL_DATA) $(EBIN_FILES) $(RELSYSDIR)/ebin $(INSTALL_DIR) $(RELSYSDIR)/bin $(INSTALL_SCRIPT) $(ESCRIPT_BIN) $(RELSYSDIR)/bin diff --git a/lib/snmp/src/compile/snmpc.erl b/lib/snmp/src/compile/snmpc.erl index 195c238184..5e6b81f1ec 100644 --- a/lib/snmp/src/compile/snmpc.erl +++ b/lib/snmp/src/compile/snmpc.erl @@ -108,6 +108,7 @@ compile(FileName) -> %% {i, [import_dir_string()]} ["./"] %% {il, [import_lib_dir_string()]} [] %% {warnings, bool()} true +%% warnings_as_errors %% {outdir, string()} "./" %% description %% reference @@ -199,6 +200,8 @@ get_options([reference|Opts], Formats, Args) -> get_options(Opts, ["~n reference"|Formats], Args); get_options([{warnings, Val}|Opts], Formats, Args) -> get_options(Opts, ["~n warnings: ~w"|Formats], [Val|Args]); +get_options([warnings_as_errors|Opts], Formats, Args) -> + get_options(Opts, ["~n warnings_as_errors"|Formats], Args); get_options([{verbosity, Val}|Opts], Formats, Args) -> get_options(Opts, ["~n verbosity: ~w"|Formats], [Val|Args]); get_options([imports|Opts], Formats, Args) -> @@ -261,6 +264,8 @@ check_options([{group_check, Atom} | T]) when is_atom(Atom) -> check_options([{warnings, Bool} | T]) -> check_bool(warnings, Bool), check_options(T); +check_options([warnings_as_errors | T]) -> + check_options(T); check_options([{db, volatile} | T]) -> check_options(T); check_options([{db, persistent} | T]) -> @@ -331,6 +336,9 @@ get_agent_capabilities(Options) -> get_module_compliance(Options) -> get_bool_option(module_compliance, Options). +get_warnings_as_errors(Options) -> + lists:member(warnings_as_errors, Options). + get_relaxed_row_name_assign_check(Options) -> lists:member(relaxed_row_name_assign_check, Options). @@ -409,6 +417,7 @@ init(From, MibFileName, Options) -> put(reference, get_reference(Options)), put(agent_capabilities, get_agent_capabilities(Options)), put(module_compliance, get_module_compliance(Options)), + put(warnings_as_errors, get_warnings_as_errors(Options)), File = filename:rootname(MibFileName, ".mib"), put(filename, filename:basename(File ++ ".mib")), R = case catch c_impl(File) of diff --git a/lib/snmp/src/compile/snmpc.src b/lib/snmp/src/compile/snmpc.src index 5f9b154bfa..4e91ae9a03 100644 --- a/lib/snmp/src/compile/snmpc.src +++ b/lib/snmp/src/compile/snmpc.src @@ -50,7 +50,8 @@ %% The default verbosity (silence) will be filled in %% during argument processing. verbosity, - warnings = false + warnings = false, + warnings_as_errors = false }). @@ -74,6 +75,7 @@ %% --version %% --verbosity V %% --warnings +%% --wae main(Args) when is_list(Args) -> case (catch process_args(Args)) of ok -> @@ -156,7 +158,8 @@ mk_mib_options(#state{outdir = OutDir, %% The default verbosity (silence) will be filled in %% during argument processing. verbosity = V, - warnings = W}) -> + warnings = W, + warnings_as_errors = WAE}) -> [{outdir, OutDir}, {db, DB}, {i, IDs}, @@ -178,7 +181,8 @@ mk_mib_options(#state{outdir = OutDir, maybe_option(Imp, imports) ++ maybe_option(MI, module_identity) ++ maybe_option(MC, module_compliance) ++ - maybe_option(AC, agent_capabilities). + maybe_option(AC, agent_capabilities) ++ + maybe_option(WE, warnings_as_errors). maybe_option(true, Opt) -> [Opt]; maybe_option(_, _) -> []. @@ -292,6 +296,8 @@ process_args(["--nd"|Args], State) -> process_args(Args, State#state{no_defaults = true}); process_args(["--rrnac"|Args], State) -> process_args(Args, State#state{relaxed_row_name_assigne_check = true}); +process_args(["--wae"|Args], State) -> + process_args(Args, State#state{warnings_as_errors = true}); process_args([MIB], State) -> Ext = filename:extension(MIB), if @@ -371,6 +377,8 @@ usage() -> "~n a warning. " "~n By default it is not included, but if this option is " "~n present it will be. " + "~n --wae - Warnings as errors. " + "~n Indicates that warnings shall be treated as errors. " "~n " "~n", []), halt(1). diff --git a/lib/snmp/src/compile/snmpc_lib.hrl b/lib/snmp/src/compile/snmpc_lib.hrl index 000486e728..35ec9abd03 100644 --- a/lib/snmp/src/compile/snmpc_lib.hrl +++ b/lib/snmp/src/compile/snmpc_lib.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2009. All Rights Reserved. +%% Copyright Ericsson AB 2009-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -20,8 +20,17 @@ -ifndef(snmpc_lib). -define(snmpc_lib, true). --define(vwarning(F, A), ?verbosity(warning, F, A, ignore)). --define(vwarning2(F, A, MibLine), ?verbosity(warning, F, A, MibLine)). +-define(vwarning(F, A), + case get(warnings_as_errors) of + true -> snmpc_lib:error(F, A); + _ -> ?verbosity(warning, F, A, ignore) + end). + +-define(vwarning2(F, A, MibLine), + case get(warnings_as_errors) of + true -> snmpc_lib:error(F, A, MibLine); + _ -> ?verbosity(warning, F, A, MibLine) + end). -define(vinfo(F, A), ?verbosity(info, F, A, ignore)). -define(vinfo2(F, A, MibLine), ?verbosity(info, F, A, MibLine)). -define(vlog(F, A), ?verbosity(log, F, A, ignore)). diff --git a/lib/snmp/src/manager/snmpm.erl b/lib/snmp/src/manager/snmpm.erl index 0d084332de..6d2ac8d747 100644 --- a/lib/snmp/src/manager/snmpm.erl +++ b/lib/snmp/src/manager/snmpm.erl @@ -50,7 +50,7 @@ register_agent/2, register_agent/3, register_agent/4, unregister_agent/2, unregister_agent/3, which_agents/0, which_agents/1, - agent_info/2, update_agent_info/4, + agent_info/2, update_agent_info/3, update_agent_info/4, register_usm_user/3, unregister_usm_user/2, which_usm_users/0, which_usm_users/1, @@ -167,6 +167,7 @@ -include_lib("snmp/include/snmp_types.hrl"). -include("snmpm_atl.hrl"). -include("snmpm_internal.hrl"). +-include("snmp_verbosity.hrl"). -define(DEFAULT_AGENT_PORT, 161). @@ -447,8 +448,11 @@ agent_info(Addr, Port, Item) -> Error end. +update_agent_info(UserId, TargetName, Info) when is_list(Info) -> + snmpm_config:update_agent_info(UserId, TargetName, Info). + update_agent_info(UserId, TargetName, Item, Val) -> - snmpm_config:update_agent_info(UserId, TargetName, Item, Val). + update_agent_info(UserId, TargetName, [{Item, Val}]). %% Backward compatibility functions update_agent_info(UserId, Addr, Port, Item, Val) -> diff --git a/lib/snmp/src/manager/snmpm_config.erl b/lib/snmp/src/manager/snmpm_config.erl index fd6da3e71a..c2e57abddb 100644 --- a/lib/snmp/src/manager/snmpm_config.erl +++ b/lib/snmp/src/manager/snmpm_config.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2010. All Rights Reserved. +%% Copyright Ericsson AB 2004-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -36,7 +36,8 @@ user_info/0, user_info/1, user_info/2, register_agent/3, unregister_agent/2, - agent_info/0, agent_info/2, agent_info/3, update_agent_info/4, + agent_info/0, agent_info/2, agent_info/3, + update_agent_info/3, update_agent_info/4, which_agents/0, which_agents/1, is_known_engine_id/2, @@ -84,7 +85,9 @@ backup/1, - mk_target_name/3 + mk_target_name/3, + + default_transport_domain/0 ]). @@ -127,23 +130,24 @@ %% Macros and Constants: --define(SERVER, ?MODULE). --define(BACKUP_DB, snmpm_config_backup). --define(CONFIG_DB, snmpm_config_db). +-define(SERVER, ?MODULE). +-define(BACKUP_DB, snmpm_config_backup). +-define(CONFIG_DB, snmpm_config_db). -define(DEFAULT_USER, default_user). -define(DEFAULT_AGENT_PORT, 161). --define(IRB_DEFAULT, auto). -%% -define(IRB_DEFAULT, {user, timer:seconds(15)}). +-define(IRB_DEFAULT, auto). +%% -define(IRB_DEFAULT, {user, timer:seconds(15)}). --define(USER_MOD_DEFAULT, snmpm_user_default). --define(USER_DATA_DEFAULT, undefined). +-define(USER_MOD_DEFAULT, snmpm_user_default). +-define(USER_DATA_DEFAULT, undefined). %% -define(DEF_ADDR_TAG, default_addr_tag). -define(DEFAULT_TARGETNAME, default_agent). --define(DEF_PORT_TAG, default_port_tag). +-define(DEF_PORT_TAG, default_port_tag). +-define(SUPPORTED_DOMAINS, [transportDomainUdpIpv4, transportDomainUdpIpv6]). -ifdef(snmp_debug). -define(GS_START_LINK(Opts), @@ -159,6 +163,11 @@ %%%------------------------------------------------------------------- %%% API %%%------------------------------------------------------------------- + +default_transport_domain() -> + transportDomainUdpIpv4. + + start_link(Opts) -> ?d("start_link -> entry with" "~n Opts: ~p", [Opts]), @@ -269,9 +278,10 @@ do_user_info(_UserId, BadItem) -> error({not_found, BadItem}). -%% A target-name constructed in this way is a string with the following +%% A target-name constructed in this way is a string with the following: %% <IP-address>:<Port>-<Version> -%% +%% This is intended for backward compatibility and therefor has +%% only support for IPv4 addresses and *no* other transport domain. mk_target_name(Addr0, Port, Config) when is_list(Config) -> Version = case lists:keysearch(version, 1, Config) of @@ -280,7 +290,6 @@ mk_target_name(Addr0, Port, Config) when is_list(Config) -> false -> select_lowest_supported_version() end, -%% p("mk_target_name -> Version: ~p", [Version]), case normalize_address(Addr0) of {A, B, C, D} -> lists:flatten( @@ -308,57 +317,99 @@ select_lowest_supported_version([H|T], Versions) -> end. -register_agent(UserId, _TargetName, _Config) when (UserId =:= user_id) -> +register_agent(UserId, _TargetName, _Config0) when (UserId =:= user_id) -> {error, {bad_user_id, UserId}}; -register_agent(UserId, TargetName, Config) +register_agent(UserId, TargetName, Config0) when (is_list(TargetName) andalso (length(TargetName) > 0) andalso - is_list(Config)) -> + is_list(Config0)) -> -%% p("register_agent -> entry with" -%% "~n UserId: ~p" -%% "~n TargetName: ~p" -%% "~n Config: ~p", [UserId, TargetName, Config]), + ?vtrace("register_agent -> entry with" + "~n UserId: ~p" + "~n TargetName: ~p" + "~n Config0: ~p", [UserId, TargetName, Config0]), %% Check: %% 1) That the mandatory configs are present - %% 2) That the illegal config user_id (used internally) is - %% not present + %% 2) That no illegal config, e.g. user_id (used internally), + %% is not present %% 3) Check that there are no invalid or erroneous configs - %% 4) Chack that the manager is capable to use the selected version - case verify_agent_config(Config) of - ok -> + %% 4) Check that the manager is capable of using the selected version + case verify_agent_config(Config0) of + {ok, Config} -> call({register_agent, UserId, TargetName, Config}); Error -> Error end. -verify_agent_config(Conf) -> - ok = verify_mandatory(Conf, [engine_id, address, reg_type]), - case verify_invalid(Conf, [user_id]) of - ok -> - case verify_agent_config2(Conf) of - ok -> - {ok, Vsns} = system_info(versions), - Vsn = - case lists:keysearch(version, 1, Conf) of - {value, {version, V}} -> - V; - false -> - v1 - end, - case lists:member(Vsn, Vsns) of - true -> - ok; - false -> - {error, {version_not_supported_by_manager, Vsn, Vsns}} - end - end; - Error -> +verify_agent_config(Conf0) -> + try + begin + verify_mandatory(Conf0, [engine_id, address, reg_type]), + verify_invalid(Conf0, [user_id]), + Conf = verify_agent_config3(Conf0), + Vsns = versions(), + Vsn = which_version(Conf), + verify_version(Vsn, Vsns), + {ok, Conf} + end + catch + throw:Error -> Error end. +versions() -> + case system_info(versions) of + {ok, Vsns} -> + Vsns; + {error, _} = ERROR -> + throw(ERROR) + end. + +which_version(Conf) -> + case lists:keysearch(version, 1, Conf) of + {value, {version, V}} -> + V; + false -> + v1 + end. + +verify_version(Vsn, Vsns) -> + case lists:member(Vsn, Vsns) of + true -> + ok; + false -> + Reason = {version_not_supported_by_manager, Vsn, Vsns}, + throw({error, Reason}) + end. + +verify_agent_config3(Conf0) -> + %% Fix (transport) address and domain + {TDomain, Conf1} = + case lists:keysearch(tdomain, 1, Conf0) of + {value, {tdomain, Dom}} -> + {Dom, Conf0}; + false -> + Dom = default_transport_domain(), + {Dom, [{tdomain, Dom} | Conf0]} + end, + Conf2 = case lists:keysearch(address, 1, Conf1) of + {value, {address, Address}} -> + lists:keyreplace(address, 1, Conf1, + {address, {TDomain, Address}}); + false -> + %% This is a mandatory config option, + %% a later test will detect this + Conf1 + end, + case verify_agent2(Conf2) of + {ok, Conf} -> + Conf; + {error, _} = ERROR -> + throw(ERROR) + end. + verify_agent_config2(Conf) -> verify_agent2(Conf). @@ -366,6 +417,7 @@ verify_agent_config2(Conf) -> unregister_agent(UserId, TargetName) -> call({unregister_agent, UserId, TargetName}). +%% This is the old style agent unregistration (using Addr and Port). unregister_agent(UserId, Addr0, Port) -> Addr = normalize_address(Addr0), case do_agent_info(Addr, Port, target_name) of @@ -421,17 +473,51 @@ which_agents(UserId) -> Agents = ets:match(snmpm_agent_table, Pat), [TargetName || [TargetName] <- Agents]. - -update_agent_info(UserId, TargetName, Item, Val0) - when (Item =/= user_id) -> - case (catch verify_val(Item, Val0)) of - {ok, Val} -> - call({update_agent_info, UserId, TargetName, Item, Val}); - Error -> + +verify_agent_info(TargetName, Info0) -> + try + begin + verify_invalid(Info0, [user_id]), + %% Check if address is part of the list and + %% if so update it with the domain info. + Info = + case lists:keysearch(address, 1, Info0) of + {value, {address, Addr}} -> + %% If domain is part of the info, then use it. + %% If not, lookup what is already stored for + %% this agent and use that. + Domain = + case lists:keysearch(tdomain, 1, Info0) of + {value, {tdomain, Dom}} -> + Dom; + false -> + {ok, Dom} = + agent_info(TargetName, tdomain), + Dom + end, + Addr2 = {Domain, Addr}, + lists:keyreplace(address, 1, Info0, {address, Addr2}); + false -> + Info0 + end, + verify_agent2(Info) + end + catch + throw:Error -> Error end. -%% Backward compatibillity +update_agent_info(UserId, TargetName, Info) -> + call({update_agent_info, UserId, TargetName, Info}). + +%% <BACKWARD-COMPAT-2> +%% This is wrapped in the interface module, so this function is +%% only here to catch code-upgrade problems. +update_agent_info(UserId, TargetName, Item, Val) -> + update_agent_info(UserId, TargetName, [{Item, Val}]). +%% </BACKWARD-COMPAT-2> + +%% <BACKWARD-COMPAT-1> update_agent_info(UserId, Addr, Port, Item, Val) -> case agent_info(Addr, Port, target_name) of {ok, TargetName} -> @@ -439,6 +525,7 @@ update_agent_info(UserId, Addr, Port, Item, Val) -> Error -> Error end. +%% </BACKWARD-COMPAT-1> is_known_engine_id(EngineID, TargetName) -> case agent_info(TargetName, engine_id) of @@ -650,22 +737,14 @@ unregister_usm_user(EngineID, Name) call({unregister_usm_user, EngineID, Name}). verify_usm_user_config(EngineID, Name, Config) -> - %% case verify_mandatory(Config, []) of - %% ok -> - %% case verify_invalid(Config, [engine_id, name]) of - %% ok -> - %% verify_usm_user_config2(EngineID, Name, Config); - %% Error -> - %% Error - %% end; - %% Error -> - %% Error - %% end. - ok = verify_mandatory(Config, []), - case verify_invalid(Config, [engine_id, name]) of - ok -> - verify_usm_user_config2(EngineID, Name, Config); - Error -> + try + begin + verify_mandatory(Config, []), + verify_invalid(Config, [engine_id, name]), + verify_usm_user_config2(EngineID, Name, Config) + end + catch + throw:Error -> Error end. @@ -1590,6 +1669,7 @@ check_agent_config2(Agent) -> throw(Err) end. +%% For backward compatibility check_agent_config({UserId, TargetName, Community, @@ -1597,10 +1677,27 @@ check_agent_config({UserId, EngineId, Timeout, MaxMessageSize, Version, SecModel, SecName, SecLevel}) -> + TDomain = default_transport_domain(), + check_agent_config({UserId, + TargetName, + Community, + TDomain, Ip, Port, + EngineId, + Timeout, MaxMessageSize, + Version, SecModel, SecName, SecLevel}); + +check_agent_config({UserId, + TargetName, + Community, + TDomain, Ip, Port, + EngineId, + Timeout, MaxMessageSize, + Version, SecModel, SecName, SecLevel}) -> ?vtrace("check_agent_config -> entry with" "~n UserId: ~p" "~n TargetName: ~p" "~n Community: ~p" + "~n TDomain: ~p" "~n Ip: ~p" "~n Port: ~p" "~n EngineId: ~p" @@ -1610,15 +1707,16 @@ check_agent_config({UserId, "~n SecModel: ~p" "~n SecName: ~p" "~n SecLevel: ~p", - [UserId, TargetName, Community, Ip, Port, + [UserId, TargetName, Community, + TDomain, Ip, Port, EngineId, Timeout, MaxMessageSize, Version, SecModel, SecName, SecLevel]), - Addr = normalize_address(Ip), + Addr = normalize_address(TDomain, Ip), ?vtrace("check_agent_config -> Addr: ~p", [Addr]), Agent = {UserId, TargetName, Community, - Addr, Port, + TDomain, Addr, Port, EngineId, Timeout, MaxMessageSize, Version, SecModel, SecName, SecLevel}, @@ -1644,6 +1742,7 @@ init_agent_config({UserId, TargetName, Config}) -> end. +%% For backward compatibility verify_agent({UserId, TargetName, Comm, @@ -1651,48 +1750,68 @@ verify_agent({UserId, EngineId, Timeout, MMS, Version, SecModel, SecName, SecLevel}) -> - ?vtrace("verify_agent -> entry with" + TDomain = default_transport_domain(), + verify_agent({UserId, + TargetName, + Comm, + TDomain, Ip, Port, + EngineId, + Timeout, MMS, + Version, SecModel, SecName, SecLevel}); + +verify_agent({UserId, + TargetName, + Comm, + TDomain, Ip, Port, + EngineId, + Timeout, MMS, + Version, SecModel, SecName, SecLevel}) -> + ?vdebug("verify_agent -> entry with" "~n UserId: ~p" "~n TargetName: ~p", [UserId, TargetName]), snmp_conf:check_string(TargetName, {gt, 0}), - case verify_val(address, Ip) of - {ok, Addr} -> - snmp_conf:check_integer(Port, {gt, 0}), - Conf = - [{reg_type, target_name}, - {address, Addr}, - {port, Port}, - {community, Comm}, - {engine_id, EngineId}, - {timeout, Timeout}, - {max_message_size, MMS}, - {version, Version}, - {sec_model, SecModel}, - {sec_name, SecName}, - {sec_level, SecLevel} - ], - case verify_agent2(Conf) of - ok -> - {UserId, TargetName, Conf, Version}; - Err -> - throw(Err) - end; - - Error -> - ?vlog("verify_agent -> failed: ~n ~p", [Error]), - throw(Error) + snmp_conf:check_integer(Port, {gt, 0}), + %% Note that the order of Conf *is* important. + %% Some properties may depend on others, so that + %% in order to verify one property, another must + %% be already verified (and present). An example + %% of this is the property 'address', for which + %% the property tdomain is needed. + Conf0 = + [{reg_type, target_name}, + {tdomain, TDomain}, + %% This should be taddress, but what the*... + {address, {TDomain, Ip}}, + {port, Port}, + {community, Comm}, + {engine_id, EngineId}, + {timeout, Timeout}, + {max_message_size, MMS}, + {version, Version}, + {sec_model, SecModel}, + {sec_name, SecName}, + {sec_level, SecLevel} + ], + case verify_agent2(Conf0) of + {ok, Conf} -> + {UserId, TargetName, Conf, Version}; + Err -> + throw(Err) end. -verify_agent2([]) -> - ok; -verify_agent2([{Item, Val}|Items]) -> - case verify_val(Item, Val) of - {ok, _Val} -> - verify_agent2(Items); +verify_agent2(Conf) -> + verify_agent2(Conf, []). + +verify_agent2([], VerifiedConf) -> + {ok, VerifiedConf}; +verify_agent2([{Item, Val0}|Items], VerifiedConf) -> + case verify_val(Item, Val0) of + {ok, Val} -> + verify_agent2(Items, [{Item, Val} | VerifiedConf]); Err -> Err end; -verify_agent2([Bad|_]) -> +verify_agent2([Bad|_], _VerifiedConf) -> {error, {bad_agent_config, Bad}}. @@ -1708,14 +1827,28 @@ read_users_config_file(Dir) -> check_user_config({Id, Mod, Data}) -> + ?vtrace("check_user_config -> entry with" + "~n Id: ~p" + "~n Mod: ~p" + "~n Data: ~p", [Id, Mod, Data]), check_user_config({Id, Mod, Data, []}); -check_user_config({Id, Mod, _Data, DefaultAgentConfig} = User) +check_user_config({Id, Mod, Data, DefaultAgentConfig} = _User) when (Id =/= ?DEFAULT_USER) andalso is_list(DefaultAgentConfig) -> + ?vtrace("check_user_config -> entry with" + "~n Id: ~p" + "~n Mod: ~p" + "~n Data: ~p" + "~n DefaultAgentConfig: ~p", + [Id, Mod, Data, DefaultAgentConfig]), case (catch verify_user_behaviour(Mod)) of ok -> + ?vtrace("check_user_config -> user behaviour verified", []), case verify_user_agent_config(DefaultAgentConfig) of - ok -> - {ok, User}; + {ok, DefAgentConf} -> + ?vtrace("check_user_config -> " + "user agent (default) config verified", []), + User2 = {Id, Mod, Data, DefAgentConf}, + {ok, User2}; {error, Reason} -> error({bad_default_agent_config, Reason}) end; @@ -1756,16 +1889,16 @@ verify_user({Id, UserMod, UserData}) -> verify_user({Id, UserMod, UserData, DefaultAgentConfig}) when (Id =/= ?DEFAULT_USER) andalso is_list(DefaultAgentConfig) -> ?d("verify_user -> entry with" - "~n Id: ~p" - "~n UserMod: ~p" - "~n UserData: ~p" + "~n Id: ~p" + "~n UserMod: ~p" + "~n UserData: ~p" "~n DefaultAgentConfig: ~p", [Id, UserMod, UserData, DefaultAgentConfig]), case (catch verify_user_behaviour(UserMod)) of ok -> case verify_user_agent_config(DefaultAgentConfig) of - ok -> - Config = default_agent_config(DefaultAgentConfig), + {ok, DefAgentConf} -> + Config = default_agent_config(DefAgentConf), {ok, #user{id = Id, mod = UserMod, data = UserData, @@ -1783,10 +1916,15 @@ verify_user({Id, _, _, _}) -> {error, {bad_user_id, Id}}. verify_user_agent_config(Conf) -> - case verify_invalid(Conf, [user_id, engine_id, address]) of - ok -> - verify_agent_config2(Conf); - Error -> + try + begin + verify_invalid(Conf, [user_id, engine_id, address]), + verify_agent_config2(Conf) + end + catch + throw:Error -> + ?vdebug("verify_user_agent_config -> throw" + "~n Error: ~p", [Error]), Error end. @@ -2147,6 +2285,16 @@ handle_call({unregister_agent, UserId, TargetName}, _From, State) -> Reply = handle_unregister_agent(UserId, TargetName), {reply, Reply, State}; +handle_call({update_agent_info, UserId, TargetName, Info}, + _From, State) -> + ?vlog("received update_agent_info request: " + "~n UserId: ~p" + "~n TargetName: ~p" + "~n Info: ~p", [UserId, TargetName, Info]), + Reply = handle_update_agent_info(UserId, TargetName, Info), + {reply, Reply, State}; + +%% <BACKWARD-COMPAT> handle_call({update_agent_info, UserId, TargetName, Item, Val}, _From, State) -> ?vlog("received update_agent_info request: " @@ -2156,6 +2304,7 @@ handle_call({update_agent_info, UserId, TargetName, Item, Val}, "~n Val: ~p", [UserId, TargetName, Item, Val]), Reply = handle_update_agent_info(UserId, TargetName, Item, Val), {reply, Reply, State}; +%% </BACKWARD-COMPAT> handle_call({register_usm_user, User}, _From, State) -> ?vlog("received register_usm_user request: " @@ -2517,16 +2666,27 @@ handle_register_agent(UserId, TargetName, Config) -> "~n Config: ~p", [UserId, TargetName, Config]), case (catch agent_info(TargetName, user_id)) of {error, _} -> + ?vtrace("handle_register_agent -> user_id not found in config", []), case ets:lookup(snmpm_user_table, UserId) of [#user{default_agent_config = DefConfig}] -> + ?vtrace("handle_register_agent -> " + "~n DefConfig: ~p", [DefConfig]), + %% First, insert this users default config + ?vtrace("handle_register_agent -> store default config", []), do_handle_register_agent(TargetName, DefConfig), + %% Second, insert the config for this agent + ?vtrace("handle_register_agent -> store config", []), do_handle_register_agent(TargetName, [{user_id, UserId}|Config]), %% <DIRTY-BACKWARD-COMPATIBILLITY> %% And now for some (backward compatibillity) %% dirty crossref stuff + ?vtrace("handle_register_agent -> lookup address", []), {ok, Addr} = agent_info(TargetName, address), + ?vtrace("handle_register_agent -> Addr: ~p, lookup Port", + [Addr]), {ok, Port} = agent_info(TargetName, port), + ?vtrace("handle_register_agent -> register cross-ref fix", []), ets:insert(snmpm_agent_table, {{Addr, Port, target_name}, TargetName}), %% </DIRTY-BACKWARD-COMPATIBILLITY> @@ -2551,10 +2711,18 @@ handle_register_agent(UserId, TargetName, Config) -> do_handle_register_agent(_TargetName, []) -> ok; do_handle_register_agent(TargetName, [{Item, Val}|Rest]) -> + ?vtrace("handle_register_agent -> entry with" + "~n TargetName: ~p" + "~n Item: ~p" + "~n Val: ~p" + "~n Rest: ~p", [TargetName, Item, Val, Rest]), case (catch do_update_agent_info(TargetName, Item, Val)) of ok -> do_handle_register_agent(TargetName, Rest); {error, Reason} -> + ?vtrace("handle_register_agent -> failed updating ~p" + "~n Item: ~p" + "~n Reason: ~p", [Item, Reason]), ets:match_delete(snmpm_agent_table, {TargetName, '_'}), {error, Reason} end; @@ -2589,41 +2757,61 @@ handle_unregister_agent(UserId, TargetName) -> end. -handle_update_agent_info(UserId, TargetName, Item, Val) -> +handle_update_agent_info(UserId, TargetName, Info) -> ?vdebug("handle_update_agent_info -> entry with" "~n UserId: ~p" "~n TargetName: ~p" - "~n Item: ~p" - "~n Val: ~p", [UserId, TargetName, Item, Val]), + "~n Info: ~p", [UserId, TargetName, Info]), + %% Verify ownership case (catch agent_info(TargetName, user_id)) of - {ok, UserId} -> - do_update_agent_info(TargetName, Item, Val); + {ok, UserId} -> + handle_update_agent_info(TargetName, Info); {ok, OtherUserId} -> {error, {not_owner, OtherUserId}}; Error -> Error end. -do_update_agent_info(TargetName, Item, Val0) -> -%% p("do_update_agent_info -> entry with" -%% "~n TargetName: ~p" -%% "~n Item: ~p" -%% "~n Val0: ~p", [TargetName, Item, Val0]), - case verify_val(Item, Val0) of - {ok, Val} -> -%% p("do_update_agent_info -> verified value" -%% "~n Val: ~p", [Val]), - ets:insert(snmpm_agent_table, {{TargetName, Item}, Val}), - ok; +handle_update_agent_info(TargetName, Info0) -> + ?vtrace("handle_update_agent_info -> entry with" + "~n TargetName: ~p" + "~n Info0: ~p", [TargetName, Info0]), + %% Verify info + try verify_agent_info(TargetName, Info0) of + {ok, Info} -> + do_update_agent_info(TargetName, Info); Error -> - ?vlog("do_update_agent_info -> verify value failed: " - "~n TargetName: ~p" - "~n Item: ~p" - "~n Val0: ~p" - "~n Error: ~p", [TargetName, Item, Val0, Error]), - {error, {bad_agent_val, TargetName, Item, Val0}} + Error + catch + throw:Error -> + Error; + T:E -> + {error, {failed_info_verification, Info0, T, E}} end. +handle_update_agent_info(UserId, TargetName, Item, Val) -> + ?vdebug("handle_update_agent_info -> entry with" + "~n UserId: ~p" + "~n TargetName: ~p" + "~n Item: ~p" + "~n Val: ~p", [UserId, TargetName, Item, Val]), + handle_update_agent_info(TargetName, [{Item, Val}]). + +do_update_agent_info(TargetName, Info) -> + InsertItem = + fun({Item, Val}) -> + ets:insert(snmpm_agent_table, {{TargetName, Item}, Val}) + end, + lists:foreach(InsertItem, Info). + +do_update_agent_info(TargetName, Item, Val) -> + ?vtrace("do_update_agent_info -> entry with" + "~n TargetName: ~p" + "~n Item: ~p" + "~n Val: ~p", [TargetName, Item, Val]), + ets:insert(snmpm_agent_table, {{TargetName, Item}, Val}), + ok. + handle_register_usm_user(#usm_user{engine_id = EngineID, name = Name} = User) -> @@ -2791,7 +2979,7 @@ verify_mandatory(Conf, [Mand|Mands]) -> true -> verify_mandatory(Conf, Mands); false -> - {error, {missing_mandatory_config, Mand}} + throw({error, {missing_mandatory_config, Mand}}) end. verify_invalid(_, []) -> @@ -2801,7 +2989,7 @@ verify_invalid(Conf, [Inv|Invs]) -> false -> verify_invalid(Conf, Invs); true -> - {error, {illegal_config, Inv}} + throw({error, {illegal_config, Inv}}) end. @@ -2810,10 +2998,26 @@ verify_val(user_id, UserId) -> verify_val(reg_type, RegType) when (RegType =:= addr_port) orelse (RegType =:= target_name) -> {ok, RegType}; -verify_val(address, Addr0) -> - case normalize_address(Addr0) of +verify_val(tdomain = Item, snmpUDPDomain = _Domain) -> + verify_val(Item, transportDomainUdpIpv4); +verify_val(tdomain, Domain) -> + case lists:member(Domain, ?SUPPORTED_DOMAINS) of + true -> + {ok, Domain}; + false -> + case lists:member(Domain, snmp_conf:all_domains()) of + true -> + error({unsupported_domain, Domain}); + false -> + error({unknown_domain, Domain}) + end + end; +verify_val(address, {Domain, Addr0}) -> + case normalize_address(Domain, Addr0) of {_A1, _A2, _A3, _A4} = Addr -> {ok, Addr}; + {_A1, _A2, _A3, _A4, _A5, _A6, _A7, _A8} = Addr -> + {ok, Addr}; _ when is_list(Addr0) -> case (catch snmp_conf:check_ip(Addr0)) of ok -> @@ -2824,6 +3028,8 @@ verify_val(address, Addr0) -> _ -> error({bad_address, Addr0}) end; +verify_val(address, BadAddress) -> + error({bad_address, BadAddress}); verify_val(port, Port) -> case (catch snmp_conf:check_integer(Port, {gt, 0})) of ok -> @@ -2875,7 +3081,7 @@ verify_val(sec_name, BadName) -> verify_val(sec_level, Level) -> (catch snmp_conf:check_sec_level(Level)); verify_val(Item, _) -> - {error, {no_such_item, Item}}. + {error, {unknown_item, Item}}. %%%------------------------------------------------------------------- @@ -3034,11 +3240,17 @@ init_mini_mib_elems(MibName, [_|T], Res) -> %%---------------------------------------------------------------------- normalize_address(Addr) -> - case inet:getaddr(Addr, inet) of + normalize_address(snmpUDPDomain, Addr). + +normalize_address(snmpUDPDomain, Addr) -> + normalize_address(transportDomainUdpIpv4, Addr); + +normalize_address(Domain, Addr) -> + case inet:getaddr(Addr, td2fam(Domain)) of {ok, Addr2} -> Addr2; _ when is_list(Addr) -> - case (catch snmp_conf:check_ip(Addr)) of + case (catch snmp_conf:check_ip(Domain, Addr)) of ok -> list_to_tuple(Addr); _ -> @@ -3048,6 +3260,9 @@ normalize_address(Addr) -> Addr end. +td2fam(transportDomainUdpIpv4) -> inet; +td2fam(transportDomainUdpIpv6) -> inet6. + %%---------------------------------------------------------------------- diff --git a/lib/snmp/src/manager/snmpm_mpd.erl b/lib/snmp/src/manager/snmpm_mpd.erl index 7712370d28..627838e3d4 100644 --- a/lib/snmp/src/manager/snmpm_mpd.erl +++ b/lib/snmp/src/manager/snmpm_mpd.erl @@ -92,7 +92,7 @@ reset(#state{v3 = V3}) -> %% Purpose: This is the main Message Dispatching function. (see %% section 4.2.1 in rfc2272) %%----------------------------------------------------------------- -process_msg(Msg, TDomain, Addr, Port, State, NoteStore, Logger) -> +process_msg(Msg, Domain, Addr, Port, State, NoteStore, Logger) -> inc(snmpInPkts), @@ -102,18 +102,18 @@ process_msg(Msg, TDomain, Addr, Port, State, NoteStore, Logger) -> #message{version = 'version-1', vsn_hdr = Community, data = Data} when State#state.v1 =:= true -> HS = ?empty_msg_size + length(Community), - process_v1_v2c_msg('version-1', NoteStore, Msg, TDomain, - Addr, Port, + process_v1_v2c_msg('version-1', NoteStore, Msg, + Domain, Addr, Port, Community, Data, HS, Logger); %% Version 2 #message{version = 'version-2', vsn_hdr = Community, data = Data} when State#state.v2c =:= true -> HS = ?empty_msg_size + length(Community), - process_v1_v2c_msg('version-2', NoteStore, Msg, TDomain, - Addr, Port, - Community, Data, HS, Logger); - + (catch process_v1_v2c_msg('version-2', NoteStore, Msg, + Domain, Addr, Port, + Community, Data, HS, Logger)); + %% Version 3 #message{version = 'version-3', vsn_hdr = H, data = Data} when State#state.v3 =:= true -> @@ -148,17 +148,30 @@ process_msg(Msg, TDomain, Addr, Port, State, NoteStore, Logger) -> %%----------------------------------------------------------------- %% Handles a Community based message (v1 or v2c). %%----------------------------------------------------------------- -process_v1_v2c_msg(Vsn, _NoteStore, Msg, snmpUDPDomain, +process_v1_v2c_msg(Vsn, _NoteStore, Msg, Domain, Addr, Port, Community, Data, HS, Log) -> ?vdebug("process_v1_v2c_msg -> entry with" "~n Vsn: ~p" + "~n Domain: ~p" "~n Addr: ~p" "~n Port: ~p" "~n Community: ~p" - "~n HS: ~p", [Vsn, Addr, Port, Community, HS]), + "~n HS: ~p", [Vsn, Domain, Addr, Port, Community, HS]), + {TDomain, TAddress} = + try + begin + TD = snmp_conf:mk_tdomain(Domain), + TA = snmp_conf:mk_taddress(Domain, Addr, Port), + {TD, TA} + end + catch + throw:{error, TReason} -> + throw({discarded, {badarg, Domain, TReason}}) + end, + Max = get_max_message_size(), AgentMax = get_agent_max_message_size(Addr, Port), PduMS = pdu_ms(Max, AgentMax, HS), @@ -170,14 +183,14 @@ process_v1_v2c_msg(Vsn, _NoteStore, Msg, snmpUDPDomain, ?vtrace("process_v1_v2c_msg -> was a pdu", []), Log(Msg), inc_snmp_in(Pdu), - MsgData = {Community, sec_model(Vsn)}, + MsgData = {Community, sec_model(Vsn), TDomain, TAddress}, {ok, Vsn, Pdu, PduMS, MsgData}; Trap when is_record(Trap, trappdu) -> ?vtrace("process_v1_v2c_msg -> was a trap", []), Log(Msg), inc_snmp_in(Trap), - MsgData = {Community, sec_model(Vsn)}, + MsgData = {Community, sec_model(Vsn), TDomain, TAddress}, {ok, Vsn, Trap, PduMS, MsgData}; {'EXIT', Reason} -> @@ -185,11 +198,7 @@ process_v1_v2c_msg(Vsn, _NoteStore, Msg, snmpUDPDomain, "~n Reason: ~p", [Reason]), inc(snmpInASNParseErrs), {discarded, Reason} - end; -process_v1_v2c_msg(_Vsn, _NoteStore, _Msg, TDomain, - _Addr, _Port, - _Comm, _HS, _Data, _Log) -> - {discarded, {badarg, TDomain}}. + end. pdu_ms(MgrMMS, AgentMMS, HS) when AgentMMS < MgrMMS -> AgentMMS - HS; @@ -482,8 +491,8 @@ generate_msg('version-3', NoteStore, Pdu, generate_v3_msg(NoteStore, Pdu, SecModel, SecName, SecLevel, CtxEngineID, CtxName, TargetName, Log); -generate_msg(Vsn, _NoteStore, Pdu, {Community, _SecModel}, Log) -> - generate_v1_v2c_msg(Vsn, Pdu, Community, Log). +generate_msg(Vsn, _NoteStore, Pdu, {Comm, _SecModel}, Log) -> + generate_v1_v2c_msg(Vsn, Pdu, Comm, Log). generate_v3_msg(NoteStore, Pdu, @@ -627,6 +636,8 @@ generate_response_msg('version-3', Pdu, generate_v3_response_msg(Pdu, MsgID, SecModel, SecName, SecLevel, CtxEngineID, CtxName, SecData, Log); generate_response_msg(Vsn, Pdu, {Comm, _SecModel}, Log) -> + generate_v1_v2c_response_msg(Vsn, Pdu, Comm, Log); +generate_response_msg(Vsn, Pdu, {Comm, _SecModel, _TDomain, _TAddress}, Log) -> generate_v1_v2c_response_msg(Vsn, Pdu, Comm, Log). diff --git a/lib/snmp/src/manager/snmpm_net_if.erl b/lib/snmp/src/manager/snmpm_net_if.erl index a116c9f26b..4d6bd9aa33 100644 --- a/lib/snmp/src/manager/snmpm_net_if.erl +++ b/lib/snmp/src/manager/snmpm_net_if.erl @@ -28,7 +28,8 @@ start_link/2, stop/1, send_pdu/6, % Backward compatibillity - send_pdu/7, + send_pdu/7, % Backward compatibillity + send_pdu/8, inform_response/4, @@ -101,16 +102,21 @@ stop(Pid) -> send_pdu(Pid, Pdu, Vsn, MsgData, Addr, Port) -> send_pdu(Pid, Pdu, Vsn, MsgData, Addr, Port, ?DEFAULT_EXTRA_INFO). -send_pdu(Pid, Pdu, Vsn, MsgData, Addr, Port, ExtraInfo) +send_pdu(Pid, Pdu, Vsn, MsgData, Addr, Port, ExtraInfo) -> + Domain = snmpm_config:default_transport_domain(), + send_pdu(Pid, Pdu, Vsn, MsgData, Domain, Addr, Port, ExtraInfo). + +send_pdu(Pid, Pdu, Vsn, MsgData, Domain, Addr, Port, ExtraInfo) when is_record(Pdu, pdu) -> ?d("send_pdu -> entry with" "~n Pid: ~p" "~n Pdu: ~p" "~n Vsn: ~p" "~n MsgData: ~p" + "~n Domain: ~p" "~n Addr: ~p" - "~n Port: ~p", [Pid, Pdu, Vsn, MsgData, Addr, Port]), - cast(Pid, {send_pdu, Pdu, Vsn, MsgData, Addr, Port, ExtraInfo}). + "~n Port: ~p", [Pid, Pdu, Vsn, MsgData, Domain, Addr, Port]), + cast(Pid, {send_pdu, Pdu, Vsn, MsgData, Domain, Addr, Port, ExtraInfo}). note_store(Pid, NoteStore) -> call(Pid, {note_store, NoteStore}). @@ -380,15 +386,17 @@ handle_call(Req, From, State) -> %% {noreply, State, Timeout} | %% {stop, Reason, State} (terminate/2 is called) %%-------------------------------------------------------------------- -handle_cast({send_pdu, Pdu, Vsn, MsgData, Addr, Port, ExtraInfo}, State) -> +handle_cast({send_pdu, Pdu, Vsn, MsgData, Domain, Addr, Port, ExtraInfo}, + State) -> ?vlog("received send_pdu message with" "~n Pdu: ~p" "~n Vsn: ~p" "~n MsgData: ~p" + "~n Domain: ~p" "~n Addr: ~p" - "~n Port: ~p", [Pdu, Vsn, MsgData, Addr, Port]), + "~n Port: ~p", [Pdu, Vsn, MsgData, Domain, Addr, Port]), maybe_process_extra_info(ExtraInfo), - maybe_handle_send_pdu(Pdu, Vsn, MsgData, Addr, Port, State), + maybe_handle_send_pdu(Pdu, Vsn, MsgData, Domain, Addr, Port, State), {noreply, State}; handle_cast({inform_response, Ref, Addr, Port}, State) -> @@ -545,8 +553,9 @@ handle_recv_msg(Addr, Port, Bytes, mpd_state = MpdState, sock = Sock, log = Log} = State) -> + Domain = snmp_conf:which_domain(Addr), % What the ****... Logger = logger(Log, read, Addr, Port), - case (catch snmpm_mpd:process_msg(Bytes, snmpUDPDomain, Addr, Port, + case (catch snmpm_mpd:process_msg(Bytes, Domain, Addr, Port, MpdState, NoteStore, Logger)) of {ok, Vsn, Pdu, MS, ACM} -> @@ -734,17 +743,17 @@ irgc_stop(Ref) -> (catch erlang:cancel_timer(Ref)). -maybe_handle_send_pdu(Pdu, Vsn, MsgData, Addr, Port, +maybe_handle_send_pdu(Pdu, Vsn, MsgData, Domain, Addr, Port, #state{filter = FilterMod} = State) -> case (catch FilterMod:accept_send_pdu(Addr, Port, pdu_type_of(Pdu))) of false -> inc(netIfPduOutDrops), ok; _ -> - handle_send_pdu(Pdu, Vsn, MsgData, Addr, Port, State) + handle_send_pdu(Pdu, Vsn, MsgData, Domain, Addr, Port, State) end. -handle_send_pdu(Pdu, Vsn, MsgData, Addr, Port, +handle_send_pdu(Pdu, Vsn, MsgData, _Domain, Addr, Port, #state{server = Pid, note_store = NoteStore, sock = Sock, diff --git a/lib/snmp/src/manager/snmpm_server.erl b/lib/snmp/src/manager/snmpm_server.erl index 58a58507d6..484954addb 100644 --- a/lib/snmp/src/manager/snmpm_server.erl +++ b/lib/snmp/src/manager/snmpm_server.erl @@ -161,7 +161,8 @@ {id, user_id, reg_type, - target, + target, + domain, addr, port, type, @@ -1175,11 +1176,12 @@ handle_sync_get(Pid, UserId, TargetName, Oids, SendOpts, From, State) -> "~n From: ~p", [Pid, UserId, TargetName, Oids, SendOpts, From]), case agent_data(TargetName, SendOpts) of - {ok, RegType, Addr, Port, Vsn, MsgData} -> + {ok, RegType, Domain, Addr, Port, Vsn, MsgData} -> ?vtrace("handle_sync_get -> send a ~p message", [Vsn]), Extra = ?GET_EXTRA(SendOpts), ReqId = send_get_request(Oids, Vsn, MsgData, - Addr, Port, Extra, State), + Domain, Addr, Port, + Extra, State), ?vdebug("handle_sync_get -> ReqId: ~p", [ReqId]), Msg = {sync_timeout, ReqId, From}, Timeout = ?SYNC_GET_TIMEOUT(SendOpts), @@ -1190,6 +1192,7 @@ handle_sync_get(Pid, UserId, TargetName, Oids, SendOpts, From, State) -> user_id = UserId, reg_type = RegType, target = TargetName, + domain = Domain, addr = Addr, port = Port, type = get, @@ -1227,11 +1230,12 @@ handle_sync_get_next(Pid, UserId, TargetName, Oids, SendOpts, "~n From: ~p", [Pid, UserId, TargetName, Oids, SendOpts, From]), case agent_data(TargetName, SendOpts) of - {ok, RegType, Addr, Port, Vsn, MsgData} -> + {ok, RegType, Domain, Addr, Port, Vsn, MsgData} -> ?vtrace("handle_sync_get_next -> send a ~p message", [Vsn]), Extra = ?GET_EXTRA(SendOpts), ReqId = send_get_next_request(Oids, Vsn, MsgData, - Addr, Port, Extra, State), + Domain, Addr, Port, + Extra, State), ?vdebug("handle_sync_get_next -> ReqId: ~p", [ReqId]), Msg = {sync_timeout, ReqId, From}, Timeout = ?SYNC_GET_NEXT_TIMEOUT(SendOpts), @@ -1242,6 +1246,7 @@ handle_sync_get_next(Pid, UserId, TargetName, Oids, SendOpts, user_id = UserId, reg_type = RegType, target = TargetName, + domain = Domain, addr = Addr, port = Port, type = get_next, @@ -1285,10 +1290,11 @@ handle_sync_get_bulk(Pid, UserId, TargetName, NonRep, MaxRep, Oids, SendOpts, "~n From: ~p", [Pid, UserId, TargetName, NonRep, MaxRep, Oids, SendOpts, From]), case agent_data(TargetName, SendOpts) of - {ok, RegType, Addr, Port, Vsn, MsgData} -> + {ok, RegType, Domain, Addr, Port, Vsn, MsgData} -> ?vtrace("handle_sync_get_bulk -> send a ~p message", [Vsn]), Extra = ?GET_EXTRA(SendOpts), - ReqId = send_get_bulk_request(Oids, Vsn, MsgData, Addr, Port, + ReqId = send_get_bulk_request(Oids, Vsn, MsgData, + Domain, Addr, Port, NonRep, MaxRep, Extra, State), ?vdebug("handle_sync_get_bulk -> ReqId: ~p", [ReqId]), Msg = {sync_timeout, ReqId, From}, @@ -1300,6 +1306,7 @@ handle_sync_get_bulk(Pid, UserId, TargetName, NonRep, MaxRep, Oids, SendOpts, user_id = UserId, reg_type = RegType, target = TargetName, + domain = Domain, addr = Addr, port = Port, type = get_bulk, @@ -1339,11 +1346,12 @@ handle_sync_set(Pid, UserId, TargetName, VarsAndVals, SendOpts, From, State) -> "~n From: ~p", [Pid, UserId, TargetName, VarsAndVals, From]), case agent_data(TargetName, SendOpts) of - {ok, RegType, Addr, Port, Vsn, MsgData} -> + {ok, RegType, Domain, Addr, Port, Vsn, MsgData} -> ?vtrace("handle_sync_set -> send a ~p message", [Vsn]), Extra = ?GET_EXTRA(SendOpts), ReqId = send_set_request(VarsAndVals, Vsn, MsgData, - Addr, Port, Extra, State), + Domain, Addr, Port, + Extra, State), ?vdebug("handle_sync_set -> ReqId: ~p", [ReqId]), Msg = {sync_timeout, ReqId, From}, Timeout = ?SYNC_SET_TIMEOUT(SendOpts), @@ -1354,6 +1362,7 @@ handle_sync_set(Pid, UserId, TargetName, VarsAndVals, SendOpts, From, State) -> user_id = UserId, reg_type = RegType, target = TargetName, + domain = Domain, addr = Addr, port = Port, type = set, @@ -1391,10 +1400,11 @@ handle_async_get(Pid, UserId, TargetName, Oids, SendOpts, State) -> "~n SendOpts: ~p", [Pid, UserId, TargetName, Oids, SendOpts]), case agent_data(TargetName, SendOpts) of - {ok, RegType, Addr, Port, Vsn, MsgData} -> + {ok, RegType, Domain, Addr, Port, Vsn, MsgData} -> ?vtrace("handle_async_get -> send a ~p message", [Vsn]), Extra = ?GET_EXTRA(SendOpts), - ReqId = send_get_request(Oids, Vsn, MsgData, Addr, Port, + ReqId = send_get_request(Oids, Vsn, MsgData, + Domain, Addr, Port, Extra, State), ?vdebug("handle_async_get -> ReqId: ~p", [ReqId]), Expire = ?ASYNC_GET_TIMEOUT(SendOpts), @@ -1402,6 +1412,7 @@ handle_async_get(Pid, UserId, TargetName, Oids, SendOpts, State) -> user_id = UserId, reg_type = RegType, target = TargetName, + domain = Domain, addr = Addr, port = Port, type = get, @@ -1439,17 +1450,19 @@ handle_async_get_next(Pid, UserId, TargetName, Oids, SendOpts, State) -> "~n SendOpts: ~p", [Pid, UserId, TargetName, Oids, SendOpts]), case agent_data(TargetName, SendOpts) of - {ok, RegType, Addr, Port, Vsn, MsgData} -> + {ok, RegType, Domain, Addr, Port, Vsn, MsgData} -> ?vtrace("handle_async_get_next -> send a ~p message", [Vsn]), Extra = ?GET_EXTRA(SendOpts), ReqId = send_get_next_request(Oids, Vsn, MsgData, - Addr, Port, Extra, State), + Domain, Addr, Port, + Extra, State), ?vdebug("handle_async_get_next -> ReqId: ~p", [ReqId]), Expire = ?ASYNC_GET_NEXT_TIMEOUT(SendOpts), Req = #request{id = ReqId, user_id = UserId, reg_type = RegType, target = TargetName, + domain = Domain, addr = Addr, port = Port, type = get_next, @@ -1494,10 +1507,11 @@ handle_async_get_bulk(Pid, "~n SendOpts: ~p", [Pid, UserId, TargetName, NonRep, MaxRep, Oids, SendOpts]), case agent_data(TargetName, SendOpts) of - {ok, RegType, Addr, Port, Vsn, MsgData} -> + {ok, RegType, Domain, Addr, Port, Vsn, MsgData} -> ?vtrace("handle_async_get_bulk -> send a ~p message", [Vsn]), Extra = ?GET_EXTRA(SendOpts), - ReqId = send_get_bulk_request(Oids, Vsn, MsgData, Addr, Port, + ReqId = send_get_bulk_request(Oids, Vsn, MsgData, + Domain, Addr, Port, NonRep, MaxRep, Extra, State), ?vdebug("handle_async_get_bulk -> ReqId: ~p", [ReqId]), Expire = ?ASYNC_GET_BULK_TIMEOUT(SendOpts), @@ -1505,6 +1519,7 @@ handle_async_get_bulk(Pid, user_id = UserId, reg_type = RegType, target = TargetName, + domain = Domain, addr = Addr, port = Port, type = get_bulk, @@ -1541,17 +1556,19 @@ handle_async_set(Pid, UserId, TargetName, VarsAndVals, SendOpts, State) -> "~n SendOpts: ~p", [Pid, UserId, TargetName, VarsAndVals, SendOpts]), case agent_data(TargetName, SendOpts) of - {ok, RegType, Addr, Port, Vsn, MsgData} -> + {ok, RegType, Domain, Addr, Port, Vsn, MsgData} -> ?vtrace("handle_async_set -> send a ~p message", [Vsn]), Extra = ?GET_EXTRA(SendOpts), ReqId = send_set_request(VarsAndVals, Vsn, MsgData, - Addr, Port, Extra, State), + Domain, Addr, Port, + Extra, State), ?vdebug("handle_async_set -> ReqId: ~p", [ReqId]), Expire = ?ASYNC_SET_TIMEOUT(SendOpts), Req = #request{id = ReqId, user_id = UserId, reg_type = RegType, target = TargetName, + domain = Domain, addr = Addr, port = Port, type = set, @@ -2907,7 +2924,7 @@ do_gc(Key, Now) -> %% %%---------------------------------------------------------------------- -send_get_request(Oids, Vsn, MsgData, Addr, Port, ExtraInfo, +send_get_request(Oids, Vsn, MsgData, Domain, Addr, Port, ExtraInfo, #state{net_if = NetIf, net_if_mod = Mod, mini_mib = MiniMIB}) -> @@ -2918,34 +2935,39 @@ send_get_request(Oids, Vsn, MsgData, Addr, Port, ExtraInfo, "~n Pdu: ~p" "~n Vsn: ~p" "~n MsgData: ~p" + "~n Domain: ~p" "~n Addr: ~p" - "~n Port: ~p", [Mod, NetIf, Pdu, Vsn, MsgData, Addr, Port]), - (catch Mod:send_pdu(NetIf, Pdu, Vsn, MsgData, Addr, Port, ExtraInfo)), + "~n Port: ~p", + [Mod, NetIf, Pdu, Vsn, MsgData, Domain, Addr, Port]), + Res = (catch Mod:send_pdu(NetIf, Pdu, Vsn, MsgData, + Domain, Addr, Port, ExtraInfo)), + ?vtrace("send_get_request -> send result:" + "~n ~p", [Res]), Pdu#pdu.request_id. -send_get_next_request(Oids, Vsn, MsgData, Addr, Port, ExtraInfo, +send_get_next_request(Oids, Vsn, MsgData, Domain, Addr, Port, ExtraInfo, #state{mini_mib = MiniMIB, net_if = NetIf, net_if_mod = Mod}) -> Pdu = make_pdu(get_next, Oids, MiniMIB), - Mod:send_pdu(NetIf, Pdu, Vsn, MsgData, Addr, Port, ExtraInfo), + Mod:send_pdu(NetIf, Pdu, Vsn, MsgData, Domain, Addr, Port, ExtraInfo), Pdu#pdu.request_id. -send_get_bulk_request(Oids, Vsn, MsgData, Addr, Port, +send_get_bulk_request(Oids, Vsn, MsgData, Domain, Addr, Port, NonRep, MaxRep, ExtraInfo, #state{mini_mib = MiniMIB, net_if = NetIf, net_if_mod = Mod}) -> Pdu = make_pdu(bulk, {NonRep, MaxRep, Oids}, MiniMIB), - Mod:send_pdu(NetIf, Pdu, Vsn, MsgData, Addr, Port, ExtraInfo), + Mod:send_pdu(NetIf, Pdu, Vsn, MsgData, Domain, Addr, Port, ExtraInfo), Pdu#pdu.request_id. -send_set_request(VarsAndVals, Vsn, MsgData, Addr, Port, ExtraInfo, +send_set_request(VarsAndVals, Vsn, MsgData, Domain, Addr, Port, ExtraInfo, #state{mini_mib = MiniMIB, net_if = NetIf, net_if_mod = Mod}) -> Pdu = make_pdu(set, VarsAndVals, MiniMIB), - Mod:send_pdu(NetIf, Pdu, Vsn, MsgData, Addr, Port, ExtraInfo), + Mod:send_pdu(NetIf, Pdu, Vsn, MsgData, Domain, Addr, Port, ExtraInfo), Pdu#pdu.request_id. %% send_discovery(Vsn, MsgData, Addr, Port, ExtraInfo, @@ -3181,10 +3203,11 @@ agent_data(TargetName, SendOpts) -> {Comm, SecModel} end, + Domain = agent_data_item(tdomain, Info), Addr = agent_data_item(address, Info), Port = agent_data_item(port, Info), RegType = agent_data_item(reg_type, Info), - {ok, RegType, Addr, Port, version(Version), MsgData}; + {ok, RegType, Domain, Addr, Port, version(Version), MsgData}; Error -> Error end. diff --git a/lib/snmp/src/misc/snmp_conf.erl b/lib/snmp/src/misc/snmp_conf.erl index 20f4455d10..7249def24e 100644 --- a/lib/snmp/src/misc/snmp_conf.erl +++ b/lib/snmp/src/misc/snmp_conf.erl @@ -37,7 +37,9 @@ check_timer/1, + all_domains/0, check_domain/1, + all_tdomains/0, check_tdomain/1, mk_tdomain/1, which_domain/1, @@ -345,6 +347,25 @@ check_sec_level(BadSecLevel) -> %% --------- +all_tdomains() -> + [ + ?transportDomainUdpIpv4, + ?transportDomainUdpIpv6, + ?transportDomainUdpIpv4z, + ?transportDomainUdpIpv6z, + ?transportDomainTcpIpv4, + ?transportDomainTcpIpv6, + ?transportDomainTcpIpv4z, + ?transportDomainTcpIpv6z, + ?transportDomainSctpIpv4, + ?transportDomainSctpIpv6, + ?transportDomainSctpIpv4z, + ?transportDomainSctpIpv6z, + ?transportDomainLocal, + ?transportDomainUdpDns, + ?transportDomainTcpDns, + ?transportDomainSctpDns + ]. check_tdomain(TDomain) -> SupportedTDomains = @@ -353,25 +374,7 @@ check_tdomain(TDomain) -> ?transportDomainUdpIpv4, ?transportDomainUdpIpv6 ], - AllTDomains = - [ - ?transportDomainUdpIpv4, - ?transportDomainUdpIpv6, - ?transportDomainUdpIpv4z, - ?transportDomainUdpIpv6z, - ?transportDomainTcpIpv4, - ?transportDomainTcpIpv6, - ?transportDomainTcpIpv4z, - ?transportDomainTcpIpv6z, - ?transportDomainSctpIpv4, - ?transportDomainSctpIpv6, - ?transportDomainSctpIpv4z, - ?transportDomainSctpIpv6z, - ?transportDomainLocal, - ?transportDomainUdpDns, - ?transportDomainTcpDns, - ?transportDomainSctpDns - ], + AllTDomains = all_tdomains(), case lists:member(TDomain, SupportedTDomains) of true -> ok; @@ -388,7 +391,7 @@ check_tdomain(TDomain) -> %% --------- mk_tdomain(snmpUDPDomain) -> - ?snmpUDPDomain; + mk_tdomain(transportDomainUdpIpv4); mk_tdomain(transportDomainUdpIpv4) -> ?transportDomainUdpIpv4; mk_tdomain(transportDomainUdpIpv6) -> @@ -474,6 +477,26 @@ do_check_timer(WaitFor, Factor, Incr, Retry) -> %% --------- +all_domains() -> + [ + transportDomainUdpIpv4, + transportDomainUdpIpv6, + transportDomainUdpIpv4z, + transportDomainUdpIpv6z, + transportDomainTcpIpv4, + transportDomainTcpIpv6, + transportDomainTcpIpv4z, + transportDomainTcpIpv6z, + transportDomainSctpIpv4, + transportDomainSctpIpv6, + transportDomainSctpIpv4z, + transportDomainSctpIpv6z, + transportDomainLocal, + transportDomainUdpDns, + transportDomainTcpDns, + transportDomainSctpDns + ]. + check_domain(Domain) -> SupportedDomains = [ @@ -481,25 +504,7 @@ check_domain(Domain) -> transportDomainUdpIpv4, transportDomainUdpIpv6 ], - AllDomains = - [ - transportDomainUdpIpv4, - transportDomainUdpIpv6, - transportDomainUdpIpv4z, - transportDomainUdpIpv6z, - transportDomainTcpIpv4, - transportDomainTcpIpv6, - transportDomainTcpIpv4z, - transportDomainTcpIpv6z, - transportDomainSctpIpv4, - transportDomainSctpIpv6, - transportDomainSctpIpv4z, - transportDomainSctpIpv6z, - transportDomainLocal, - transportDomainUdpDns, - transportDomainTcpDns, - transportDomainSctpDns - ], + AllDomains = all_domains(), case lists:member(Domain, SupportedDomains) of true -> ok; diff --git a/lib/snmp/src/misc/snmp_config.erl b/lib/snmp/src/misc/snmp_config.erl index fcbc6a88c9..6ab20e3e48 100644 --- a/lib/snmp/src/misc/snmp_config.erl +++ b/lib/snmp/src/misc/snmp_config.erl @@ -337,7 +337,7 @@ config_agent_sys() -> {dir, ATLDir}, {size, ATLSize}, {repair, ATLRepair}, - {seqno, ATLSeqNo}]}]; + {seqno, ATLSeqNo}]}]; no -> [] end, @@ -568,7 +568,7 @@ config_agent_snmp(Dir, Vsns) -> false -> ok end, - i("The following agent files were written: agent.conf, " + i("The following agent files where written: agent.conf, " "community.conf,~n" "standard.conf, target_addr.conf, " "target_params.conf, ~n" @@ -776,7 +776,7 @@ config_manager_snmp(Dir, Vsns) -> Users, Agents, Usms)) of ok -> i("~n- - - - - - - - - - - - -"), - i("The following manager files were written: " + i("The following manager files where written: " "manager.conf, agents.conf " ++ case lists:member(v3, Vsns) of true -> @@ -2350,7 +2350,9 @@ write_sys_config_file_manager_atl_opt(Fid, {type, Type}) -> write_sys_config_file_manager_atl_opt(Fid, {size, Size}) -> ok = io:format(Fid, "{size, ~w}", [Size]); write_sys_config_file_manager_atl_opt(Fid, {repair, Rep}) -> - ok = io:format(Fid, "{repair, ~w}", [Rep]). + ok = io:format(Fid, "{repair, ~w}", [Rep]); +write_sys_config_file_manager_atl_opt(Fid, {seqno, SeqNo}) -> + ok = io:format(Fid, "{seqno, ~w}", [SeqNo]). header() -> diff --git a/lib/snmp/test/snmp_compiler_test.erl b/lib/snmp/test/snmp_compiler_test.erl index 2e6020ae7a..c964b08168 100644 --- a/lib/snmp/test/snmp_compiler_test.erl +++ b/lib/snmp/test/snmp_compiler_test.erl @@ -47,6 +47,7 @@ module_identity/1, agent_capabilities/1, module_compliance/1, + warnings_as_errors/1, otp_6150/1, otp_8574/1, @@ -97,9 +98,10 @@ all() -> description, oid_conflicts, imports, - module_identity, - agent_capabilities, - module_compliance, + module_identity, + agent_capabilities, + module_compliance, + warnings_as_errors, {group, tickets} ]. @@ -152,6 +154,8 @@ description(Config) when is_list(Config) -> ok. +%%====================================================================== + oid_conflicts(suite) -> []; oid_conflicts(Config) when is_list(Config) -> put(tname,oid_conflicts), @@ -165,18 +169,24 @@ oid_conflicts(Config) when is_list(Config) -> ok. +%%====================================================================== + imports(suite) -> []; imports(Config) when is_list(Config) -> ?SKIP(not_yet_implemented). +%%====================================================================== + module_identity(suite) -> []; module_identity(Config) when is_list(Config) -> ?SKIP(not_yet_implemented). +%%====================================================================== + agent_capabilities(suite) -> []; agent_capabilities(Config) when is_list(Config) -> @@ -218,6 +228,8 @@ agent_capabilities(Config) when is_list(Config) -> ok. +%%====================================================================== + module_compliance(suite) -> []; module_compliance(Config) when is_list(Config) -> @@ -259,6 +271,32 @@ module_compliance(Config) when is_list(Config) -> ok. +%%====================================================================== + +warnings_as_errors(suite) -> + ["OTP-9437"]; +warnings_as_errors(Config) when is_list(Config) -> + put(tname,warnings_as_errors), + p("starting with Config: ~p~n", [Config]), + Dir = ?config(comp_dir, Config), + MibDir = ?config(mib_dir, Config), + MibFile = join(MibDir, "OTP8574-MIB.mib"), + OutFile = join(Dir, "OTP8574-MIB.bin"), + Opts = [{group_check, false}, + {outdir, Dir}, + {verbosity, trace}, + relaxed_row_name_assign_check], + {error, compilation_failed} = + snmpc:compile(MibFile, [warnings_as_errors|Opts]), + false = filelib:is_regular(OutFile), + {ok, _} = snmpc:compile(MibFile, Opts), + true = filelib:is_regular(OutFile), + ok = file:delete(OutFile), + ok. + + +%%====================================================================== + otp_6150(suite) -> []; otp_6150(Config) when is_list(Config) -> @@ -273,6 +311,8 @@ otp_6150(Config) when is_list(Config) -> ok. +%%====================================================================== + otp_8574(suite) -> []; otp_8574(Config) when is_list(Config) -> @@ -304,6 +344,8 @@ otp_8574(Config) when is_list(Config) -> end. +%%====================================================================== + otp_8595(suite) -> []; otp_8595(Config) when is_list(Config) -> diff --git a/lib/snmp/test/snmp_manager_test.erl b/lib/snmp/test/snmp_manager_test.erl index 0b536748fb..d18f20d359 100644 --- a/lib/snmp/test/snmp_manager_test.erl +++ b/lib/snmp/test/snmp_manager_test.erl @@ -61,6 +61,7 @@ register_agent1/1, register_agent2/1, + register_agent3/1, info/1, @@ -383,12 +384,12 @@ end_per_testcase2(Case, Config) -> all() -> [ {group, start_and_stop_tests}, - {group, misc_tests}, + {group, misc_tests}, {group, user_tests}, - {group, agent_tests}, + {group, agent_tests}, {group, request_tests}, {group, event_tests}, - discovery, + discovery, {group, tickets} ]. @@ -417,7 +418,8 @@ groups() -> {agent_tests, [], [ register_agent1, - register_agent2 + register_agent2, + register_agent3 ] }, {request_tests, [], @@ -477,14 +479,14 @@ groups() -> }, {event_tests, [], [ - trap1, - trap2, - inform1, - inform2, - inform3, - inform4, - inform_swarm, - report + trap1%% , + %% trap2, + %% inform1, + %% inform2, + %% inform3, + %% inform4, + %% inform_swarm, + %% report ] }, {tickets, [], @@ -1134,6 +1136,7 @@ register_agent1(suite) -> register_agent1(Config) when is_list(Config) -> process_flag(trap_exit, true), put(tname,ra1), + p("starting with Config: ~p~n", [Config]), ManagerNode = start_manager_node(), @@ -1164,7 +1167,7 @@ register_agent1(Config) when is_list(Config) -> p("manager info: ~p~n", [mgr_info(ManagerNode)]), - p("register user(s) calvin & hobbe"), + p("register user(s) user_alfa & user_beta"), ?line ok = mgr_register_user(ManagerNode, user_alfa, snmpm_user_default, []), ?line ok = mgr_register_user(ManagerNode, user_beta, snmpm_user_default, []), p("manager info: ~p~n", [mgr_info(ManagerNode)]), @@ -1293,7 +1296,7 @@ register_agent2(Config) when is_list(Config) -> p("manager info: ~p~n", [mgr_info(ManagerNode)]), - p("register user(s) calvin & hobbe"), + p("register user(s) user_alfa & user_beta"), ?line ok = mgr_register_user(ManagerNode, user_alfa, snmpm_user_default, []), ?line ok = mgr_register_user(ManagerNode, user_beta, snmpm_user_default, []), p("manager info: ~p~n", [mgr_info(ManagerNode)]), @@ -1348,7 +1351,7 @@ register_agent2(Config) when is_list(Config) -> end, p("manager info: ~p~n", [mgr_info(ManagerNode)]), - + p("unregister user user_alfa"), ?line ok = mgr_unregister_user(ManagerNode, user_alfa), @@ -1377,7 +1380,157 @@ register_agent2(Config) when is_list(Config) -> p("manager info: ~p~n", [mgr_info(ManagerNode)]), - p("unregister user hobbe"), + p("unregister user user_beta"), + ?line ok = mgr_unregister_user(ManagerNode, user_beta), + + p("manager info: ~p~n", [mgr_info(ManagerNode)]), + + ?SLEEP(1000), + + p("stop snmp application (with only manager)"), + ?line ok = stop_snmp(ManagerNode), + + ?SLEEP(1000), + + stop_node(ManagerNode), + + ?SLEEP(1000), + + p("end"), + ok. + + +%%====================================================================== + +register_agent3(doc) -> + ["Test registration of agents with the NEW interface functions " + "and specifying transport domain"]; +register_agent3(suite) -> + []; +register_agent3(Config) when is_list(Config) -> + process_flag(trap_exit, true), + put(tname, ra3), + p("starting with Config: ~p~n", [Config]), + + ManagerNode = start_manager_node(), + + ConfDir = ?config(manager_conf_dir, Config), + DbDir = ?config(manager_db_dir, Config), + LocalHost = snmp_test_lib:localhost(), + + + write_manager_conf(ConfDir), + + Opts = [{server, [{verbosity, trace}]}, + {net_if, [{verbosity, trace}]}, + {note_store, [{verbosity, trace}]}, + {config, [{verbosity, trace}, {dir, ConfDir}, {db_dir, DbDir}]}], + + + p("load snmp application"), + ?line ok = load_snmp(ManagerNode), + + p("set manager env for the snmp application"), + ?line ok = set_mgr_env(ManagerNode, Opts), + + p("starting snmp application (with only manager)"), + ?line ok = start_snmp(ManagerNode), + + p("started"), + + ?SLEEP(1000), + + p("manager info: ~p~n", [mgr_info(ManagerNode)]), + + p("register user(s) user_alfa & user_beta"), + ?line ok = mgr_register_user(ManagerNode, user_alfa, snmpm_user_default, []), + ?line ok = mgr_register_user(ManagerNode, user_beta, snmpm_user_default, []), + p("manager info: ~p~n", [mgr_info(ManagerNode)]), + + p("register agent(s)"), + TargetName1 = "agent2", + ?line ok = mgr_register_agent(ManagerNode, user_alfa, TargetName1, + [{tdomain, transportDomainUdpIpv4}, + {address, LocalHost}, + {port, 5001}, + {engine_id, "agentEngineId-1"}]), + TargetName2 = "agent3", + ?line ok = mgr_register_agent(ManagerNode, user_alfa, TargetName2, + [{tdomain, transportDomainUdpIpv6}, + {address, LocalHost}, + {port, 5002}, + {engine_id, "agentEngineId-2"}]), + TargetName3 = "agent4", + ?line {error, {unsupported_domain, _} = Reason4} = + mgr_register_agent(ManagerNode, user_beta, TargetName3, + [{tdomain, transportDomainTcpIpv4}, + {address, LocalHost}, + {port, 5003}, + {engine_id, "agentEngineId-3"}]), + p("Expected registration failure: ~p", [Reason4]), + TargetName4 = "agent5", + ?line {error, {unknown_domain, _} = Reason5} = + mgr_register_agent(ManagerNode, user_beta, TargetName4, + [{tdomain, transportDomainUdpIpv4_bad}, + {address, LocalHost}, + {port, 5004}, + {engine_id, "agentEngineId-4"}]), + p("Expected registration failure: ~p", [Reason5]), + + p("verify all agent(s): expect 2"), + case mgr_which_agents(ManagerNode) of + Agents1 when length(Agents1) =:= 2 -> + p("all agents: ~p~n", [Agents1]), + ok; + Agents1 -> + ?FAIL({agent_registration_failure, Agents1}) + end, + + p("verify user_alfa agent(s)"), + case mgr_which_agents(ManagerNode, user_alfa) of + Agents2 when length(Agents2) =:= 2 -> + p("calvin agents: ~p~n", [Agents2]), + ok; + Agents2 -> + ?FAIL({agent_registration_failure, Agents2}) + end, + + p("verify user_beta agent(s)"), + case mgr_which_agents(ManagerNode, user_beta) of + Agents3 when length(Agents3) =:= 0 -> + p("hobbe agents: ~p~n", [Agents3]), + ok; + Agents3 -> + ?FAIL({agent_registration_failure, Agents3}) + end, + + p("manager info: ~p~n", [mgr_info(ManagerNode)]), + + p("unregister user user_alfa"), + ?line ok = mgr_unregister_user(ManagerNode, user_alfa), + + p("verify all agent(s): expect 0"), + case mgr_which_agents(ManagerNode) of + Agents4 when length(Agents4) =:= 0 -> + p("all agents: ~p~n", [Agents4]), + ok; + Agents4 -> + ?FAIL({agent_unregistration_failure, Agents4}) + end, + p("manager info: ~p~n", [mgr_info(ManagerNode)]), + + p("verify all agent(s): expect 0"), + case mgr_which_agents(ManagerNode) of + [] -> + ok; + Agents5 -> + p("all agents: ~p~n", [Agents5]), + ?FAIL({agent_unregistration_failure, Agents5}) + end, + + p("manager info: ~p~n", [mgr_info(ManagerNode)]), + + p("unregister user user_beta"), ?line ok = mgr_unregister_user(ManagerNode, user_beta), p("manager info: ~p~n", [mgr_info(ManagerNode)]), diff --git a/lib/snmp/test/test_config/Makefile b/lib/snmp/test/test_config/Makefile index d7bebbc431..d65bb8abe2 100644 --- a/lib/snmp/test/test_config/Makefile +++ b/lib/snmp/test/test_config/Makefile @@ -155,23 +155,23 @@ release_spec: release_tests_spec: clean opt $(INSTALL_DIR) $(RELSYSDIR) - chmod -f -R u+w $(RELSYSDIR) + chmod -R u+w $(RELSYSDIR) $(INSTALL_DIR) $(RELSYSDIR)/agent - chmod -f -R u+w $(RELSYSDIR)/agent + chmod -R u+w $(RELSYSDIR)/agent $(INSTALL_DIR) $(RELSYSDIR)/agent/conf - chmod -f -R u+w $(RELSYSDIR)/agent/conf + chmod -R u+w $(RELSYSDIR)/agent/conf $(INSTALL_DIR) $(RELSYSDIR)/agent/db - chmod -f -R u+w $(RELSYSDIR)/agent/db + chmod -R u+w $(RELSYSDIR)/agent/db $(INSTALL_DIR) $(RELSYSDIR)/agent/log - chmod -f -R u+w $(RELSYSDIR)/agent/log + chmod -R u+w $(RELSYSDIR)/agent/log $(INSTALL_DIR) $(RELSYSDIR)/manager - chmod -f -R u+w $(RELSYSDIR)/manager + chmod -R u+w $(RELSYSDIR)/manager $(INSTALL_DIR) $(RELSYSDIR)/manager/conf - chmod -f -R u+w $(RELSYSDIR)/manager/conf + chmod -R u+w $(RELSYSDIR)/manager/conf $(INSTALL_DIR) $(RELSYSDIR)/manager/db - chmod -f -R u+w $(RELSYSDIR)/manager/db + chmod -R u+w $(RELSYSDIR)/manager/db $(INSTALL_DIR) $(RELSYSDIR)/manager/log - chmod -f -R u+w $(RELSYSDIR)/manager/log + chmod -R u+w $(RELSYSDIR)/manager/log $(INSTALL_DATA) $(SYS_CONFIG_FILES) $(RELSYSDIR) $(INSTALL_DATA) $(AGENT_CONFIG_FILES) $(RELSYSDIR)/agent/conf $(INSTALL_DATA) $(MANAGER_CONFIG_FILES) $(RELSYSDIR)/manager/conf diff --git a/lib/snmp/vsn.mk b/lib/snmp/vsn.mk index 29228fc59b..08251ab9ea 100644 --- a/lib/snmp/vsn.mk +++ b/lib/snmp/vsn.mk @@ -17,6 +17,6 @@ # # %CopyrightEnd% -SNMP_VSN = 4.20 +SNMP_VSN = 4.21 PRE_VSN = APP_VSN = "snmp-$(SNMP_VSN)$(PRE_VSN)" diff --git a/lib/ssh/doc/src/notes.xml b/lib/ssh/doc/src/notes.xml index 71f3941577..6fc4fdc43d 100644 --- a/lib/ssh/doc/src/notes.xml +++ b/lib/ssh/doc/src/notes.xml @@ -29,6 +29,20 @@ <file>notes.xml</file> </header> +<section><title>Ssh 2.0.8</title> + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Calling ssh_sftp:stop_channel/1 resulted in that the trap_exit flag was + set to true for the invoking process.</p> + <p> + Own Id: OTP-9386 Aux Id: seq11865</p> + </item> + </list> + </section> +</section> + <section><title>Ssh 2.0.7</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/ssh/src/ssh.appup.src b/lib/ssh/src/ssh.appup.src index 974145836c..150b7d86dd 100644 --- a/lib/ssh/src/ssh.appup.src +++ b/lib/ssh/src/ssh.appup.src @@ -19,13 +19,19 @@ {"%VSN%", [ - {"2.0.6", [{load_module, ssh_userreg, soft_purge, soft_purge, []}]}, + {"2.0.7", [{load_module, ssh_sftp, soft_purge, soft_purge, []}]}, + {"2.0.6", [{load_module, ssh_userreg, soft_purge, soft_purge, []}, + {load_module, ssh_sftp, soft_purge, soft_purge, []}]}, {"2.0.5", [{load_module, ssh_userreg, soft_purge, soft_purge, []}, + {load_module, ssh_sftp, soft_purge, soft_purge, []}, {load_module, ssh_connection_handler, soft_purge, soft_purge, [ssh_userreg]}]} ], [ - {"2.0.6", [{load_module, ssh_userreg, soft_purge, soft_purge, []}]}, + {"2.0.7", [{load_module, ssh_sftp, soft_purge, soft_purge, []}]}, + {"2.0.6", [{load_module, ssh_userreg, soft_purge, soft_purge, []}, + {load_module, ssh_sftp, soft_purge, soft_purge, []}]}, {"2.0.5", [{load_module, ssh_userreg, soft_purge, soft_purge, []}, + {load_module, ssh_sftp, soft_purge, soft_purge, []}, {load_module, ssh_connection_handler, soft_purge, soft_purge, [ssh_userreg]}]} ] }. diff --git a/lib/ssh/src/ssh_sftp.erl b/lib/ssh/src/ssh_sftp.erl index 59e09fdd0f..f000558100 100755 --- a/lib/ssh/src/ssh_sftp.erl +++ b/lib/ssh/src/ssh_sftp.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2010. All Rights Reserved. +%% Copyright Ericsson AB 2005-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -130,9 +130,9 @@ start_channel(Host, Port, Opts) -> end. stop_channel(Pid) -> - case process_info(Pid, [trap_exit]) of - [{trap_exit, Bool}] -> - process_flag(trap_exit, true), + case is_process_alive(Pid) of + true -> + OldValue = process_flag(trap_exit, true), link(Pid), exit(Pid, ssh_sftp_stop_channel), receive @@ -145,9 +145,9 @@ stop_channel(Pid) -> ok end end, - process_flag(trap_exit, Bool), + process_flag(trap_exit, OldValue), ok; - undefined -> + false -> ok end. diff --git a/lib/ssh/test/Makefile b/lib/ssh/test/Makefile index 5a2a6de24a..1820924ed6 100644 --- a/lib/ssh/test/Makefile +++ b/lib/ssh/test/Makefile @@ -115,7 +115,7 @@ release_tests_spec: opt $(INSTALL_DATA) $(ERL_FILES) $(RELSYSDIR) $(INSTALL_DATA) ssh.spec ssh.cover $(RELSYSDIR) $(INSTALL_DATA) $(HRL_FILES_NEEDED_IN_TEST) $(RELSYSDIR) - chmod -f -R u+w $(RELSYSDIR) + chmod -R u+w $(RELSYSDIR) @tar cf - *_SUITE_data | (cd $(RELSYSDIR); tar xf -) release_docs_spec: diff --git a/lib/ssh/vsn.mk b/lib/ssh/vsn.mk index d79038df29..fe2b915d17 100644 --- a/lib/ssh/vsn.mk +++ b/lib/ssh/vsn.mk @@ -1,5 +1,5 @@ #-*-makefile-*- ; force emacs to enter makefile-mode -SSH_VSN = 2.0.7 +SSH_VSN = 2.0.8 APP_VSN = "ssh-$(SSH_VSN)" diff --git a/lib/ssl/c_src/esock_openssl.c b/lib/ssl/c_src/esock_openssl.c index 2621c9934e..0bc42958f0 100644 --- a/lib/ssl/c_src/esock_openssl.c +++ b/lib/ssl/c_src/esock_openssl.c @@ -1024,7 +1024,7 @@ static void info_callback(const SSL *ssl, int where, int ret) } } -/* This function is called whenever a SSL_CTX *ctx structure is +/* This function is called whenever an SSL_CTX *ctx structure is * freed. */ static void callback_data_free(void *parent, void *ptr, CRYPTO_EX_DATA *ad, diff --git a/lib/ssl/doc/src/notes.xml b/lib/ssl/doc/src/notes.xml index b2d17925fd..e090b4e1ef 100644 --- a/lib/ssl/doc/src/notes.xml +++ b/lib/ssl/doc/src/notes.xml @@ -554,7 +554,7 @@ Own Id: OTP-8224</p> </item> <item> - <p>A ssl:ssl_accept/3 could crash a connection if the + <p>An ssl:ssl_accept/3 could crash a connection if the timing was wrong.</p> <p>Removed info message if the socket closed without a proper disconnect from the ssl layer. </p> <p>ssl:send/2 is now blocking until the @@ -770,7 +770,7 @@ <item> <p> The new ssl implementation released as a alfa in this - version supports upgrading of a tcp connection to a ssl + version supports upgrading of a tcp connection to an ssl connection so that http client and servers may implement RFC 2817.</p> <p> @@ -789,7 +789,7 @@ very crippled as the control of the ssl-socket was deep down in openssl making it hard if not impossible to support all inet options, ipv6 and upgrade of a tcp - connection to a ssl connection. The alfa version has a + connection to an ssl connection. The alfa version has a few limitations that will be removed before the ssl-4.0 release. Main differences and limitations in the alfa are listed below.</p> diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml index 0da6bbee5b..0c4c8796be 100644 --- a/lib/ssl/doc/src/ssl.xml +++ b/lib/ssl/doc/src/ssl.xml @@ -35,7 +35,7 @@ <title>SSL</title> <list type="bulleted"> - <item>ssl requires the crypto an public_key applications.</item> + <item>ssl requires the crypto and public_key applications.</item> <item>Supported SSL/TLS-versions are SSL-3.0 and TLS-1.0 </item> <item>For security reasons sslv2 is not supported.</item> <item>Ephemeral Diffie-Hellman cipher suites are supported @@ -216,7 +216,7 @@ fun(OtpCert :: #'OTPCertificate'{}, Event :: {bad_cert, Reason :: atom()} | application is encountered. Additionally it will be called when a certificate is considered valid by the path validation to allow access to each certificate in the path to the user - application. Note that the it will differentiate between the + application. Note that it will differentiate between the peer certificate and CA certificates by using valid_peer or valid as the second argument to the verify fun. See <seealso marker="public_key:cert_records">the public_key User's @@ -326,10 +326,10 @@ fun(OtpCert :: #'OTPCertificate'{}, Event :: {bad_cert, Reason :: atom()} | </item> <tag>{fail_if_no_peer_cert, boolean()}</tag> - <item>Used together with {verify, verify_peer} by a ssl server. + <item>Used together with {verify, verify_peer} by an ssl server. If set to true, the server will fail if the client does not have a certificate to send, i.e. sends a empty certificate, if set to - false it will only fail if the client sends a invalid + false it will only fail if the client sends an invalid certificate (an empty certificate is considered valid). </item> @@ -343,10 +343,10 @@ fun(OtpCert :: #'OTPCertificate'{}, Event :: {bad_cert, Reason :: atom()} | PeerCert, Compression, CipherSuite) -> boolean()}</tag> <item>Enables the ssl server to have a local policy for deciding if a session should be reused or not, - only meaning full if <c>reuse_sessions</c> is set to true. + only meaningful if <c>reuse_sessions</c> is set to true. SuggestedSessionId is a binary(), PeerCert is a DER encoded certificate, Compression is an enumeration integer - and CipherSuite of type ciphersuite(). + and CipherSuite is of type ciphersuite(). </item> </taglist> @@ -355,7 +355,7 @@ fun(OtpCert :: #'OTPCertificate'{}, Event :: {bad_cert, Reason :: atom()} | <section> <title>General</title> - <p>When a ssl socket is in active mode (the default), data from the + <p>When an ssl socket is in active mode (the default), data from the socket is delivered to the owner of the socket in the form of messages: </p> @@ -396,7 +396,7 @@ fun(OtpCert :: #'OTPCertificate'{}, Event :: {bad_cert, Reason :: atom()} | <name>connect(Socket, SslOptions, Timeout) -> {ok, SslSocket} | {error, Reason}</name> <fsummary> Upgrades a gen_tcp, or - equivalent, connected socket to a ssl socket. </fsummary> + equivalent, connected socket to an ssl socket. </fsummary> <type> <v>Socket = socket()</v> <v>SslOptions = [ssloption()]</v> @@ -405,7 +405,7 @@ fun(OtpCert :: #'OTPCertificate'{}, Event :: {bad_cert, Reason :: atom()} | <v>Reason = term()</v> </type> <desc> <p>Upgrades a gen_tcp, or equivalent, - connected socket to a ssl socket i.e. performs the + connected socket to an ssl socket i.e. performs the client-side ssl handshake.</p> </desc> </func> @@ -428,12 +428,12 @@ fun(OtpCert :: #'OTPCertificate'{}, Event :: {bad_cert, Reason :: atom()} | <func> <name>close(SslSocket) -> ok | {error, Reason}</name> - <fsummary>Close a ssl connection</fsummary> + <fsummary>Close an ssl connection</fsummary> <type> <v>SslSocket = sslsocket()</v> <v>Reason = term()</v> </type> - <desc><p>Close a ssl connection.</p> + <desc><p>Close an ssl connection.</p> </desc> </func> @@ -450,7 +450,7 @@ fun(OtpCert :: #'OTPCertificate'{}, Event :: {bad_cert, Reason :: atom()} | <v>Reason = term()</v> </type> <desc><p>Assigns a new controlling process to the ssl-socket. A - controlling process is the owner of a ssl-socket, and receives + controlling process is the owner of an ssl-socket, and receives all messages from the socket.</p> </desc> </func> @@ -480,7 +480,6 @@ fun(OtpCert :: #'OTPCertificate'{}, Event :: {bad_cert, Reason :: atom()} | </func> <func> - <name>getopts(Socket) -> </name> <name>getopts(Socket, OptionNames) -> {ok, [socketoption()]} | {error, Reason}</name> <fsummary>Get the value of the specified options.</fsummary> @@ -489,8 +488,7 @@ fun(OtpCert :: #'OTPCertificate'{}, Event :: {bad_cert, Reason :: atom()} | <v>OptionNames = [atom()]</v> </type> <desc> - <p>Get the value of the specified socket options, if no - options are specified all options are returned. + <p>Get the value of the specified socket options. </p> </desc> </func> @@ -498,14 +496,14 @@ fun(OtpCert :: #'OTPCertificate'{}, Event :: {bad_cert, Reason :: atom()} | <func> <name>listen(Port, Options) -> {ok, ListenSocket} | {error, Reason}</name> - <fsummary>Creates a ssl listen socket.</fsummary> + <fsummary>Creates an ssl listen socket.</fsummary> <type> <v>Port = integer()</v> <v>Options = options()</v> <v>ListenSocket = sslsocket()</v> </type> <desc> - <p>Creates a ssl listen socket.</p> + <p>Creates an ssl listen socket.</p> </desc> </func> @@ -589,6 +587,7 @@ fun(OtpCert :: #'OTPCertificate'{}, Event :: {bad_cert, Reason :: atom()} | the socket is closed.</p> </desc> </func> + <func> <name>setopts(Socket, Options) -> ok | {error, Reason}</name> <fsummary>Set socket options.</fsummary> @@ -648,7 +647,7 @@ fun(OtpCert :: #'OTPCertificate'{}, Event :: {bad_cert, Reason :: atom()} | </type> <desc> <p> Upgrades a gen_tcp, or - equivalent, socket to a ssl socket i.e. performs the + equivalent, socket to an ssl socket i.e. performs the ssl server-side handshake.</p> <p><warning>Note that the listen socket should be in {active, false} mode before telling the client that the server is ready to upgrade diff --git a/lib/ssl/doc/src/ssl_protocol.xml b/lib/ssl/doc/src/ssl_protocol.xml index 6936408881..ca5cc8bc7a 100644 --- a/lib/ssl/doc/src/ssl_protocol.xml +++ b/lib/ssl/doc/src/ssl_protocol.xml @@ -31,11 +31,11 @@ </p> <p>By default erlang ssl is run over the TCP/IP protocol even - though you could plug in an other reliable transport protocol + though you could plug in any other reliable transport protocol with the same API as gen_tcp.</p> <p>If a client and server wants to use an upgrade mechanism, such as - defined by RFC2817, to upgrade a regular TCP/IP connection to a ssl + defined by RFC2817, to upgrade a regular TCP/IP connection to an ssl connection the erlang ssl API supports this. This can be useful for things such as supporting HTTP and HTTPS on the same port and implementing virtual hosting. diff --git a/lib/ssl/doc/src/using_ssl.xml b/lib/ssl/doc/src/using_ssl.xml index 605290b6f9..ab837a156a 100644 --- a/lib/ssl/doc/src/using_ssl.xml +++ b/lib/ssl/doc/src/using_ssl.xml @@ -56,7 +56,7 @@ <code type="erl">1 server> ssl:start(). ok</code> - <p>Create a ssl listen socket</p> + <p>Create an ssl listen socket</p> <code type="erl">2 server> {ok, ListenSocket} = ssl:listen(9999, [{certfile, "cert.pem"}, {keyfile, "key.pem"},{reuseaddr, true}]). {ok,{sslsocket, [...]}}</code> @@ -90,7 +90,7 @@ ok</code> <section> <title>Upgrade example</title> - <note><p> To upgrade a TCP/IP connection to a ssl connection the + <note><p> To upgrade a TCP/IP connection to an ssl connection the client and server have to aggre to do so. Agreement may be accompliced by using a protocol such the one used by HTTP specified in RFC 2817.</p> </note> @@ -114,7 +114,7 @@ ok</code> <code type="erl">2 client> {ok, Socket} = gen_tcp:connect("localhost", 9999, [], infinity).</code> <p>Make sure active is set to false before trying - to upgrade a connection to a ssl connection, otherwhise + to upgrade a connection to an ssl connection, otherwhise ssl handshake messages may be deliverd to the wrong process.</p> <code type="erl">4 server> inet:setopts(Socket, [{active, false}]). ok</code> @@ -124,7 +124,7 @@ ok</code> {certfile, "cert.pem"}, {keyfile, "key.pem"}]). {ok,{sslsocket,[...]}}</code> - <p> Upgrade to a ssl connection. Note that the client and server + <p> Upgrade to an ssl connection. Note that the client and server must agree upon the upgrade and the server must call ssl:accept/2 before the client calls ssl:connect/3.</p> <code type="erl">3 client>{ok, SSLSocket} = ssl:connect(Socket, [{cacertfile, "cacerts.pem"}, diff --git a/lib/ssl/src/ssl.appup.src b/lib/ssl/src/ssl.appup.src index cf8867245b..29674f30da 100644 --- a/lib/ssl/src/ssl.appup.src +++ b/lib/ssl/src/ssl.appup.src @@ -1,6 +1,7 @@ %% -*- erlang -*- {"%VSN%", [ + {"4.1.5", [{restart_application, ssl}]}, {"4.1.4", [{restart_application, ssl}]}, {"4.1.3", [{restart_application, ssl}]}, {"4.1.2", [{restart_application, ssl}]}, @@ -9,6 +10,7 @@ {"4.0.1", [{restart_application, ssl}]} ], [ + {"4.1.5", [{restart_application, ssl}]}, {"4.1.4", [{restart_application, ssl}]}, {"4.1.3", [{restart_application, ssl}]}, {"4.1.2", [{restart_application, ssl}]}, diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index a5e8e7e5c2..59f8479a4c 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -49,9 +49,12 @@ inet_ssl, %% inet options for internal ssl socket cb %% Callback info }). --type option() :: socketoption() | ssloption() | transportoption(). --type socketoption() :: term(). %% See gen_tcp and inet, import spec later when there is one to import --type ssloption() :: {verify, verify_type()} | +-type connect_option() :: socket_connect_option() | ssl_option() | transport_option(). +-type socket_connect_option() :: gen_tcp:connect_option(). +-type listen_option() :: socket_listen_option() | ssl_option() | transport_option(). +-type socket_listen_option() :: gen_tcp:listen_option(). + +-type ssl_option() :: {verify, verify_type()} | {verify_fun, {fun(), InitialUserState::term()}} | {fail_if_no_peer_cert, boolean()} | {depth, integer()} | {cert, Der::binary()} | {certfile, path()} | {key, Der::binary()} | @@ -66,7 +69,7 @@ string(). % (according to old API) -type ssl_imp() :: new | old. --type transportoption() :: {CallbackModule::atom(), DataTag::atom(), ClosedTag::atom()}. +-type transport_option() :: {cb_info, {CallbackModule::atom(), DataTag::atom(), ClosedTag::atom()}}. %%-------------------------------------------------------------------- @@ -96,15 +99,15 @@ stop() -> application:stop(ssl). %%-------------------------------------------------------------------- --spec connect(host() | port(), [option()]) -> {ok, #sslsocket{}} | +-spec connect(host() | port(), [connect_option()]) -> {ok, #sslsocket{}} | {error, reason()}. --spec connect(host() | port(), [option()] | port_num(), timeout() | list()) -> +-spec connect(host() | port(), [connect_option()] | inet:port_number(), timeout() | list()) -> {ok, #sslsocket{}} | {error, reason()}. --spec connect(host() | port(), port_num(), list(), timeout()) -> +-spec connect(host() | port(), inet:port_number(), list(), timeout()) -> {ok, #sslsocket{}} | {error, reason()}. %% -%% Description: Connect to a ssl server. +%% Description: Connect to an ssl server. %%-------------------------------------------------------------------- connect(Socket, SslOptions) when is_port(Socket) -> connect(Socket, SslOptions, infinity). @@ -112,7 +115,7 @@ connect(Socket, SslOptions) when is_port(Socket) -> connect(Socket, SslOptions0, Timeout) when is_port(Socket) -> EmulatedOptions = emulated_options(), {ok, InetValues} = inet:getopts(Socket, EmulatedOptions), - inet:setopts(Socket, internal_inet_values()), + ok = inet:setopts(Socket, internal_inet_values()), try handle_options(SslOptions0 ++ InetValues, client) of {ok, #config{cb=CbInfo, ssl=SslOptions, emulated=EmOpts}} -> case inet:peername(Socket) of @@ -148,10 +151,10 @@ connect(Host, Port, Options0, Timeout) -> end. %%-------------------------------------------------------------------- --spec listen(port_num(), [option()]) ->{ok, #sslsocket{}} | {error, reason()}. +-spec listen(inet:port_number(), [listen_option()]) ->{ok, #sslsocket{}} | {error, reason()}. %% -%% Description: Creates a ssl listen socket. +%% Description: Creates an ssl listen socket. %%-------------------------------------------------------------------- listen(_Port, []) -> {error, enooptions}; @@ -177,7 +180,7 @@ listen(Port, Options0) -> -spec transport_accept(#sslsocket{}, timeout()) -> {ok, #sslsocket{}} | {error, reason()}. %% -%% Description: Performs transport accept on a ssl listen socket +%% Description: Performs transport accept on an ssl listen socket %%-------------------------------------------------------------------- transport_accept(ListenSocket) -> transport_accept(ListenSocket, infinity). @@ -214,11 +217,11 @@ transport_accept(#sslsocket{} = ListenSocket, Timeout) -> %%-------------------------------------------------------------------- -spec ssl_accept(#sslsocket{}) -> ok | {error, reason()}. --spec ssl_accept(#sslsocket{} | port(), timeout()| [option()]) -> +-spec ssl_accept(#sslsocket{} | port(), timeout()| [ssl_option() | transport_option()]) -> ok | {ok, #sslsocket{}} | {error, reason()}. --spec ssl_accept(port(), [option()], timeout()) -> {ok, #sslsocket{}} | {error, reason()}. +-spec ssl_accept(port(), [ssl_option()| transport_option()], timeout()) -> {ok, #sslsocket{}} | {error, reason()}. %% -%% Description: Performs accept on a ssl listen socket. e.i. performs +%% Description: Performs accept on an ssl listen socket. e.i. performs %% ssl handshake. %%-------------------------------------------------------------------- ssl_accept(ListenSocket) -> @@ -238,7 +241,7 @@ ssl_accept(#sslsocket{} = Socket, Timeout) -> ssl_accept(Socket, SslOptions, Timeout) when is_port(Socket) -> EmulatedOptions = emulated_options(), {ok, InetValues} = inet:getopts(Socket, EmulatedOptions), - inet:setopts(Socket, internal_inet_values()), + ok = inet:setopts(Socket, internal_inet_values()), try handle_options(SslOptions ++ InetValues, server) of {ok, #config{cb=CbInfo,ssl=SslOpts, emulated=EmOpts}} -> {ok, Port} = inet:port(Socket), @@ -252,7 +255,7 @@ ssl_accept(Socket, SslOptions, Timeout) when is_port(Socket) -> %%-------------------------------------------------------------------- -spec close(#sslsocket{}) -> term(). %% -%% Description: Close a ssl connection +%% Description: Close an ssl connection %%-------------------------------------------------------------------- close(#sslsocket{pid = {ListenSocket, #config{cb={CbMod,_, _, _}}}, fd = new_ssl}) -> CbMod:close(ListenSocket); @@ -373,7 +376,7 @@ select_part(plain, Cert, Opts) -> end. %%-------------------------------------------------------------------- --spec peername(#sslsocket{}) -> {ok, {tuple(), port_num()}} | {error, reason()}. +-spec peername(#sslsocket{}) -> {ok, {inet:ip_address(), inet:port_number()}} | {error, reason()}. %% %% Description: same as inet:peername/1. %%-------------------------------------------------------------------- @@ -402,29 +405,56 @@ cipher_suites(openssl) -> [ssl_cipher:openssl_suite_name(S) || S <- ssl_cipher:suites(Version)]. %%-------------------------------------------------------------------- --spec getopts(#sslsocket{}, [atom()]) -> {ok, [{atom(), term()}]} | {error, reason()}. +-spec getopts(#sslsocket{}, [gen_tcp:option_name()]) -> + {ok, [gen_tcp:option()]} | {error, reason()}. %% %% Description: Gets options %%-------------------------------------------------------------------- -getopts(#sslsocket{fd = new_ssl, pid = Pid}, OptTags) when is_pid(Pid) -> - ssl_connection:get_opts(Pid, OptTags); -getopts(#sslsocket{fd = new_ssl, pid = {ListenSocket, _}}, OptTags) -> - inet:getopts(ListenSocket, OptTags); -getopts(#sslsocket{} = Socket, Options) -> +getopts(#sslsocket{fd = new_ssl, pid = Pid}, OptionTags) when is_pid(Pid), is_list(OptionTags) -> + ssl_connection:get_opts(Pid, OptionTags); +getopts(#sslsocket{fd = new_ssl, pid = {ListenSocket, _}}, OptionTags) when is_list(OptionTags) -> + try inet:getopts(ListenSocket, OptionTags) of + {ok, _} = Result -> + Result; + {error, InetError} -> + {error, {eoptions, {inet_options, OptionTags, InetError}}} + catch + _:_ -> + {error, {eoptions, {inet_options, OptionTags}}} + end; +getopts(#sslsocket{fd = new_ssl}, OptionTags) -> + {error, {eoptions, {inet_options, OptionTags}}}; +getopts(#sslsocket{} = Socket, OptionTags) -> ensure_old_ssl_started(), - ssl_broker:getopts(Socket, Options). + ssl_broker:getopts(Socket, OptionTags). %%-------------------------------------------------------------------- --spec setopts(#sslsocket{}, [proplists:property()]) -> ok | {error, reason()}. +-spec setopts(#sslsocket{}, [gen_tcp:option()]) -> ok | {error, reason()}. %% %% Description: Sets options %%-------------------------------------------------------------------- -setopts(#sslsocket{fd = new_ssl, pid = Pid}, Opts0) when is_pid(Pid) -> - Opts = proplists:expand([{binary, [{mode, binary}]}, - {list, [{mode, list}]}], Opts0), - ssl_connection:set_opts(Pid, Opts); -setopts(#sslsocket{fd = new_ssl, pid = {ListenSocket, _}}, OptTags) -> - inet:setopts(ListenSocket, OptTags); +setopts(#sslsocket{fd = new_ssl, pid = Pid}, Options0) when is_pid(Pid), is_list(Options0) -> + try proplists:expand([{binary, [{mode, binary}]}, + {list, [{mode, list}]}], Options0) of + Options -> + ssl_connection:set_opts(Pid, Options) + catch + _:_ -> + {error, {eoptions, {not_a_proplist, Options0}}} + end; + +setopts(#sslsocket{fd = new_ssl, pid = {ListenSocket, _}}, Options) when is_list(Options) -> + try inet:setopts(ListenSocket, Options) of + ok -> + ok; + {error, InetError} -> + {error, {eoptions, {inet_options, Options, InetError}}} + catch + _:Error -> + {error, {eoptions, {inet_options, Options, Error}}} + end; +setopts(#sslsocket{fd = new_ssl}, Options) -> + {error, {eoptions,{not_a_proplist, Options}}}; setopts(#sslsocket{} = Socket, Options) -> ensure_old_ssl_started(), ssl_broker:setopts(Socket, Options). @@ -440,7 +470,7 @@ shutdown(#sslsocket{pid = Pid, fd = new_ssl}, How) -> ssl_connection:shutdown(Pid, How). %%-------------------------------------------------------------------- --spec sockname(#sslsocket{}) -> {ok, {tuple(), port_num()}} | {error, reason()}. +-spec sockname(#sslsocket{}) -> {ok, {inet:ip_address(), inet:port_number()}} | {error, reason()}. %% %% Description: Same as inet:sockname/1 %%-------------------------------------------------------------------- diff --git a/lib/ssl/src/ssl_certificate.erl b/lib/ssl/src/ssl_certificate.erl index 8c0c2bfa5d..422ea6404b 100644 --- a/lib/ssl/src/ssl_certificate.erl +++ b/lib/ssl/src/ssl_certificate.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2010. All Rights Reserved. +%% Copyright Ericsson AB 2007-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -30,9 +30,9 @@ -include("ssl_internal.hrl"). -include_lib("public_key/include/public_key.hrl"). --export([trusted_cert_and_path/2, - certificate_chain/2, - file_to_certificats/1, +-export([trusted_cert_and_path/3, + certificate_chain/3, + file_to_certificats/2, validate_extension/3, is_valid_extkey_usage/2, is_valid_key_usage/2, @@ -46,14 +46,14 @@ %%==================================================================== %%-------------------------------------------------------------------- --spec trusted_cert_and_path([der_cert()], certdb_ref()) -> +-spec trusted_cert_and_path([der_cert()], db_handle(), certdb_ref()) -> {der_cert() | unknown_ca, [der_cert()]}. %% %% Description: Extracts the root cert (if not presents tries to %% look it up, if not found {bad_cert, unknown_ca} will be added verification %% errors. Returns {RootCert, Path, VerifyErrors} %%-------------------------------------------------------------------- -trusted_cert_and_path(CertChain, CertDbRef) -> +trusted_cert_and_path(CertChain, CertDbHandle, CertDbRef) -> Path = [Cert | _] = lists:reverse(CertChain), OtpCert = public_key:pkix_decode_cert(Cert, otp), SignedAndIssuerID = @@ -66,7 +66,7 @@ trusted_cert_and_path(CertChain, CertDbRef) -> {ok, IssuerId} -> {other, IssuerId}; {error, issuer_not_found} -> - case find_issuer(OtpCert, no_candidate) of + case find_issuer(OtpCert, no_candidate, CertDbHandle) of {ok, IssuerId} -> {other, IssuerId}; Other -> @@ -82,7 +82,7 @@ trusted_cert_and_path(CertChain, CertDbRef) -> {self, _} when length(Path) == 1 -> {selfsigned_peer, Path}; {_ ,{SerialNr, Issuer}} -> - case ssl_manager:lookup_trusted_cert(CertDbRef, SerialNr, Issuer) of + case ssl_manager:lookup_trusted_cert(CertDbHandle, CertDbRef, SerialNr, Issuer) of {ok, {BinCert,_}} -> {BinCert, Path}; _ -> @@ -92,23 +92,23 @@ trusted_cert_and_path(CertChain, CertDbRef) -> end. %%-------------------------------------------------------------------- --spec certificate_chain(undefined | binary(), certdb_ref()) -> +-spec certificate_chain(undefined | binary(), db_handle(), certdb_ref()) -> {error, no_cert} | {ok, [der_cert()]}. %% %% Description: Return the certificate chain to send to peer. %%-------------------------------------------------------------------- -certificate_chain(undefined, _CertsDbRef) -> +certificate_chain(undefined, _, _) -> {error, no_cert}; -certificate_chain(OwnCert, CertsDbRef) -> +certificate_chain(OwnCert, CertDbHandle, CertsDbRef) -> ErlCert = public_key:pkix_decode_cert(OwnCert, otp), - certificate_chain(ErlCert, OwnCert, CertsDbRef, [OwnCert]). + certificate_chain(ErlCert, OwnCert, CertDbHandle, CertsDbRef, [OwnCert]). %%-------------------------------------------------------------------- --spec file_to_certificats(string()) -> [der_cert()]. +-spec file_to_certificats(string(), term()) -> [der_cert()]. %% %% Description: Return list of DER encoded certificates. %%-------------------------------------------------------------------- -file_to_certificats(File) -> - {ok, List} = ssl_manager:cache_pem_file(File), +file_to_certificats(File, DbHandle) -> + {ok, List} = ssl_manager:cache_pem_file(File, DbHandle), [Bin || {'Certificate', Bin, not_encrypted} <- List]. %%-------------------------------------------------------------------- -spec validate_extension(term(), #'Extension'{} | {bad_cert, atom()} | valid, @@ -180,7 +180,7 @@ signature_type(?'id-dsa-with-sha1') -> %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- -certificate_chain(OtpCert, _Cert, CertsDbRef, Chain) -> +certificate_chain(OtpCert, _Cert, CertDbHandle, CertsDbRef, Chain) -> IssuerAndSelfSigned = case public_key:pkix_is_self_signed(OtpCert) of true -> @@ -191,11 +191,11 @@ certificate_chain(OtpCert, _Cert, CertsDbRef, Chain) -> case IssuerAndSelfSigned of {_, true = SelfSigned} -> - certificate_chain(CertsDbRef, Chain, ignore, ignore, SelfSigned); + certificate_chain(CertDbHandle, CertsDbRef, Chain, ignore, ignore, SelfSigned); {{error, issuer_not_found}, SelfSigned} -> - case find_issuer(OtpCert, no_candidate) of + case find_issuer(OtpCert, no_candidate, CertDbHandle) of {ok, {SerialNr, Issuer}} -> - certificate_chain(CertsDbRef, Chain, + certificate_chain(CertDbHandle, CertsDbRef, Chain, SerialNr, Issuer, SelfSigned); _ -> %% Guess the the issuer must be the root @@ -205,19 +205,19 @@ certificate_chain(OtpCert, _Cert, CertsDbRef, Chain) -> {ok, lists:reverse(Chain)} end; {{ok, {SerialNr, Issuer}}, SelfSigned} -> - certificate_chain(CertsDbRef, Chain, SerialNr, Issuer, SelfSigned) + certificate_chain(CertDbHandle, CertsDbRef, Chain, SerialNr, Issuer, SelfSigned) end. -certificate_chain(_CertsDbRef, Chain, _SerialNr, _Issuer, true) -> +certificate_chain(_,_, Chain, _SerialNr, _Issuer, true) -> {ok, lists:reverse(Chain)}; -certificate_chain(CertsDbRef, Chain, SerialNr, Issuer, _SelfSigned) -> - case ssl_manager:lookup_trusted_cert(CertsDbRef, +certificate_chain(CertDbHandle, CertsDbRef, Chain, SerialNr, Issuer, _SelfSigned) -> + case ssl_manager:lookup_trusted_cert(CertDbHandle, CertsDbRef, SerialNr, Issuer) of {ok, {IssuerCert, ErlCert}} -> ErlCert = public_key:pkix_decode_cert(IssuerCert, otp), certificate_chain(ErlCert, IssuerCert, - CertsDbRef, [IssuerCert | Chain]); + CertDbHandle, CertsDbRef, [IssuerCert | Chain]); _ -> %% The trusted cert may be obmitted from the chain as the %% counter part needs to have it anyway to be able to @@ -227,8 +227,8 @@ certificate_chain(CertsDbRef, Chain, SerialNr, Issuer, _SelfSigned) -> {ok, lists:reverse(Chain)} end. -find_issuer(OtpCert, PrevCandidateKey) -> - case ssl_manager:issuer_candidate(PrevCandidateKey) of +find_issuer(OtpCert, PrevCandidateKey, CertDbHandle) -> + case ssl_manager:issuer_candidate(PrevCandidateKey, CertDbHandle) of no_more_candidates -> {error, issuer_not_found}; {Key, {_Cert, ErlCertCandidate}} -> @@ -236,7 +236,7 @@ find_issuer(OtpCert, PrevCandidateKey) -> true -> public_key:pkix_issuer_id(ErlCertCandidate, self); false -> - find_issuer(OtpCert, Key) + find_issuer(OtpCert, Key, CertDbHandle) end end. diff --git a/lib/ssl/src/ssl_certificate_db.erl b/lib/ssl/src/ssl_certificate_db.erl index 3eceefa304..0560a02110 100644 --- a/lib/ssl/src/ssl_certificate_db.erl +++ b/lib/ssl/src/ssl_certificate_db.erl @@ -26,8 +26,8 @@ -include_lib("public_key/include/public_key.hrl"). -export([create/0, remove/1, add_trusted_certs/3, - remove_trusted_certs/2, lookup_trusted_cert/3, issuer_candidate/1, - lookup_cached_certs/1, cache_pem_file/4, uncache_pem_file/2, lookup/2]). + remove_trusted_certs/2, lookup_trusted_cert/4, issuer_candidate/2, + lookup_cached_certs/2, cache_pem_file/4, uncache_pem_file/2, lookup/2]). -type time() :: {non_neg_integer(), non_neg_integer(), non_neg_integer()}. @@ -36,19 +36,19 @@ %%==================================================================== %%-------------------------------------------------------------------- --spec create() -> certdb_ref(). +-spec create() -> [db_handle()]. %% %% Description: Creates a new certificate db. -%% Note: lookup_trusted_cert/3 may be called from any process but only +%% Note: lookup_trusted_cert/4 may be called from any process but only %% the process that called create may call the other functions. %%-------------------------------------------------------------------- create() -> - [ets:new(certificate_db_name(), [named_table, set, protected]), - ets:new(ssl_file_to_ref, [named_table, set, protected]), + [ets:new(ssl_otp_certificate_db, [set, protected]), + ets:new(ssl_file_to_ref, [set, protected]), ets:new(ssl_pid_to_file, [bag, private])]. %%-------------------------------------------------------------------- --spec remove(certdb_ref()) -> term(). +-spec remove([db_handle()]) -> term(). %% %% Description: Removes database db %%-------------------------------------------------------------------- @@ -56,7 +56,7 @@ remove(Dbs) -> lists:foreach(fun(Db) -> true = ets:delete(Db) end, Dbs). %%-------------------------------------------------------------------- --spec lookup_trusted_cert(reference(), serialnumber(), issuer()) -> +-spec lookup_trusted_cert(db_handle(), certdb_ref(), serialnumber(), issuer()) -> undefined | {ok, {der_cert(), #'OTPCertificate'{}}}. %% @@ -64,19 +64,19 @@ remove(Dbs) -> %% <SerialNumber, Issuer>. Ref is used as it is specified %% for each connection which certificates are trusted. %%-------------------------------------------------------------------- -lookup_trusted_cert(Ref, SerialNumber, Issuer) -> - case lookup({Ref, SerialNumber, Issuer}, certificate_db_name()) of +lookup_trusted_cert(DbHandle, Ref, SerialNumber, Issuer) -> + case lookup({Ref, SerialNumber, Issuer}, DbHandle) of undefined -> undefined; [Certs] -> {ok, Certs} end. -lookup_cached_certs(File) -> - ets:lookup(certificate_db_name(), {file, File}). +lookup_cached_certs(DbHandle, File) -> + ets:lookup(DbHandle, {file, File}). %%-------------------------------------------------------------------- --spec add_trusted_certs(pid(), string() | {der, list()}, certdb_ref()) -> {ok, certdb_ref()}. +-spec add_trusted_certs(pid(), string() | {der, list()}, [db_handle()]) -> {ok, [db_handle()]}. %% %% Description: Adds the trusted certificates from file <File> to the %% runtime database. Returns Ref that should be handed to lookup_trusted_cert @@ -100,7 +100,7 @@ add_trusted_certs(Pid, File, [CertsDb, FileToRefDb, PidToFileDb]) -> insert(Pid, File, PidToFileDb), {ok, Ref}. %%-------------------------------------------------------------------- --spec cache_pem_file(pid(), string(), time(), certdb_ref()) -> term(). +-spec cache_pem_file(pid(), string(), time(), [db_handle()]) -> term(). %% %% Description: Cache file as binary in DB %%-------------------------------------------------------------------- @@ -112,7 +112,7 @@ cache_pem_file(Pid, File, Time, [CertsDb, _FileToRefDb, PidToFileDb]) -> {ok, Content}. %-------------------------------------------------------------------- --spec uncache_pem_file(string(), certdb_ref()) -> no_return(). +-spec uncache_pem_file(string(), [db_handle()]) -> no_return(). %% %% Description: If a cached file is no longer valid (changed on disk) %% we must terminate the connections using the old file content, and @@ -130,7 +130,7 @@ uncache_pem_file(File, [_CertsDb, _FileToRefDb, PidToFileDb]) -> %%-------------------------------------------------------------------- --spec remove_trusted_certs(pid(), certdb_ref()) -> term(). +-spec remove_trusted_certs(pid(), [db_handle()]) -> term(). %% %% Description: Removes trusted certs originating from @@ -161,7 +161,7 @@ remove_trusted_certs(Pid, [CertsDb, FileToRefDb, PidToFileDb]) -> end. %%-------------------------------------------------------------------- --spec issuer_candidate(no_candidate | cert_key() | {file, term()}) -> +-spec issuer_candidate(no_candidate | cert_key() | {file, term()}, term()) -> {cert_key(),{der_cert(), #'OTPCertificate'{}}} | no_more_candidates. %% %% Description: If a certificat does not define its issuer through @@ -169,32 +169,30 @@ remove_trusted_certs(Pid, [CertsDb, FileToRefDb, PidToFileDb]) -> %% try to find the issuer in the database over known %% certificates. %%-------------------------------------------------------------------- -issuer_candidate(no_candidate) -> - Db = certificate_db_name(), +issuer_candidate(no_candidate, Db) -> case ets:first(Db) of '$end_of_table' -> no_more_candidates; {file, _} = Key -> - issuer_candidate(Key); + issuer_candidate(Key, Db); Key -> [Cert] = lookup(Key, Db), {Key, Cert} end; -issuer_candidate(PrevCandidateKey) -> - Db = certificate_db_name(), +issuer_candidate(PrevCandidateKey, Db) -> case ets:next(Db, PrevCandidateKey) of '$end_of_table' -> no_more_candidates; {file, _} = Key -> - issuer_candidate(Key); + issuer_candidate(Key, Db); Key -> [Cert] = lookup(Key, Db), {Key, Cert} end. %%-------------------------------------------------------------------- --spec lookup(term(), term()) -> term() | undefined. +-spec lookup(term(), db_handle()) -> term() | undefined. %% %% Description: Looks up an element in a certificat <Db>. %%-------------------------------------------------------------------- @@ -212,9 +210,6 @@ lookup(Key, Db) -> %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- -certificate_db_name() -> - ssl_otp_certificate_db. - insert(Key, Data, Db) -> true = ets:insert(Db, {Key, Data}). diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index 2c452837f8..cec81d551b 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -70,6 +70,7 @@ %% {{md5_hash, sha_hash}, {prev_md5, prev_sha}} (binary()) tls_handshake_hashes, % see above tls_cipher_texts, % list() received but not deciphered yet + cert_db, % session, % #session{} from ssl_handshake.hrl session_cache, % session_cache_cb, % @@ -126,11 +127,11 @@ send(Pid, Data) -> recv(Pid, Length, Timeout) -> sync_send_all_state_event(Pid, {recv, Length}, Timeout). %%-------------------------------------------------------------------- --spec connect(host(), port_num(), port(), {#ssl_options{}, #socket_options{}}, +-spec connect(host(), inet:port_number(), port(), {#ssl_options{}, #socket_options{}}, pid(), tuple(), timeout()) -> {ok, #sslsocket{}} | {error, reason()}. %% -%% Description: Connect to a ssl server. +%% Description: Connect to an ssl server. %%-------------------------------------------------------------------- connect(Host, Port, Socket, Options, User, CbInfo, Timeout) -> try start_fsm(client, Host, Port, Socket, Options, User, CbInfo, @@ -140,11 +141,11 @@ connect(Host, Port, Socket, Options, User, CbInfo, Timeout) -> {error, ssl_not_started} end. %%-------------------------------------------------------------------- --spec ssl_accept(port_num(), port(), {#ssl_options{}, #socket_options{}}, +-spec ssl_accept(inet:port_number(), port(), {#ssl_options{}, #socket_options{}}, pid(), tuple(), timeout()) -> {ok, #sslsocket{}} | {error, reason()}. %% -%% Description: Performs accept on a ssl listen socket. e.i. performs +%% Description: Performs accept on an ssl listen socket. e.i. performs %% ssl handshake. %%-------------------------------------------------------------------- ssl_accept(Port, Socket, Opts, User, CbInfo, Timeout) -> @@ -184,7 +185,7 @@ socket_control(Socket, Pid, CbModule) -> %%-------------------------------------------------------------------- -spec close(pid()) -> ok | {error, reason()}. %% -%% Description: Close a ssl connection +%% Description: Close an ssl connection %%-------------------------------------------------------------------- close(ConnectionPid) -> case sync_send_all_state_event(ConnectionPid, close) of @@ -211,14 +212,14 @@ shutdown(ConnectionPid, How) -> new_user(ConnectionPid, User) -> sync_send_all_state_event(ConnectionPid, {new_user, User}). %%-------------------------------------------------------------------- --spec sockname(pid()) -> {ok, {tuple(), port_num()}} | {error, reason()}. +-spec sockname(pid()) -> {ok, {inet:ip_address(), inet:port_number()}} | {error, reason()}. %% %% Description: Same as inet:sockname/1 %%-------------------------------------------------------------------- sockname(ConnectionPid) -> sync_send_all_state_event(ConnectionPid, sockname). %%-------------------------------------------------------------------- --spec peername(pid()) -> {ok, {tuple(), port_num()}} | {error, reason()}. +-spec peername(pid()) -> {ok, {inet:ip_address(), inet:port_number()}} | {error, reason()}. %% %% Description: Same as inet:peername/1 %%-------------------------------------------------------------------- @@ -276,7 +277,7 @@ renegotiation(ConnectionPid) -> %%==================================================================== %%-------------------------------------------------------------------- --spec start_link(atom(), host(), port_num(), port(), list(), pid(), tuple()) -> +-spec start_link(atom(), host(), inet:port_number(), port(), list(), pid(), tuple()) -> {ok, pid()} | ignore | {error, reason()}. %% %% Description: Creates a gen_fsm process which calls Module:init/1 to @@ -305,12 +306,13 @@ init([Role, Host, Port, Socket, {SSLOpts0, _} = Options, Hashes0 = ssl_handshake:init_hashes(), try ssl_init(SSLOpts0, Role) of - {ok, Ref, CacheRef, OwnCert, Key, DHParams} -> + {ok, Ref, CertDbHandle, CacheHandle, OwnCert, Key, DHParams} -> Session = State0#state.session, State = State0#state{tls_handshake_hashes = Hashes0, session = Session#session{own_certificate = OwnCert}, cert_db_ref = Ref, - session_cache = CacheRef, + cert_db = CertDbHandle, + session_cache = CacheHandle, private_key = Key, diffie_hellman_params = DHParams}, {ok, hello, State, get_timeout(State)} @@ -500,9 +502,10 @@ certify(#certificate{asn1_certificates = []}, certify(#certificate{} = Cert, #state{negotiated_version = Version, role = Role, + cert_db = CertDbHandle, cert_db_ref = CertDbRef, ssl_options = Opts} = State) -> - case ssl_handshake:certify(Cert, CertDbRef, Opts#ssl_options.depth, + case ssl_handshake:certify(Cert, CertDbHandle, CertDbRef, Opts#ssl_options.depth, Opts#ssl_options.verify, Opts#ssl_options.verify_fun, Role) of {PeerCert, PublicKeyInfo} -> @@ -859,23 +862,23 @@ handle_sync_event({set_opts, Opts0}, _From, StateName, #state{socket_options = Opts1, socket = Socket, user_data_buffer = Buffer} = State0) -> - Opts = set_socket_opts(Socket, Opts0, Opts1, []), + {Reply, Opts} = set_socket_opts(Socket, Opts0, Opts1, []), State1 = State0#state{socket_options = Opts}, if Opts#socket_options.active =:= false -> - {reply, ok, StateName, State1, get_timeout(State1)}; + {reply, Reply, StateName, State1, get_timeout(State1)}; Buffer =:= <<>>, Opts1#socket_options.active =:= false -> %% Need data, set active once {Record, State2} = next_record_if_active(State1), case next_state(StateName, Record, State2) of {next_state, StateName, State, Timeout} -> - {reply, ok, StateName, State, Timeout}; + {reply, Reply, StateName, State, Timeout}; {stop, Reason, State} -> {stop, Reason, State} end; Buffer =:= <<>> -> %% Active once already set - {reply, ok, StateName, State1, get_timeout(State1)}; + {reply, Reply, StateName, State1, get_timeout(State1)}; true -> case application_data(<<>>, State1) of Stop = {stop,_,_} -> @@ -883,7 +886,7 @@ handle_sync_event({set_opts, Opts0}, _From, StateName, {Record, State2} -> case next_state(StateName, Record, State2) of {next_state, StateName, State, Timeout} -> - {reply, ok, StateName, State, Timeout}; + {reply, Reply, StateName, State, Timeout}; {stop, Reason, State} -> {stop, Reason, State} end @@ -1044,19 +1047,19 @@ start_fsm(Role, Host, Port, Socket, Opts, User, {CbModule, _,_, _} = CbInfo, end. ssl_init(SslOpts, Role) -> - {ok, CertDbRef, CacheRef, OwnCert} = init_certificates(SslOpts, Role), + {ok, CertDbRef, CertDbHandle, CacheHandle, OwnCert} = init_certificates(SslOpts, Role), PrivateKey = - init_private_key(SslOpts#ssl_options.key, SslOpts#ssl_options.keyfile, + init_private_key(CertDbHandle, SslOpts#ssl_options.key, SslOpts#ssl_options.keyfile, SslOpts#ssl_options.password, Role), - DHParams = init_diffie_hellman(SslOpts#ssl_options.dh, SslOpts#ssl_options.dhfile, Role), - {ok, CertDbRef, CacheRef, OwnCert, PrivateKey, DHParams}. + DHParams = init_diffie_hellman(CertDbHandle, SslOpts#ssl_options.dh, SslOpts#ssl_options.dhfile, Role), + {ok, CertDbRef, CertDbHandle, CacheHandle, OwnCert, PrivateKey, DHParams}. init_certificates(#ssl_options{cacerts = CaCerts, cacertfile = CACertFile, certfile = CertFile, cert = Cert}, Role) -> - {ok, CertDbRef, CacheRef} = + {ok, CertDbRef, CertDbHandle, CacheHandle} = try Certs = case CaCerts of undefined -> @@ -1064,44 +1067,44 @@ init_certificates(#ssl_options{cacerts = CaCerts, _ -> {der, CaCerts} end, - {ok, _, _} = ssl_manager:connection_init(Certs, Role) + {ok, _, _, _} = ssl_manager:connection_init(Certs, Role) catch Error:Reason -> handle_file_error(?LINE, Error, Reason, CACertFile, ecacertfile, erlang:get_stacktrace()) end, - init_certificates(Cert, CertDbRef, CacheRef, CertFile, Role). + init_certificates(Cert, CertDbRef, CertDbHandle, CacheHandle, CertFile, Role). -init_certificates(undefined, CertDbRef, CacheRef, "", _) -> - {ok, CertDbRef, CacheRef, undefined}; +init_certificates(undefined, CertDbRef, CertDbHandle, CacheHandle, "", _) -> + {ok, CertDbRef, CertDbHandle, CacheHandle, undefined}; -init_certificates(undefined, CertDbRef, CacheRef, CertFile, client) -> +init_certificates(undefined, CertDbRef, CertDbHandle, CacheHandle, CertFile, client) -> try - [OwnCert] = ssl_certificate:file_to_certificats(CertFile), - {ok, CertDbRef, CacheRef, OwnCert} + [OwnCert] = ssl_certificate:file_to_certificats(CertFile, CertDbHandle), + {ok, CertDbRef, CertDbHandle, CacheHandle, OwnCert} catch _Error:_Reason -> - {ok, CertDbRef, CacheRef, undefined} + {ok, CertDbRef, CertDbHandle, CacheHandle, undefined} end; -init_certificates(undefined, CertDbRef, CacheRef, CertFile, server) -> +init_certificates(undefined, CertDbRef, CertDbHandle, CacheRef, CertFile, server) -> try - [OwnCert] = ssl_certificate:file_to_certificats(CertFile), - {ok, CertDbRef, CacheRef, OwnCert} + [OwnCert] = ssl_certificate:file_to_certificats(CertFile, CertDbHandle), + {ok, CertDbRef, CertDbHandle, CacheRef, OwnCert} catch Error:Reason -> handle_file_error(?LINE, Error, Reason, CertFile, ecertfile, erlang:get_stacktrace()) end; -init_certificates(Cert, CertDbRef, CacheRef, _, _) -> - {ok, CertDbRef, CacheRef, Cert}. +init_certificates(Cert, CertDbRef, CertDbHandle, CacheRef, _, _) -> + {ok, CertDbRef, CertDbHandle, CacheRef, Cert}. -init_private_key(undefined, "", _Password, _Client) -> +init_private_key(_, undefined, "", _Password, _Client) -> undefined; -init_private_key(undefined, KeyFile, Password, _) -> +init_private_key(DbHandle, undefined, KeyFile, Password, _) -> try - {ok, List} = ssl_manager:cache_pem_file(KeyFile), + {ok, List} = ssl_manager:cache_pem_file(KeyFile, DbHandle), [PemEntry] = [PemEntry || PemEntry = {PKey, _ , _} <- List, - PKey =:= 'RSAPrivateKey' orelse + PKey =:= 'RSAPrivateKey' orelse PKey =:= 'DSAPrivateKey'], public_key:pem_entry_decode(PemEntry, Password) catch @@ -1110,9 +1113,9 @@ init_private_key(undefined, KeyFile, Password, _) -> erlang:get_stacktrace()) end; -init_private_key({rsa, PrivateKey}, _, _,_) -> +init_private_key(_,{rsa, PrivateKey}, _, _,_) -> public_key:der_decode('RSAPrivateKey', PrivateKey); -init_private_key({dsa, PrivateKey},_,_,_) -> +init_private_key(_,{dsa, PrivateKey},_,_,_) -> public_key:der_decode('DSAPrivateKey', PrivateKey). -spec(handle_file_error(_,_,_,_,_,_) -> no_return()). @@ -1128,15 +1131,15 @@ file_error(Line, Error, Reason, File, Throw, Stack) -> error_logger:error_report(Report), throw(Throw). -init_diffie_hellman(Params, _,_) when is_binary(Params)-> +init_diffie_hellman(_,Params, _,_) when is_binary(Params)-> public_key:der_decode('DHParameter', Params); -init_diffie_hellman(_,_, client) -> +init_diffie_hellman(_,_,_, client) -> undefined; -init_diffie_hellman(_,undefined, _) -> +init_diffie_hellman(_,_,undefined, _) -> ?DEFAULT_DIFFIE_HELLMAN_PARAMS; -init_diffie_hellman(_, DHParamFile, server) -> +init_diffie_hellman(DbHandle,_, DHParamFile, server) -> try - {ok, List} = ssl_manager:cache_pem_file(DHParamFile), + {ok, List} = ssl_manager:cache_pem_file(DHParamFile,DbHandle), case [Entry || Entry = {'DHParameter', _ , _} <- List] of [Entry] -> public_key:pem_entry_decode(Entry); @@ -1180,11 +1183,12 @@ certify_client(#state{client_certificate_requested = true, role = client, connection_states = ConnectionStates0, transport_cb = Transport, negotiated_version = Version, + cert_db = CertDbHandle, cert_db_ref = CertDbRef, session = #session{own_certificate = OwnCert}, socket = Socket, tls_handshake_hashes = Hashes0} = State) -> - Certificate = ssl_handshake:certificate(OwnCert, CertDbRef, client), + Certificate = ssl_handshake:certificate(OwnCert, CertDbHandle, CertDbRef, client), {BinCert, ConnectionStates1, Hashes1} = encode_handshake(Certificate, Version, ConnectionStates0, Hashes0), Transport:send(Socket, BinCert), @@ -1365,9 +1369,10 @@ certify_server(#state{transport_cb = Transport, negotiated_version = Version, connection_states = ConnectionStates, tls_handshake_hashes = Hashes, + cert_db = CertDbHandle, cert_db_ref = CertDbRef, session = #session{own_certificate = OwnCert}} = State) -> - case ssl_handshake:certificate(OwnCert, CertDbRef, server) of + case ssl_handshake:certificate(OwnCert, CertDbHandle, CertDbRef, server) of CertMsg = #certificate{} -> {BinCertMsg, NewConnectionStates, NewHashes} = encode_handshake(CertMsg, Version, ConnectionStates, Hashes), @@ -1454,12 +1459,13 @@ rsa_key_exchange(_, _) -> request_client_cert(#state{ssl_options = #ssl_options{verify = verify_peer}, connection_states = ConnectionStates0, + cert_db = CertDbHandle, cert_db_ref = CertDbRef, tls_handshake_hashes = Hashes0, negotiated_version = Version, socket = Socket, transport_cb = Transport} = State) -> - Msg = ssl_handshake:certificate_request(ConnectionStates0, CertDbRef), + Msg = ssl_handshake:certificate_request(ConnectionStates0, CertDbHandle, CertDbRef), {BinMsg, ConnectionStates1, Hashes1} = encode_handshake(Msg, Version, ConnectionStates0, Hashes0), Transport:send(Socket, BinMsg), @@ -1772,7 +1778,8 @@ format_reply(binary, _, N, Data) when N > 0 -> % Header mode format_reply(binary, _, _, Data) -> Data; format_reply(list, Packet, _, Data) - when Packet == http; Packet == {http, headers}; Packet == http_bin; Packet == {http_bin, headers} -> + when Packet == http; Packet == {http, headers}; Packet == http_bin; Packet == {http_bin, headers}; Packet == httph; + Packet == httph_bin-> Data; format_reply(list, _,_, Data) -> binary_to_list(Data). @@ -2040,31 +2047,69 @@ get_socket_opts(Socket, [active | Tags], SockOpts, Acc) -> get_socket_opts(Socket, Tags, SockOpts, [{active, SockOpts#socket_options.active} | Acc]); get_socket_opts(Socket, [Tag | Tags], SockOpts, Acc) -> - case inet:getopts(Socket, [Tag]) of + try inet:getopts(Socket, [Tag]) of {ok, [Opt]} -> get_socket_opts(Socket, Tags, SockOpts, [Opt | Acc]); {error, Error} -> - {error, Error} - end. + {error, {eoptions, {inet_option, Tag, Error}}} + catch + %% So that inet behavior does not crash our process + _:Error -> {error, {eoptions, {inet_option, Tag, Error}}} + end; +get_socket_opts(_,Opts, _,_) -> + {error, {eoptions, {inet_option, Opts, function_clause}}}. set_socket_opts(_, [], SockOpts, []) -> - SockOpts; + {ok, SockOpts}; set_socket_opts(Socket, [], SockOpts, Other) -> %% Set non emulated options - inet:setopts(Socket, Other), - SockOpts; -set_socket_opts(Socket, [{mode, Mode}| Opts], SockOpts, Other) -> + try inet:setopts(Socket, Other) of + ok -> + {ok, SockOpts}; + {error, InetError} -> + {{error, {eoptions, {inet_options, Other, InetError}}}, SockOpts} + catch + _:Error -> + %% So that inet behavior does not crash our process + {{error, {eoptions, {inet_options, Other, Error}}}, SockOpts} + end; + +set_socket_opts(Socket, [{mode, Mode}| Opts], SockOpts, Other) when Mode == list; Mode == binary -> set_socket_opts(Socket, Opts, SockOpts#socket_options{mode = Mode}, Other); -set_socket_opts(Socket, [{packet, Packet}| Opts], SockOpts, Other) -> +set_socket_opts(_, [{mode, _} = Opt| _], SockOpts, _) -> + {{error, {eoptions, {inet_opt, Opt}}}, SockOpts}; +set_socket_opts(Socket, [{packet, Packet}| Opts], SockOpts, Other) when Packet == raw; + Packet == 0; + Packet == 1; + Packet == 2; + Packet == 4; + Packet == asn1; + Packet == cdr; + Packet == sunrm; + Packet == fcgi; + Packet == tpkt; + Packet == line; + Packet == http; + Packet == httph; + Packet == http_bin; + Packet == httph_bin -> set_socket_opts(Socket, Opts, SockOpts#socket_options{packet = Packet}, Other); -set_socket_opts(Socket, [{header, Header}| Opts], SockOpts, Other) -> +set_socket_opts(_, [{packet, _} = Opt| _], SockOpts, _) -> + {{error, {eoptions, {inet_opt, Opt}}}, SockOpts}; +set_socket_opts(Socket, [{header, Header}| Opts], SockOpts, Other) when is_integer(Header) -> set_socket_opts(Socket, Opts, SockOpts#socket_options{header = Header}, Other); -set_socket_opts(Socket, [{active, Active}| Opts], SockOpts, Other) -> +set_socket_opts(_, [{header, _} = Opt| _], SockOpts, _) -> + {{error,{eoptions, {inet_opt, Opt}}}, SockOpts}; +set_socket_opts(Socket, [{active, Active}| Opts], SockOpts, Other) when Active == once; + Active == true; + Active == false -> set_socket_opts(Socket, Opts, SockOpts#socket_options{active = Active}, Other); +set_socket_opts(_, [{active, _} = Opt| _], SockOpts, _) -> + {{error, {eoptions, {inet_opt, Opt}} }, SockOpts}; set_socket_opts(Socket, [Opt | Opts], SockOpts, Other) -> set_socket_opts(Socket, Opts, SockOpts, [Opt | Other]). diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl index 1f4c44d115..453ea20f99 100644 --- a/lib/ssl/src/ssl_handshake.erl +++ b/lib/ssl/src/ssl_handshake.erl @@ -31,9 +31,9 @@ -include_lib("public_key/include/public_key.hrl"). -export([master_secret/4, client_hello/6, server_hello/4, hello/4, - hello_request/0, certify/6, certificate/3, + hello_request/0, certify/7, certificate/4, client_certificate_verify/5, certificate_verify/5, - certificate_request/2, key_exchange/2, server_key_exchange_hash/2, + certificate_request/3, key_exchange/2, server_key_exchange_hash/2, finished/4, verify_connection/5, get_tls_handshake/2, decode_client_key/3, server_hello_done/0, encode_handshake/2, init_hashes/0, update_hashes/2, @@ -48,7 +48,7 @@ %% Internal application API %%==================================================================== %%-------------------------------------------------------------------- --spec client_hello(host(), port_num(), #connection_states{}, +-spec client_hello(host(), inet:port_number(), #connection_states{}, #ssl_options{}, boolean(), der_cert()) -> #client_hello{}. %% %% Description: Creates a client hello message. @@ -106,7 +106,7 @@ hello_request() -> %%-------------------------------------------------------------------- -spec hello(#server_hello{} | #client_hello{}, #ssl_options{}, - #connection_states{} | {port_num(), #session{}, cache_ref(), + #connection_states{} | {inet:port_number(), #session{}, db_handle(), atom(), #connection_states{}, binary()}, boolean()) -> {tls_version(), session_id(), #connection_states{}}| {tls_version(), {resumed | new, #session{}}, @@ -173,13 +173,13 @@ hello(#client_hello{client_version = ClientVersion, random = Random, end. %%-------------------------------------------------------------------- --spec certify(#certificate{}, term(), integer() | nolimit, +-spec certify(#certificate{}, db_handle(), certdb_ref(), integer() | nolimit, verify_peer | verify_none, {fun(), term}, client | server) -> {der_cert(), public_key_info()} | #alert{}. %% %% Description: Handles a certificate handshake message %%-------------------------------------------------------------------- -certify(#certificate{asn1_certificates = ASN1Certs}, CertDbRef, +certify(#certificate{asn1_certificates = ASN1Certs}, CertDbHandle, CertDbRef, MaxPathLen, _Verify, VerifyFunAndState, Role) -> [PeerCert | _] = ASN1Certs, @@ -208,7 +208,7 @@ certify(#certificate{asn1_certificates = ASN1Certs}, CertDbRef, end, {TrustedErlCert, CertPath} = - ssl_certificate:trusted_cert_and_path(ASN1Certs, CertDbRef), + ssl_certificate:trusted_cert_and_path(ASN1Certs, CertDbHandle, CertDbRef), case public_key:pkix_path_validation(TrustedErlCert, CertPath, @@ -222,13 +222,13 @@ certify(#certificate{asn1_certificates = ASN1Certs}, CertDbRef, end. %%-------------------------------------------------------------------- --spec certificate(der_cert(), term(), client | server) -> #certificate{} | #alert{}. +-spec certificate(der_cert(), db_handle(), certdb_ref(), client | server) -> #certificate{} | #alert{}. %% %% Description: Creates a certificate message. %%-------------------------------------------------------------------- -certificate(OwnCert, CertDbRef, client) -> +certificate(OwnCert, CertDbHandle, CertDbRef, client) -> Chain = - case ssl_certificate:certificate_chain(OwnCert, CertDbRef) of + case ssl_certificate:certificate_chain(OwnCert, CertDbHandle, CertDbRef) of {ok, CertChain} -> CertChain; {error, _} -> @@ -239,8 +239,8 @@ certificate(OwnCert, CertDbRef, client) -> end, #certificate{asn1_certificates = Chain}; -certificate(OwnCert, CertDbRef, server) -> - case ssl_certificate:certificate_chain(OwnCert, CertDbRef) of +certificate(OwnCert, CertDbHandle, CertDbRef, server) -> + case ssl_certificate:certificate_chain(OwnCert, CertDbHandle, CertDbRef) of {ok, Chain} -> #certificate{asn1_certificates = Chain}; {error, _} -> @@ -302,17 +302,17 @@ certificate_verify(Signature, {?'id-dsa' = Algorithm, PublicKey, PublicKeyParams %%-------------------------------------------------------------------- --spec certificate_request(#connection_states{}, certdb_ref()) -> +-spec certificate_request(#connection_states{}, db_handle(), certdb_ref()) -> #certificate_request{}. %% %% Description: Creates a certificate_request message, called by the server. %%-------------------------------------------------------------------- -certificate_request(ConnectionStates, CertDbRef) -> +certificate_request(ConnectionStates, CertDbHandle, CertDbRef) -> #connection_state{security_parameters = #security_parameters{cipher_suite = CipherSuite}} = ssl_record:pending_connection_state(ConnectionStates, read), Types = certificate_types(CipherSuite), - Authorities = certificate_authorities(CertDbRef), + Authorities = certificate_authorities(CertDbHandle, CertDbRef), #certificate_request{ certificate_types = Types, certificate_authorities = Authorities @@ -383,8 +383,9 @@ master_secret(Version, #session{master_secret = Mastersecret}, ConnectionStates, Role) catch exit:Reason -> - error_logger:error_report("Key calculation failed due to ~p", - [Reason]), + Report = io_lib:format("Key calculation failed due to ~p", + [Reason]), + error_logger:error_report(Report), ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE) end; @@ -400,8 +401,9 @@ master_secret(Version, PremasterSecret, ConnectionStates, Role) -> SecParams, ConnectionStates, Role) catch exit:Reason -> - error_logger:error_report("Master secret calculation failed" - " due to ~p", [Reason]), + Report = io_lib:format("Master secret calculation failed" + " due to ~p", [Reason]), + error_logger:error_report(Report), ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE) end. @@ -1071,8 +1073,8 @@ certificate_types({KeyExchange, _, _, _}) certificate_types(_) -> <<?BYTE(?RSA_SIGN)>>. -certificate_authorities(CertDbRef) -> - Authorities = certificate_authorities_from_db(CertDbRef), +certificate_authorities(CertDbHandle, CertDbRef) -> + Authorities = certificate_authorities_from_db(CertDbHandle, CertDbRef), Enc = fun(#'OTPCertificate'{tbsCertificate=TBSCert}) -> OTPSubj = TBSCert#'OTPTBSCertificate'.subject, DNEncodedBin = public_key:pkix_encode('Name', OTPSubj, otp), @@ -1084,18 +1086,18 @@ certificate_authorities(CertDbRef) -> end, list_to_binary([Enc(Cert) || {_, Cert} <- Authorities]). -certificate_authorities_from_db(CertDbRef) -> - certificate_authorities_from_db(CertDbRef, no_candidate, []). +certificate_authorities_from_db(CertDbHandle, CertDbRef) -> + certificate_authorities_from_db(CertDbHandle, CertDbRef, no_candidate, []). -certificate_authorities_from_db(CertDbRef, PrevKey, Acc) -> - case ssl_manager:issuer_candidate(PrevKey) of +certificate_authorities_from_db(CertDbHandle,CertDbRef, PrevKey, Acc) -> + case ssl_manager:issuer_candidate(PrevKey, CertDbHandle) of no_more_candidates -> lists:reverse(Acc); {{CertDbRef, _, _} = Key, Cert} -> - certificate_authorities_from_db(CertDbRef, Key, [Cert|Acc]); + certificate_authorities_from_db(CertDbHandle, CertDbRef, Key, [Cert|Acc]); {Key, _Cert} -> %% skip certs not from this ssl connection - certificate_authorities_from_db(CertDbRef, Key, Acc) + certificate_authorities_from_db(CertDbHandle, CertDbRef, Key, Acc) end. digitally_signed(Hash, #'RSAPrivateKey'{} = Key) -> diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl index c28daa271e..6bf1edc452 100644 --- a/lib/ssl/src/ssl_internal.hrl +++ b/lib/ssl/src/ssl_internal.hrl @@ -28,13 +28,12 @@ -type reply() :: term(). -type msg() :: term(). -type from() :: term(). --type host() :: string() | tuple(). --type port_num() :: integer(). +-type host() :: inet:ip_address() | inet:hostname(). -type session_id() :: 0 | binary(). -type tls_version() :: {integer(), integer()}. -type tls_atom_version() :: sslv3 | tlsv1. --type cache_ref() :: term(). --type certdb_ref() :: term(). +-type certdb_ref() :: reference(). +-type db_handle() :: term(). -type key_algo() :: null | rsa | dhe_rsa | dhe_dss | dh_anon. -type der_cert() :: binary(). -type private_key() :: #'RSAPrivateKey'{} | #'DSAPrivateKey'{}. diff --git a/lib/ssl/src/ssl_manager.erl b/lib/ssl/src/ssl_manager.erl index 1bbb03bdde..725a085d1f 100644 --- a/lib/ssl/src/ssl_manager.erl +++ b/lib/ssl/src/ssl_manager.erl @@ -28,8 +28,8 @@ %% Internal application API -export([start_link/1, - connection_init/2, cache_pem_file/1, - lookup_trusted_cert/3, issuer_candidate/1, client_session_id/4, + connection_init/2, cache_pem_file/2, + lookup_trusted_cert/4, issuer_candidate/2, client_session_id/4, server_session_id/4, register_session/2, register_session/3, invalidate_session/2, invalidate_session/3]). @@ -50,7 +50,8 @@ session_cache_cb, session_lifetime, certificate_db, - session_validation_timer + session_validation_timer, + last_delay_timer %% Keep for testing purposes }). -define('24H_in_msec', 8640000). @@ -72,47 +73,47 @@ start_link(Opts) -> %%-------------------------------------------------------------------- -spec connection_init(string()| {der, list()}, client | server) -> - {ok, reference(), cache_ref()}. + {ok, certdb_ref(), db_handle(), db_handle()}. %% %% Description: Do necessary initializations for a new connection. %%-------------------------------------------------------------------- connection_init(Trustedcerts, Role) -> call({connection_init, Trustedcerts, Role}). %%-------------------------------------------------------------------- --spec cache_pem_file(string()) -> {ok, term()} | {error, reason()}. +-spec cache_pem_file(string(), term()) -> {ok, term()} | {error, reason()}. %% %% Description: Cach a pem file and return its content. %%-------------------------------------------------------------------- -cache_pem_file(File) -> +cache_pem_file(File, DbHandle) -> try file:read_file_info(File) of {ok, #file_info{mtime = LastWrite}} -> - cache_pem_file(File, LastWrite) + cache_pem_file(File, LastWrite, DbHandle) catch _:Reason -> {error, Reason} end. %%-------------------------------------------------------------------- --spec lookup_trusted_cert(reference(), serialnumber(), issuer()) -> +-spec lookup_trusted_cert(term(), reference(), serialnumber(), issuer()) -> undefined | {ok, {der_cert(), #'OTPCertificate'{}}}. %% %% Description: Lookup the trusted cert with Key = {reference(), %% serialnumber(), issuer()}. %% -------------------------------------------------------------------- -lookup_trusted_cert(Ref, SerialNumber, Issuer) -> - ssl_certificate_db:lookup_trusted_cert(Ref, SerialNumber, Issuer). +lookup_trusted_cert(DbHandle, Ref, SerialNumber, Issuer) -> + ssl_certificate_db:lookup_trusted_cert(DbHandle, Ref, SerialNumber, Issuer). %%-------------------------------------------------------------------- --spec issuer_candidate(cert_key() | no_candidate) -> +-spec issuer_candidate(cert_key() | no_candidate, term()) -> {cert_key(), {der_cert(), #'OTPCertificate'{}}} | no_more_candidates. %% %% Description: Return next issuer candidate. %%-------------------------------------------------------------------- -issuer_candidate(PrevCandidateKey) -> - ssl_certificate_db:issuer_candidate(PrevCandidateKey). +issuer_candidate(PrevCandidateKey, DbHandle) -> + ssl_certificate_db:issuer_candidate(PrevCandidateKey, DbHandle). %%-------------------------------------------------------------------- --spec client_session_id(host(), port_num(), #ssl_options{}, +-spec client_session_id(host(), inet:port_number(), #ssl_options{}, der_cert() | undefined) -> session_id(). %% %% Description: Select a session id for the client. @@ -121,7 +122,7 @@ client_session_id(Host, Port, SslOpts, OwnCert) -> call({client_session_id, Host, Port, SslOpts, OwnCert}). %%-------------------------------------------------------------------- --spec server_session_id(host(), port_num(), #ssl_options{}, +-spec server_session_id(host(), inet:port_number(), #ssl_options{}, der_cert()) -> session_id(). %% %% Description: Select a session id for the server. @@ -130,8 +131,8 @@ server_session_id(Port, SuggestedSessionId, SslOpts, OwnCert) -> call({server_session_id, Port, SuggestedSessionId, SslOpts, OwnCert}). %%-------------------------------------------------------------------- --spec register_session(port_num(), #session{}) -> ok. --spec register_session(host(), port_num(), #session{}) -> ok. +-spec register_session(inet:port_number(), #session{}) -> ok. +-spec register_session(host(), inet:port_number(), #session{}) -> ok. %% %% Description: Make the session available for reuse. %%-------------------------------------------------------------------- @@ -141,8 +142,8 @@ register_session(Host, Port, Session) -> register_session(Port, Session) -> cast({register_session, Port, Session}). %%-------------------------------------------------------------------- --spec invalidate_session(port_num(), #session{}) -> ok. --spec invalidate_session(host(), port_num(), #session{}) -> ok. +-spec invalidate_session(inet:port_number(), #session{}) -> ok. +-spec invalidate_session(host(), inet:port_number(), #session{}) -> ok. %% %% Description: Make the session unavailable for reuse. After %% a the session has been marked "is_resumable = false" for some while @@ -192,19 +193,20 @@ init([Opts]) -> %% Description: Handling call messages %%-------------------------------------------------------------------- handle_call({{connection_init, "", _Role}, Pid}, _From, - #state{session_cache = Cache} = State) -> + #state{certificate_db = [CertDb |_], + session_cache = Cache} = State) -> erlang:monitor(process, Pid), - Result = {ok, make_ref(), Cache}, + Result = {ok, make_ref(),CertDb, Cache}, {reply, Result, State}; handle_call({{connection_init, Trustedcerts, _Role}, Pid}, _From, - #state{certificate_db = Db, + #state{certificate_db = [CertDb|_] =Db, session_cache = Cache} = State) -> erlang:monitor(process, Pid), Result = try {ok, Ref} = ssl_certificate_db:add_trusted_certs(Pid, Trustedcerts, Db), - {ok, Ref, Cache} + {ok, Ref, CertDb, Cache} catch _:Reason -> {error, Reason} @@ -265,20 +267,25 @@ handle_cast({register_session, Port, Session}, CacheCb:update(Cache, {Port, NewSession#session.session_id}, NewSession), {noreply, State}; -handle_cast({invalidate_session, Host, Port, +%%% When a session is invalidated we need to wait a while before deleting +%%% it as there might be pending connections that rightfully needs to look +%%% up the session data but new connections should not get to use this session. +handle_cast({invalidate_session, Host, Port, #session{session_id = ID} = Session}, #state{session_cache = Cache, session_cache_cb = CacheCb} = State) -> CacheCb:update(Cache, {{Host, Port}, ID}, Session#session{is_resumable = false}), - timer:apply_after(?CLEAN_SESSION_DB, CacheCb, delete, [{{Host, Port}, ID}]), - {noreply, State}; + TRef = + erlang:send_after(delay_time(), self(), {delayed_clean_session, {{Host, Port}, ID}}), + {noreply, State#state{last_delay_timer = TRef}}; handle_cast({invalidate_session, Port, #session{session_id = ID} = Session}, #state{session_cache = Cache, session_cache_cb = CacheCb} = State) -> CacheCb:update(Cache, {Port, ID}, Session#session{is_resumable = false}), - timer:apply_after(?CLEAN_SESSION_DB, CacheCb, delete, [{Port, ID}]), - {noreply, State}; + TRef = + erlang:send_after(delay_time(), self(), {delayed_clean_session, {Port, ID}}), + {noreply, State#state{last_delay_timer = TRef}}; handle_cast({recache_pem, File, LastWrite, Pid, From}, #state{certificate_db = [_, FileToRefDb, _]} = State0) -> @@ -312,6 +319,12 @@ handle_info(validate_sessions, #state{session_cache_cb = CacheCb, start_session_validator(Cache, CacheCb, LifeTime), {noreply, State#state{session_validation_timer = Timer}}; +handle_info({delayed_clean_session, Key}, #state{session_cache = Cache, + session_cache_cb = CacheCb + } = State) -> + CacheCb:delete(Cache, Key), + {noreply, State}; + handle_info({'EXIT', _, _}, State) -> %% Session validator died!! Do we need to take any action? %% maybe error log @@ -399,8 +412,8 @@ session_validation({{Port, _}, Session}, LifeTime) -> validate_session(Port, Session, LifeTime), LifeTime. -cache_pem_file(File, LastWrite) -> - case ssl_certificate_db:lookup_cached_certs(File) of +cache_pem_file(File, LastWrite, DbHandle) -> + case ssl_certificate_db:lookup_cached_certs(DbHandle,File) of [{_, {Mtime, Content}}] -> case LastWrite of Mtime -> @@ -411,3 +424,11 @@ cache_pem_file(File, LastWrite) -> [] -> call({cache_pem, File, LastWrite}) end. + +delay_time() -> + case application:get_env(ssl, session_delay_cleanup_time) of + {ok, Time} when is_integer(Time) -> + Time; + _ -> + ?CLEAN_SESSION_DB + end. diff --git a/lib/ssl/src/ssl_record.erl b/lib/ssl/src/ssl_record.erl index f1c0073965..72091fdd5f 100644 --- a/lib/ssl/src/ssl_record.erl +++ b/lib/ssl/src/ssl_record.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2010. All Rights Reserved. +%% Copyright Ericsson AB 2007-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -62,6 +62,8 @@ -compile(inline). +-define(INITIAL_BYTES, 5). + %%==================================================================== %% Internal application API %%==================================================================== @@ -340,7 +342,7 @@ get_tls_records_aux(<<?BYTE(?CHANGE_CIPHER_SPEC),?BYTE(MajVer),?BYTE(MinVer), get_tls_records_aux(Rest, [#ssl_tls{type = ?CHANGE_CIPHER_SPEC, version = {MajVer, MinVer}, fragment = Data} | Acc]); -%% Matches a ssl v2 client hello message. +%% Matches an ssl v2 client hello message. %% The server must be able to receive such messages, from clients that %% are willing to use ssl v3 or higher, but have ssl v2 compatibility. get_tls_records_aux(<<1:1, Length0:15, Data0:Length0/binary, Rest/binary>>, @@ -360,16 +362,20 @@ get_tls_records_aux(<<1:1, Length0:15, Data0:Length0/binary, Rest/binary>>, get_tls_records_aux(<<0:1, _CT:7, ?BYTE(_MajVer), ?BYTE(_MinVer), ?UINT16(Length), _/binary>>, - _Acc) when Length > ?MAX_CIPHER_TEXT_LENGTH-> + _Acc) when Length > ?MAX_CIPHER_TEXT_LENGTH -> ?ALERT_REC(?FATAL, ?RECORD_OVERFLOW); get_tls_records_aux(<<1:1, Length0:15, _/binary>>,_Acc) - when Length0 > ?MAX_CIPHER_TEXT_LENGTH-> + when Length0 > ?MAX_CIPHER_TEXT_LENGTH -> ?ALERT_REC(?FATAL, ?RECORD_OVERFLOW); get_tls_records_aux(Data, Acc) -> - {lists:reverse(Acc), Data}. - + case size(Data) =< ?MAX_CIPHER_TEXT_LENGTH + ?INITIAL_BYTES of + true -> + {lists:reverse(Acc), Data}; + false -> + ?ALERT_REC(?FATAL, ?UNEXPECTED_MESSAGE) + end. %%-------------------------------------------------------------------- -spec protocol_version(tls_atom_version() | tls_version()) -> tls_version() | tls_atom_version(). diff --git a/lib/ssl/src/ssl_session.erl b/lib/ssl/src/ssl_session.erl index dc4b7a711c..bf738649f6 100644 --- a/lib/ssl/src/ssl_session.erl +++ b/lib/ssl/src/ssl_session.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2010. All Rights Reserved. +%% Copyright Ericsson AB 2007-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -48,7 +48,7 @@ is_new(_ClientSuggestion, _ServerDecision) -> true. %%-------------------------------------------------------------------- --spec id({host(), port_num(), #ssl_options{}}, cache_ref(), atom(), +-spec id({host(), inet:port_number(), #ssl_options{}}, db_handle(), atom(), undefined | binary()) -> binary(). %% %% Description: Should be called by the client side to get an id @@ -63,7 +63,7 @@ id(ClientInfo, Cache, CacheCb, OwnCert) -> end. %%-------------------------------------------------------------------- --spec id(port_num(), binary(), #ssl_options{}, cache_ref(), +-spec id(inet:port_number(), binary(), #ssl_options{}, db_handle(), atom(), seconds(), binary()) -> binary(). %% %% Description: Should be called by the server side to get an id diff --git a/lib/ssl/src/ssl_session_cache.erl b/lib/ssl/src/ssl_session_cache.erl index 823bf7acfa..93969f628f 100644 --- a/lib/ssl/src/ssl_session_cache.erl +++ b/lib/ssl/src/ssl_session_cache.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2010. All Rights Reserved. +%% Copyright Ericsson AB 2008-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -28,10 +28,10 @@ -export([init/1, terminate/1, lookup/2, update/3, delete/2, foldl/3, select_session/2]). --type key() :: {{host(), port_num()}, session_id()} | {port_num(), session_id()}. +-type key() :: {{host(), inet:port_number()}, session_id()} | {inet:port_number(), session_id()}. %%-------------------------------------------------------------------- --spec init(list()) -> cache_ref(). %% Returns reference to the cache (opaque) +-spec init(list()) -> db_handle(). %% Returns reference to the cache (opaque) %% %% Description: Return table reference. Called by ssl_manager process. %%-------------------------------------------------------------------- @@ -39,7 +39,7 @@ init(_) -> ets:new(cache_name(), [set, protected]). %%-------------------------------------------------------------------- --spec terminate(cache_ref()) -> any(). %% +-spec terminate(db_handle()) -> any(). %% %% Description: Handles cache table at termination of ssl manager. %%-------------------------------------------------------------------- @@ -47,7 +47,7 @@ terminate(Cache) -> ets:delete(Cache). %%-------------------------------------------------------------------- --spec lookup(cache_ref(), key()) -> #session{} | undefined. +-spec lookup(db_handle(), key()) -> #session{} | undefined. %% %% Description: Looks up a cach entry. Should be callable from any %% process. @@ -61,7 +61,7 @@ lookup(Cache, Key) -> end. %%-------------------------------------------------------------------- --spec update(cache_ref(), key(), #session{}) -> any(). +-spec update(db_handle(), key(), #session{}) -> any(). %% %% Description: Caches a new session or updates a already cached one. %% Will only be called from the ssl_manager process. @@ -70,7 +70,7 @@ update(Cache, Key, Session) -> ets:insert(Cache, {Key, Session}). %%-------------------------------------------------------------------- --spec delete(cache_ref(), key()) -> any(). +-spec delete(db_handle(), key()) -> any(). %% %% Description: Delets a cache entry. %% Will only be called from the ssl_manager process. @@ -79,7 +79,7 @@ delete(Cache, Key) -> ets:delete(Cache, Key). %%-------------------------------------------------------------------- --spec foldl(fun(), term(), cache_ref()) -> term(). +-spec foldl(fun(), term(), db_handle()) -> term(). %% %% Description: Calls Fun(Elem, AccIn) on successive elements of the %% cache, starting with AccIn == Acc0. Fun/2 must return a new @@ -91,7 +91,7 @@ foldl(Fun, Acc0, Cache) -> ets:foldl(Fun, Acc0, Cache). %%-------------------------------------------------------------------- --spec select_session(cache_ref(), {host(), port_num()} | port_num()) -> [#session{}]. +-spec select_session(db_handle(), {host(), inet:port_number()} | inet:port_number()) -> [#session{}]. %% %% Description: Selects a session that could be reused. Should be callable %% from any process. diff --git a/lib/ssl/src/ssl_ssl2.erl b/lib/ssl/src/ssl_ssl2.erl index b1005b1acb..30a3a5fc98 100644 --- a/lib/ssl/src/ssl_ssl2.erl +++ b/lib/ssl/src/ssl_ssl2.erl @@ -20,7 +20,7 @@ %% %%---------------------------------------------------------------------- %% Purpose: Handles sslv2 hello as clients supporting sslv2 and higher -%% will send a sslv2 hello. +%% will send an sslv2 hello. %%---------------------------------------------------------------------- -module(ssl_ssl2). diff --git a/lib/ssl/test/Makefile b/lib/ssl/test/Makefile index 53b2223035..5be07cad2c 100644 --- a/lib/ssl/test/Makefile +++ b/lib/ssl/test/Makefile @@ -61,8 +61,10 @@ HRL_FILES = ssl_test_MACHINE.hrl HRL_FILES_SRC = \ ssl_int.hrl \ + ssl_internal.hrl\ ssl_alert.hrl \ - ssl_handshake.hrl + ssl_handshake.hrl \ + ssl_record.hrl HRL_FILES_INC = diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index 4f0907027f..37a021e7cf 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -25,11 +25,12 @@ -compile(export_all). -include_lib("common_test/include/ct.hrl"). --include("test_server_line.hrl"). -include_lib("public_key/include/public_key.hrl"). -include("ssl_alert.hrl"). -include("ssl_int.hrl"). +-include("ssl_internal.hrl"). +-include("ssl_record.hrl"). -define('24H_in_sec', 86400). -define(TIMEOUT, 60000). @@ -208,8 +209,12 @@ all() -> empty_protocol_versions, controlling_process, controller_dies, client_closes_socket, peercert, connect_dist, peername, sockname, socket_options, + invalid_inet_get_option, invalid_inet_get_option_not_list, + invalid_inet_get_option_improper_list, + invalid_inet_set_option, invalid_inet_set_option_not_list, + invalid_inet_set_option_improper_list, misc_ssl_options, versions, cipher_suites, upgrade, - upgrade_with_timeout, tcp_connect, ipv6, ekeyfile, + upgrade_with_timeout, tcp_connect, tcp_connect_big, ipv6, ekeyfile, ecertfile, ecacertfile, eoptions, shutdown, shutdown_write, shutdown_both, shutdown_error, ciphers_rsa_signed_certs, ciphers_rsa_signed_certs_ssl3, @@ -252,7 +257,7 @@ all() -> %%different_ca_peer_sign, no_reuses_session_server_restart_new_cert, no_reuses_session_server_restart_new_cert_file, reuseaddr, - hibernate + hibernate, connect_twice ]. groups() -> @@ -808,8 +813,218 @@ socket_options_result(Socket, Options, DefaultValues, NewOptions, NewValues) -> {ok,[{nodelay,false}]} = ssl:getopts(Socket, [nodelay]), ssl:setopts(Socket, [{nodelay, true}]), {ok,[{nodelay, true}]} = ssl:getopts(Socket, [nodelay]), + {ok, All} = ssl:getopts(Socket, []), + test_server:format("All opts ~p~n", [All]), ok. + + +%%-------------------------------------------------------------------- +invalid_inet_get_option(doc) -> + ["Test handling of invalid inet options in getopts"]; + +invalid_inet_get_option(suite) -> + []; + +invalid_inet_get_option(Config) when is_list(Config) -> + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, get_invalid_inet_option, []}}, + {options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {ssl_test_lib, no_result, []}}, + {options, ClientOpts}]), + + test_server:format("Testcase ~p, Client ~p Server ~p ~n", + [self(), Client, Server]), + + ssl_test_lib:check_result(Server, ok), + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + + +get_invalid_inet_option(Socket) -> + {error, {eoptions, {inet_option, foo, _}}} = ssl:getopts(Socket, [foo]), + ok. + +%%-------------------------------------------------------------------- +invalid_inet_get_option_not_list(doc) -> + ["Test handling of invalid type in getopts"]; + +invalid_inet_get_option_not_list(suite) -> + []; + +invalid_inet_get_option_not_list(Config) when is_list(Config) -> + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, get_invalid_inet_option_not_list, []}}, + {options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {ssl_test_lib, no_result, []}}, + {options, ClientOpts}]), + + test_server:format("Testcase ~p, Client ~p Server ~p ~n", + [self(), Client, Server]), + ssl_test_lib:check_result(Server, ok), + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + + +get_invalid_inet_option_not_list(Socket) -> + {error, {eoptions, {inet_options, some_invalid_atom_here}}} + = ssl:getopts(Socket, some_invalid_atom_here), + ok. + +%%-------------------------------------------------------------------- +invalid_inet_get_option_improper_list(doc) -> + ["Test handling of invalid type in getopts"]; + +invalid_inet_get_option_improper_list(suite) -> + []; + +invalid_inet_get_option_improper_list(Config) when is_list(Config) -> + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, get_invalid_inet_option_improper_list, []}}, + {options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {ssl_test_lib, no_result, []}}, + {options, ClientOpts}]), + + test_server:format("Testcase ~p, Client ~p Server ~p ~n", + [self(), Client, Server]), + + ssl_test_lib:check_result(Server, ok), + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + + +get_invalid_inet_option_improper_list(Socket) -> + {error, {eoptions, {inet_option, foo,_}}} = ssl:getopts(Socket, [packet | foo]), + ok. + +%%-------------------------------------------------------------------- +invalid_inet_set_option(doc) -> + ["Test handling of invalid inet options in setopts"]; + +invalid_inet_set_option(suite) -> + []; + +invalid_inet_set_option(Config) when is_list(Config) -> + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, set_invalid_inet_option, []}}, + {options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {ssl_test_lib, no_result, []}}, + {options, ClientOpts}]), + + test_server:format("Testcase ~p, Client ~p Server ~p ~n", + [self(), Client, Server]), + + ssl_test_lib:check_result(Server, ok), + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + +set_invalid_inet_option(Socket) -> + {error, {eoptions, {inet_opt, {packet, foo}}}} = ssl:setopts(Socket, [{packet, foo}]), + {error, {eoptions, {inet_opt, {header, foo}}}} = ssl:setopts(Socket, [{header, foo}]), + {error, {eoptions, {inet_opt, {active, foo}}}} = ssl:setopts(Socket, [{active, foo}]), + {error, {eoptions, {inet_opt, {mode, foo}}}} = ssl:setopts(Socket, [{mode, foo}]), + ok. +%%-------------------------------------------------------------------- +invalid_inet_set_option_not_list(doc) -> + ["Test handling of invalid type in setopts"]; + +invalid_inet_set_option_not_list(suite) -> + []; + +invalid_inet_set_option_not_list(Config) when is_list(Config) -> + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, set_invalid_inet_option_not_list, []}}, + {options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {ssl_test_lib, no_result, []}}, + {options, ClientOpts}]), + + test_server:format("Testcase ~p, Client ~p Server ~p ~n", + [self(), Client, Server]), + + ssl_test_lib:check_result(Server, ok), + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + + +set_invalid_inet_option_not_list(Socket) -> + {error, {eoptions, {not_a_proplist, some_invalid_atom_here}}} + = ssl:setopts(Socket, some_invalid_atom_here), + ok. + +%%-------------------------------------------------------------------- +invalid_inet_set_option_improper_list(doc) -> + ["Test handling of invalid tye in setopts"]; + +invalid_inet_set_option_improper_list(suite) -> + []; + +invalid_inet_set_option_improper_list(Config) when is_list(Config) -> + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, set_invalid_inet_option_improper_list, []}}, + {options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {ssl_test_lib, no_result, []}}, + {options, ClientOpts}]), + + test_server:format("Testcase ~p, Client ~p Server ~p ~n", + [self(), Client, Server]), + + ssl_test_lib:check_result(Server, ok), + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + +set_invalid_inet_option_improper_list(Socket) -> + {error, {eoptions, {not_a_proplist, [{packet, 0} | {foo, 2}]}}} = + ssl:setopts(Socket, [{packet, 0} | {foo, 2}]), + ok. + %%-------------------------------------------------------------------- misc_ssl_options(doc) -> ["Test what happens when we give valid options"]; @@ -1097,6 +1312,41 @@ tcp_connect(Config) when is_list(Config) -> end end. +tcp_connect_big(doc) -> + ["Test what happens when a tcp tries to connect, i,e. a bad big (ssl) packet is sent first"]; + +tcp_connect_big(suite) -> + []; + +tcp_connect_big(Config) when is_list(Config) -> + ServerOpts = ?config(server_opts, Config), + {_, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + TcpOpts = [binary, {reuseaddr, true}], + + Server = ssl_test_lib:start_upgrade_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {timeout, 5000}, + {mfa, {?MODULE, dummy, []}}, + {tcp_options, TcpOpts}, + {ssl_options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + + {ok, Socket} = gen_tcp:connect(Hostname, Port, [binary, {packet, 0}]), + test_server:format("Testcase ~p connected to Server ~p ~n", [self(), Server]), + + Rand = crypto:rand_bytes(?MAX_CIPHER_TEXT_LENGTH+1), + gen_tcp:send(Socket, <<?BYTE(0), + ?BYTE(3), ?BYTE(1), ?UINT16(?MAX_CIPHER_TEXT_LENGTH), Rand/binary>>), + + receive + {tcp_closed, Socket} -> + receive + {Server, {error, timeout}} -> + test_server:fail("hangs"); + {Server, {error, Error}} -> + test_server:format("Error ~p", [Error]) + end + end. dummy(_Socket) -> %% Should not happen as the ssl connection will not be established @@ -1659,7 +1909,7 @@ reuse_session(Config) when is_list(Config) -> Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, {from, self()}, - {mfa, {?MODULE, session_info_result, []}}, + {mfa, {ssl_test_lib, session_info_result, []}}, {options, ServerOpts}]), Port = ssl_test_lib:inet_port(Server), Client0 = @@ -1681,7 +1931,7 @@ reuse_session(Config) when is_list(Config) -> Client1 = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, - {mfa, {?MODULE, session_info_result, []}}, + {mfa, {ssl_test_lib, session_info_result, []}}, {from, self()}, {options, ClientOpts}]), receive {Client1, SessionInfo} -> @@ -1697,7 +1947,7 @@ reuse_session(Config) when is_list(Config) -> Client2 = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, - {mfa, {?MODULE, session_info_result, []}}, + {mfa, {ssl_test_lib, session_info_result, []}}, {from, self()}, {options, [{reuse_sessions, false} | ClientOpts]}]), receive @@ -1713,7 +1963,7 @@ reuse_session(Config) when is_list(Config) -> Server1 = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, {from, self()}, - {mfa, {?MODULE, session_info_result, []}}, + {mfa, {ssl_test_lib, session_info_result, []}}, {options, [{reuse_sessions, false} | ServerOpts]}]), Port1 = ssl_test_lib:inet_port(Server1), @@ -1737,7 +1987,7 @@ reuse_session(Config) when is_list(Config) -> Client4 = ssl_test_lib:start_client([{node, ClientNode}, {port, Port1}, {host, Hostname}, - {mfa, {?MODULE, session_info_result, []}}, + {mfa, {ssl_test_lib, session_info_result, []}}, {from, self()}, {options, ClientOpts}]), receive @@ -1756,9 +2006,6 @@ reuse_session(Config) when is_list(Config) -> ssl_test_lib:close(Client3), ssl_test_lib:close(Client4). -session_info_result(Socket) -> - ssl:session_info(Socket). - %%-------------------------------------------------------------------- reuse_session_expired(doc) -> ["Test sessions is not reused when it has expired"]; @@ -1774,7 +2021,7 @@ reuse_session_expired(Config) when is_list(Config) -> Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, {from, self()}, - {mfa, {?MODULE, session_info_result, []}}, + {mfa, {ssl_test_lib, session_info_result, []}}, {options, ServerOpts}]), Port = ssl_test_lib:inet_port(Server), Client0 = @@ -1796,7 +2043,7 @@ reuse_session_expired(Config) when is_list(Config) -> Client1 = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, - {mfa, {?MODULE, session_info_result, []}}, + {mfa, {ssl_test_lib, session_info_result, []}}, {from, self()}, {options, ClientOpts}]), receive {Client1, SessionInfo} -> @@ -1815,7 +2062,7 @@ reuse_session_expired(Config) when is_list(Config) -> Client2 = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, - {mfa, {?MODULE, session_info_result, []}}, + {mfa, {ssl_test_lib, session_info_result, []}}, {from, self()}, {options, ClientOpts}]), receive {Client2, SessionInfo} -> @@ -1844,7 +2091,7 @@ server_does_not_want_to_reuse_session(Config) when is_list(Config) -> Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, {from, self()}, - {mfa, {?MODULE, session_info_result, []}}, + {mfa, {ssl_test_lib, session_info_result, []}}, {options, [{reuse_session, fun(_,_,_,_) -> false end} | @@ -1870,7 +2117,7 @@ server_does_not_want_to_reuse_session(Config) when is_list(Config) -> Client1 = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, - {mfa, {?MODULE, session_info_result, []}}, + {mfa, {ssl_test_lib, session_info_result, []}}, {from, self()}, {options, ClientOpts}]), receive {Client1, SessionInfo} -> @@ -3179,7 +3426,7 @@ no_reuses_session_server_restart_new_cert(Config) when is_list(Config) -> Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, {from, self()}, - {mfa, {?MODULE, session_info_result, []}}, + {mfa, {ssl_test_lib, session_info_result, []}}, {options, ServerOpts}]), Port = ssl_test_lib:inet_port(Server), Client0 = @@ -3207,7 +3454,7 @@ no_reuses_session_server_restart_new_cert(Config) when is_list(Config) -> Client1 = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, - {mfa, {?MODULE, session_info_result, []}}, + {mfa, {ssl_test_lib, session_info_result, []}}, {from, self()}, {options, ClientOpts}]), receive {Client1, SessionInfo} -> @@ -3238,7 +3485,7 @@ no_reuses_session_server_restart_new_cert_file(Config) when is_list(Config) -> Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, {from, self()}, - {mfa, {?MODULE, session_info_result, []}}, + {mfa, {ssl_test_lib, session_info_result, []}}, {options, NewServerOpts}]), Port = ssl_test_lib:inet_port(Server), Client0 = @@ -3268,7 +3515,7 @@ no_reuses_session_server_restart_new_cert_file(Config) when is_list(Config) -> Client1 = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, - {mfa, {?MODULE, session_info_result, []}}, + {mfa, {ssl_test_lib, session_info_result, []}}, {from, self()}, {options, ClientOpts}]), receive {Client1, SessionInfo} -> @@ -3304,6 +3551,7 @@ reuseaddr(Config) when is_list(Config) -> {options, [{active, false} | ClientOpts]}]), test_server:sleep(?SLEEP), ssl_test_lib:close(Server), + ssl_test_lib:close(Client), Server1 = ssl_test_lib:start_server([{node, ServerNode}, {port, Port}, @@ -3361,6 +3609,54 @@ hibernate(Config) -> ssl_test_lib:close(Client). %%-------------------------------------------------------------------- + +connect_twice(doc) -> + [""]; +connect_twice(suite) -> + []; +connect_twice(Config) when is_list(Config) -> + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_opts, Config), + + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Server = + ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, send_recv_result, []}}, + {options, [{keepalive, true},{active, false} + | ServerOpts]}]), + Port = ssl_test_lib:inet_port(Server), + Client = + ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, send_recv_result, []}}, + {options, [{keepalive, true},{active, false} + | ClientOpts]}]), + Server ! listen, + + {Client1, #sslsocket{}} = + ssl_test_lib:start_client([return_socket, + {node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, send_recv_result, []}}, + {options, [{keepalive, true},{active, false} + | ClientOpts]}]), + + test_server:format("Testcase ~p, Client ~p Server ~p ~n", + [self(), Client, Server]), + + ssl_test_lib:check_result(Server, ok, Client, ok), + ssl_test_lib:check_result(Server, ok, Client1, ok), + + ssl_test_lib:close(Server), + ssl_test_lib:close(Client), + ssl_test_lib:close(Client1). + + +%%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- send_recv_result(Socket) -> @@ -3438,7 +3734,7 @@ session_cache_process_mnesia(suite) -> session_cache_process_mnesia(Config) when is_list(Config) -> session_cache_process(mnesia,Config). -session_cache_process(Type,Config) when is_list(Config) -> +session_cache_process(_Type,Config) when is_list(Config) -> reuse_session(Config). init([Type]) -> diff --git a/lib/ssl/test/ssl_packet_SUITE.erl b/lib/ssl/test/ssl_packet_SUITE.erl index d22d5d2954..9d2599b778 100644 --- a/lib/ssl/test/ssl_packet_SUITE.erl +++ b/lib/ssl/test/ssl_packet_SUITE.erl @@ -151,6 +151,9 @@ all() -> packet_cdr_decode, packet_cdr_decode_list, packet_http_decode, packet_http_decode_list, packet_http_bin_decode_multi, packet_http_error_passive, + packet_httph_active, packet_httph_bin_active, + packet_httph_active_once, packet_httph_bin_active_once, + packet_httph_passive, packet_httph_bin_passive, packet_line_decode, packet_line_decode_list, packet_asn1_decode, packet_asn1_decode_list, packet_tpkt_decode, packet_tpkt_decode_list, @@ -1594,7 +1597,7 @@ client_http_decode(Socket, HttpRequest) -> %%-------------------------------------------------------------------- packet_http_decode_list(doc) -> ["Test setting the packet option {packet, http}, {mode, list}" - "(Body will be litst too)"]; + "(Body will be list too)"]; packet_http_decode_list(suite) -> []; packet_http_decode_list(Config) when is_list(Config) -> @@ -1804,7 +1807,304 @@ server_http_decode_error(Socket, HttpResponse) -> assert_packet_opt(Socket, http), ok = ssl:send(Socket, HttpResponse), ok. +%%-------------------------------------------------------------------- +packet_httph_active(doc) -> + ["Test setting the packet option {packet, httph}"]; +packet_httph_active(suite) -> + []; +packet_httph_active(Config) when is_list(Config) -> + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Trailer = "Content-Encoding: gzip\r\n" + "\r\n", + + Server = ssl_test_lib:start_server([{node, ClientNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, server_send_trailer, + [Trailer]}}, + {options, [{active, true}, binary | + ServerOpts]}]), + + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client([{node, ServerNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, client_http_decode_trailer_active, + []}}, + {options, [{active, true}, + {packet, httph}, + list | + ClientOpts]}]), + + ssl_test_lib:check_result(Server, ok, Client, ok), + + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + +server_send_trailer(Socket, Trailer)-> + ssl:send(Socket, Trailer), + ok. + +client_http_decode_trailer_active(Socket) -> + receive + {ssl, Socket, + {http_header,36,'Content-Encoding',undefined,"gzip"}} -> + ok; + Other1 -> + exit({?LINE, Other1}) + end, + receive + {ssl, Socket, http_eoh} -> + ok; + Other2 -> + exit({?LINE, Other2}) + end, + ok. + +%%-------------------------------------------------------------------- +packet_httph_bin_active(doc) -> + ["Test setting the packet option {packet, httph_bin}"]; +packet_httph_bin_active(suite) -> + []; +packet_httph_bin_active(Config) when is_list(Config) -> + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Trailer = "Content-Encoding: gzip\r\n" + "\r\n", + + Server = ssl_test_lib:start_server([{node, ClientNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, server_send_trailer, + [Trailer]}}, + {options, [{active, true}, binary | + ServerOpts]}]), + + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client([{node, ServerNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, client_http_decode_trailer_bin_active, + []}}, + {options, [{active, true}, + {packet, httph_bin}, + list | + ClientOpts]}]), + + ssl_test_lib:check_result(Server, ok, Client, ok), + + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + +client_http_decode_trailer_bin_active(Socket) -> + receive + {ssl, Socket, + {http_header,36,'Content-Encoding',undefined, <<"gzip">>}} -> + ok; + Other1 -> + exit({?LINE, Other1}) + end, + receive + {ssl, Socket, http_eoh} -> + ok; + Other2 -> + exit({?LINE, Other2}) + end, + ok. +%%-------------------------------------------------------------------- +packet_httph_active_once(doc) -> + ["Test setting the packet option {packet, httph}"]; +packet_httph_active_once(suite) -> + []; +packet_httph_active_once(Config) when is_list(Config) -> + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Trailer = "Content-Encoding: gzip\r\n" + "\r\n", + + Server = ssl_test_lib:start_server([{node, ClientNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, server_send_trailer, + [Trailer]}}, + {options, [{active, true}, binary | + ServerOpts]}]), + + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client([{node, ServerNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, client_http_decode_trailer_active_once, + []}}, + {options, [{active, false}, + {packet, httph}, + list | + ClientOpts]}]), + + ssl_test_lib:check_result(Server, ok, Client, ok), + + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + + +client_http_decode_trailer_active_once(Socket) -> + ssl:setopts(Socket, [{active, once}]), + receive + {ssl, Socket, + {http_header,36,'Content-Encoding',undefined,"gzip"}} -> + ok; + Other1 -> + exit({?LINE, Other1}) + end, + ssl:setopts(Socket, [{active, once}]), + receive + {ssl, Socket, http_eoh} -> + ok; + Other2 -> + exit({?LINE, Other2}) + end, + ok. +%%-------------------------------------------------------------------- +packet_httph_bin_active_once(doc) -> + ["Test setting the packet option {packet, httph_bin}"]; +packet_httph_bin_active_once(suite) -> + []; +packet_httph_bin_active_once(Config) when is_list(Config) -> + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Trailer = "Content-Encoding: gzip\r\n" + "\r\n", + + Server = ssl_test_lib:start_server([{node, ClientNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, server_send_trailer, + [Trailer]}}, + {options, [{active, true}, binary | + ServerOpts]}]), + + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client([{node, ServerNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, client_http_decode_trailer_bin_active_once, + []}}, + {options, [{active, false}, + {packet, httph_bin}, + list | + ClientOpts]}]), + + ssl_test_lib:check_result(Server, ok, Client, ok), + + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + +client_http_decode_trailer_bin_active_once(Socket) -> + ssl:setopts(Socket, [{active, once}]), + receive + {ssl, Socket, + {http_header,36,'Content-Encoding',undefined, <<"gzip">>}} -> + ok; + Other1 -> + exit({?LINE, Other1}) + end, + ssl:setopts(Socket, [{active, once}]), + receive + {ssl, Socket, http_eoh} -> + ok; + Other2 -> + exit({?LINE, Other2}) + end, + ok. + +%%-------------------------------------------------------------------- + +packet_httph_passive(doc) -> + ["Test setting the packet option {packet, httph}"]; +packet_httph_passive(suite) -> + []; +packet_httph_passive(Config) when is_list(Config) -> + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Trailer = "Content-Encoding: gzip\r\n" + "\r\n", + + Server = ssl_test_lib:start_server([{node, ClientNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, server_send_trailer, + [Trailer]}}, + {options, [{active, true}, binary | + ServerOpts]}]), + + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client([{node, ServerNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, client_http_decode_trailer_passive, + []}}, + {options, [{active, false}, + {packet, httph}, + list | + ClientOpts]}]), + + ssl_test_lib:check_result(Server, ok, Client, ok), + + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + +client_http_decode_trailer_passive(Socket) -> + {ok,{http_header,36,'Content-Encoding',undefined,"gzip"}} = ssl:recv(Socket, 0), + {ok, http_eoh} = ssl:recv(Socket, 0), + ok. + +%%-------------------------------------------------------------------- +packet_httph_bin_passive(doc) -> + ["Test setting the packet option {packet, httph_bin}"]; +packet_httph_bin_passive(suite) -> + []; +packet_httph_bin_passive(Config) when is_list(Config) -> + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Trailer = "Content-Encoding: gzip\r\n" + "\r\n", + + Server = ssl_test_lib:start_server([{node, ClientNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, server_send_trailer, + [Trailer]}}, + {options, [{active, true}, binary | + ServerOpts]}]), + + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client([{node, ServerNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, client_http_decode_trailer_bin_passive, + []}}, + {options, [{active, false}, + {packet, httph_bin}, + list | + ClientOpts]}]), + + ssl_test_lib:check_result(Server, ok, Client, ok), + + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + +client_http_decode_trailer_bin_passive(Socket) -> + {ok,{http_header,36,'Content-Encoding',undefined,<<"gzip">>}} = ssl:recv(Socket, 0), + {ok, http_eoh} = ssl:recv(Socket, 0), + ok. %%-------------------------------------------------------------------- packet_line_decode(doc) -> diff --git a/lib/ssl/test/ssl_session_cache_SUITE.erl b/lib/ssl/test/ssl_session_cache_SUITE.erl index a43b9ab586..5ea45018e6 100644 --- a/lib/ssl/test/ssl_session_cache_SUITE.erl +++ b/lib/ssl/test/ssl_session_cache_SUITE.erl @@ -26,9 +26,11 @@ -include_lib("common_test/include/ct.hrl"). +-define(DELAY, 500). -define(SLEEP, 500). -define(TIMEOUT, 60000). -define(LONG_TIMEOUT, 600000). + -behaviour(ssl_session_cache_api). %% For the session cache tests @@ -95,6 +97,16 @@ init_per_testcase(session_cache_process_mnesia, Config) -> mnesia:start(), init_customized_session_cache(mnesia, Config); +init_per_testcase(session_cleanup, Config0) -> + Config = lists:keydelete(watchdog, 1, Config0), + Dog = test_server:timetrap(?TIMEOUT), + ssl:stop(), + application:load(ssl), + application:set_env(ssl, session_lifetime, 5), + application:set_env(ssl, session_delay_cleanup_time, ?DELAY), + ssl:start(), + [{watchdog, Dog} | Config]; + init_per_testcase(_TestCase, Config0) -> Config = lists:keydelete(watchdog, 1, Config0), Dog = test_server:timetrap(?TIMEOUT), @@ -128,6 +140,10 @@ end_per_testcase(session_cache_process_mnesia, Config) -> ssl:stop(), ssl:start(), end_per_testcase(default_action, Config); +end_per_testcase(session_cleanup, Config) -> + application:unset_env(ssl, session_delay_cleanup_time), + application:unset_env(ssl, session_lifetime), + end_per_testcase(default_action, Config); end_per_testcase(_TestCase, Config) -> Dog = ?config(watchdog, Config), case Dog of @@ -148,7 +164,8 @@ end_per_testcase(_TestCase, Config) -> suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [session_cache_process_list, + [session_cleanup, + session_cache_process_list, session_cache_process_mnesia]. groups() -> @@ -159,7 +176,95 @@ init_per_group(_GroupName, Config) -> end_per_group(_GroupName, Config) -> Config. +%%-------------------------------------------------------------------- +session_cleanup(doc) -> + ["Test that sessions are cleand up eventually, so that the session table " + "does not grow and grow ..."]; +session_cleanup(suite) -> + []; +session_cleanup(Config)when is_list(Config) -> + process_flag(trap_exit, true), + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Server = + ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {ssl_test_lib, session_info_result, []}}, + {options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + Client = + ssl_test_lib:start_client([{node, ClientNode}, + {port, Port}, {host, Hostname}, + {mfa, {ssl_test_lib, no_result, []}}, + {from, self()}, {options, ClientOpts}]), + SessionInfo = + receive + {Server, Info} -> + Info + end, + + %% Make sure session is registered + test_server:sleep(?SLEEP), + + {status, _, _, StatusInfo} = sys:get_status(whereis(ssl_manager)), + [_, _,_, _, Prop] = StatusInfo, + State = state(Prop), + Cache = element(2, State), + SessionTimer = element(6, State), + + Id = proplists:get_value(session_id, SessionInfo), + CSession = ssl_session_cache:lookup(Cache, {{Hostname, Port}, Id}), + SSession = ssl_session_cache:lookup(Cache, {Port, Id}), + + true = CSession =/= undefined, + true = SSession =/= undefined, + + %% Make sure session has expired and been cleaned up + check_timer(SessionTimer), + test_server:sleep(?DELAY *2), %% Delay time + some extra time + + DelayTimer = get_delay_timer(), + + check_timer(DelayTimer), + + test_server:sleep(?SLEEP), %% Make sure clean has had to run + + undefined = ssl_session_cache:lookup(Cache, {{Hostname, Port}, Id}), + undefined = ssl_session_cache:lookup(Cache, {Port, Id}), + + process_flag(trap_exit, false), + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + +state([{data,[{"State", State}]} | _]) -> + State; +state([_ | Rest]) -> + state(Rest). + +check_timer(Timer) -> + case erlang:read_timer(Timer) of + false -> + {status, _, _, _} = sys:get_status(whereis(ssl_manager)), + ok; + Int -> + test_server:sleep(Int), + check_timer(Timer) + end. +get_delay_timer() -> + {status, _, _, StatusInfo} = sys:get_status(whereis(ssl_manager)), + [_, _,_, _, Prop] = StatusInfo, + State = state(Prop), + case element(7, State) of + undefined -> + test_server:sleep(?SLEEP), + get_delay_timer(); + DelayTimer -> + DelayTimer + end. +%%-------------------------------------------------------------------- session_cache_process_list(doc) -> ["Test reuse of sessions (short handshake)"]; @@ -176,7 +281,6 @@ session_cache_process_mnesia(suite) -> session_cache_process_mnesia(Config) when is_list(Config) -> session_cache_process(mnesia,Config). - %%-------------------------------------------------------------------- %%% Session cache API callbacks %%-------------------------------------------------------------------- diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index 40bbdf1dbd..b7916b96eb 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -670,3 +670,6 @@ cipher_result(Socket, Result) -> Other -> {unexpected, Other} end. + +session_info_result(Socket) -> + ssl:session_info(Socket). diff --git a/lib/ssl/vsn.mk b/lib/ssl/vsn.mk index 0e80e42637..8286201df4 100644 --- a/lib/ssl/vsn.mk +++ b/lib/ssl/vsn.mk @@ -1 +1 @@ -SSL_VSN = 4.1.5 +SSL_VSN = 4.1.6 diff --git a/lib/stdlib/doc/src/calendar.xml b/lib/stdlib/doc/src/calendar.xml index 4876b37127..f8db48e00c 100644 --- a/lib/stdlib/doc/src/calendar.xml +++ b/lib/stdlib/doc/src/calendar.xml @@ -75,13 +75,13 @@ <datatypes> <datatype> - <name name="t_datetime"/> + <name name="datetime"/> </datatype> <datatype> - <name name="t_datetime1970"/> + <name name="datetime1970"/> </datatype> <datatype> - <name name="t_date"/> + <name name="date"/> </datatype> <datatype> <name name="year"/> @@ -100,7 +100,7 @@ <name name="day"/> </datatype> <datatype> - <name name="t_time"/> + <name name="time"/> </datatype> <datatype> <name name="hour"/> @@ -118,12 +118,7 @@ <name name="ldom"/> </datatype> <datatype> - <name name="t_now"/> - <desc><p>See <seealso marker="erts:erlang#now/0">erlang:now/0</seealso>.</p> - </desc> - </datatype> - <datatype> - <name name="t_yearweeknum"/> + <name name="yearweeknum"/> </datatype> <datatype> <name name="weeknum"/> diff --git a/lib/stdlib/doc/src/dets.xml b/lib/stdlib/doc/src/dets.xml index 2512c84e18..54fefbe2b8 100644 --- a/lib/stdlib/doc/src/dets.xml +++ b/lib/stdlib/doc/src/dets.xml @@ -1105,7 +1105,7 @@ fun(X) -> {continue, X} end. </pre> <p>Terminate the traversal and return <c>[<anno>Value</anno> | Acc]</c>.</p> </item> </taglist> - <p>Any other value returned by <c><anno>Fun</anno></c> terminates the + <p>Any other value <c><anno>OtherValue</anno></c> returned by <c><anno>Fun</anno></c> terminates the traversal and is immediately returned. </p> </desc> diff --git a/lib/stdlib/doc/src/ets.xml b/lib/stdlib/doc/src/ets.xml index 8c952708c5..f19f92be6f 100644 --- a/lib/stdlib/doc/src/ets.xml +++ b/lib/stdlib/doc/src/ets.xml @@ -513,6 +513,9 @@ Error: fun containing local Erlang function calls the table has been fixed by the process.</p> <p>If the table never has been fixed, the call returns <c>false</c>.</p> + <item><c>Item=stats, Value=tuple()</c> <br></br> + Returns internal statistics about set, bag and duplicate_bag tables on an internal format used by OTP test suites. + Not for production use.</item> </item> </list> </desc> diff --git a/lib/stdlib/doc/src/gen_fsm.xml b/lib/stdlib/doc/src/gen_fsm.xml index d15383c621..e35b5adace 100644 --- a/lib/stdlib/doc/src/gen_fsm.xml +++ b/lib/stdlib/doc/src/gen_fsm.xml @@ -438,7 +438,7 @@ gen_fsm:sync_send_all_state_event -----> Module:handle_sync_event/4 <fsummary>Initialize process and internal state name and state data.</fsummary> <type> <v>Args = term()</v> - <v>Return = {ok,StateName,StateData} | {ok,StateName,StateData,Timeout}</v> + <v>Result = {ok,StateName,StateData} | {ok,StateName,StateData,Timeout}</v> <v> | {ok,StateName,StateData,hibernate}</v> <v> | {stop,Reason} | ignore</v> <v> StateName = atom()</v> @@ -639,9 +639,9 @@ gen_fsm:sync_send_all_state_event -----> Module:handle_sync_event/4 <v>StateName = atom()</v> <v>StateData = term()</v> <v>Result = {next_state,NextStateName,NewStateData}</v> - <v> > | {next_state,NextStateName,NewStateData,Timeout}</v> - <v> > | {next_state,NextStateName,NewStateData,hibernate}</v> - <v> > | {stop,Reason,NewStateData}</v> + <v> | {next_state,NextStateName,NewStateData,Timeout}</v> + <v> | {next_state,NextStateName,NewStateData,hibernate}</v> + <v> | {stop,Reason,NewStateData}</v> <v> NextStateName = atom()</v> <v> NewStateData = term()</v> <v> Timeout = int()>0 | infinity</v> diff --git a/lib/stdlib/doc/src/io.xml b/lib/stdlib/doc/src/io.xml index af9c75d546..667d758e29 100644 --- a/lib/stdlib/doc/src/io.xml +++ b/lib/stdlib/doc/src/io.xml @@ -439,7 +439,7 @@ ok</pre> <item> <p>Prints the argument with the <c>string</c> syntax. The argument is, if no Unicode translation modifier is present, an - <seealso marker="erts:erlang#iolist_definition">I/O list</seealso>, a binary, or an atom. If the Unicode translation modifier ('t') is in effect, the argument is unicode:chardata(), meaning that binaries are in UTF-8. The characters + iolist(), a binary, or an atom. If the Unicode translation modifier ('t') is in effect, the argument is unicode:chardata(), meaning that binaries are in UTF-8. The characters are printed without quotes. The string is first truncated by the given precision and then padded and justified to the given field width. The default precision is the field width.</p> diff --git a/lib/stdlib/doc/src/supervisor.xml b/lib/stdlib/doc/src/supervisor.xml index 009aa60faa..edd119d37a 100644 --- a/lib/stdlib/doc/src/supervisor.xml +++ b/lib/stdlib/doc/src/supervisor.xml @@ -150,9 +150,12 @@ child_spec() = {Id,StartFunc,Restart,Shutdown,Type,Modules} <p><c>Restart</c> defines when a terminated child process should be restarted. A <c>permanent</c> child process should always be restarted, a <c>temporary</c> child process should - never be restarted and a <c>transient</c> child process - should be restarted only if it terminates abnormally, i.e. - with another exit reason than <c>normal</c>.</p> + never be restarted (even when the supervisor's restart strategy + is <c>rest_for_one</c> or <c>one_for_all</c> and a sibling's + death causes the temporary process to be terminated) and a + <c>transient</c> child process should be restarted only if + it terminates abnormally, i.e. with another exit reason + than <c>normal</c>.</p> </item> <item> <p><c>Shutdown</c> defines how a child process should be diff --git a/lib/stdlib/doc/src/unicode_usage.xml b/lib/stdlib/doc/src/unicode_usage.xml index 416df1f02c..b48ad8c1f3 100644 --- a/lib/stdlib/doc/src/unicode_usage.xml +++ b/lib/stdlib/doc/src/unicode_usage.xml @@ -52,7 +52,7 @@ <tag>UCS-4</tag> <item>Basically the same as UTF-32, but without some Unicode semantics, defined by IEEE and has little use as a separate encoding standard. For all normal (and possibly abnormal) usages, UTF-32 and UCS-4 are interchangeable.</item> </taglist> -<p>Certain ranges of characters are left unused and certain ranges are even deemed invalid. The most notable invalid range is 16#D800 - 16#DFFF, as the UTF-16 encoding does not allow for encoding of these numbers. It can be speculated that the UTF-16 encoding standard was, from the beginning, expected to be able to hold all Unicode characters in one 16-bit entity, but then had to be extended, leaving a whole in the Unicode range to cope with backward compatibility.</p> +<p>Certain ranges of characters are left unused and certain ranges are even deemed invalid. The most notable invalid range is 16#D800 - 16#DFFF, as the UTF-16 encoding does not allow for encoding of these numbers. It can be speculated that the UTF-16 encoding standard was, from the beginning, expected to be able to hold all Unicode characters in one 16-bit entity, but then had to be extended, leaving a hole in the Unicode range to cope with backward compatibility.</p> <p>Additionally, the codepoint 16#FEFF is used for byte order marks (BOM's) and use of that character is not encouraged in other contexts than that. It actually is valid though, as the character "ZWNBS" (Zero Width Non Breaking Space). BOM's are used to identify encodings and byte order for programs where such parameters are not known in advance. Byte order marks are more seldom used than one could expect, put their use is becoming more widely spread as they provide the means for programs to make educated guesses about the Unicode format of a certain file.</p> </section> <section> diff --git a/lib/stdlib/src/calendar.erl b/lib/stdlib/src/calendar.erl index 8d1071209e..0320e0cd0e 100644 --- a/lib/stdlib/src/calendar.erl +++ b/lib/stdlib/src/calendar.erl @@ -63,7 +63,7 @@ %% Types %%---------------------------------------------------------------------- --export_type([t_now/0]). +-export_type([date/0, time/0, datetime/0, datetime1970/0]). -type year() :: non_neg_integer(). -type year1970() :: 1970..10000. % should probably be 1970.. @@ -76,15 +76,11 @@ -type ldom() :: 28 | 29 | 30 | 31. % last day of month -type weeknum() :: 1..53. --type t_now() :: {MegaSecs :: non_neg_integer(), - Secs :: non_neg_integer(), - MicroSecs :: non_neg_integer()}. - --type t_date() :: {year(),month(),day()}. --type t_time() :: {hour(),minute(),second()}. --type t_datetime() :: {t_date(),t_time()}. --type t_datetime1970() :: {{year1970(),month(),day()},t_time()}. --type t_yearweeknum() :: {year(),weeknum()}. +-type date() :: {year(),month(),day()}. +-type time() :: {hour(),minute(),second()}. +-type datetime() :: {date(),time()}. +-type datetime1970() :: {{year1970(),month(),day()},time()}. +-type yearweeknum() :: {year(),weeknum()}. %%---------------------------------------------------------------------- @@ -123,7 +119,7 @@ date_to_gregorian_days(Year, Month, Day) when is_integer(Day), Day > 0 -> end. -spec date_to_gregorian_days(Date) -> Days when - Date :: t_date(), + Date :: date(), Days :: non_neg_integer(). date_to_gregorian_days({Year, Month, Day}) -> date_to_gregorian_days(Year, Month, Day). @@ -135,7 +131,7 @@ date_to_gregorian_days({Year, Month, Day}) -> %% January 1st. %% -spec datetime_to_gregorian_seconds(DateTime) -> Seconds when - DateTime :: t_datetime(), + DateTime :: datetime(), Seconds :: non_neg_integer(). datetime_to_gregorian_seconds({Date, Time}) -> ?SECONDS_PER_DAY*date_to_gregorian_days(Date) + @@ -155,14 +151,14 @@ day_of_the_week(Year, Month, Day) -> (date_to_gregorian_days(Year, Month, Day) + 5) rem 7 + 1. -spec day_of_the_week(Date) -> daynum() when - Date:: t_date(). + Date:: date(). day_of_the_week({Year, Month, Day}) -> day_of_the_week(Year, Month, Day). %% gregorian_days_to_date(Days) = {Year, Month, Day} %% --spec gregorian_days_to_date(Days) -> t_date() when +-spec gregorian_days_to_date(Days) -> date() when Days :: non_neg_integer(). gregorian_days_to_date(Days) -> {Year, DayOfYear} = day_to_year(Days), @@ -172,7 +168,7 @@ gregorian_days_to_date(Days) -> %% gregorian_seconds_to_datetime(Secs) %% --spec gregorian_seconds_to_datetime(Seconds) -> t_datetime() when +-spec gregorian_seconds_to_datetime(Seconds) -> datetime() when Seconds :: non_neg_integer(). gregorian_seconds_to_datetime(Secs) when Secs >= 0 -> Days = Secs div ?SECONDS_PER_DAY, @@ -198,7 +194,7 @@ is_leap_year1(_) -> false. %% %% Calculates the iso week number for the current date. %% --spec iso_week_number() -> t_yearweeknum(). +-spec iso_week_number() -> yearweeknum(). iso_week_number() -> {Date, _} = local_time(), iso_week_number(Date). @@ -207,8 +203,8 @@ iso_week_number() -> %% %% Calculates the iso week number for the given date. %% --spec iso_week_number(Date) -> t_yearweeknum() when - Date :: t_date(). +-spec iso_week_number(Date) -> yearweeknum() when + Date :: date(). iso_week_number({Year, Month, Day}) -> D = date_to_gregorian_days({Year, Month, Day}), W01_1_Year = gregorian_days_of_iso_w01_1(Year), @@ -260,7 +256,7 @@ last_day_of_the_month1(_, M) when is_integer(M), M > 0, M < 13 -> %% local_time() %% %% Returns: {date(), time()}, date() = {Y, M, D}, time() = {H, M, S}. --spec local_time() -> t_datetime(). +-spec local_time() -> datetime(). local_time() -> erlang:localtime(). @@ -268,20 +264,20 @@ local_time() -> %% local_time_to_universal_time(DateTime) %% -spec local_time_to_universal_time(DateTime1) -> DateTime2 when - DateTime1 :: t_datetime1970(), - DateTime2 :: t_datetime1970(). + DateTime1 :: datetime1970(), + DateTime2 :: datetime1970(). local_time_to_universal_time(DateTime) -> erlang:localtime_to_universaltime(DateTime). --spec local_time_to_universal_time(t_datetime1970(), +-spec local_time_to_universal_time(datetime1970(), 'true' | 'false' | 'undefined') -> - t_datetime1970(). + datetime1970(). local_time_to_universal_time(DateTime, IsDst) -> erlang:localtime_to_universaltime(DateTime, IsDst). -spec local_time_to_universal_time_dst(DateTime1) -> [DateTime] when - DateTime1 :: t_datetime1970(), - DateTime :: t_datetime1970(). + DateTime1 :: datetime1970(), + DateTime :: datetime1970(). local_time_to_universal_time_dst(DateTime) -> UtDst = erlang:localtime_to_universaltime(DateTime, true), Ut = erlang:localtime_to_universaltime(DateTime, false), @@ -309,14 +305,14 @@ local_time_to_universal_time_dst(DateTime) -> %% = MilliSec = integer() %% Returns: {date(), time()}, date() = {Y, M, D}, time() = {H, M, S}. %% --spec now_to_datetime(Now) -> t_datetime1970() when - Now :: t_now(). +-spec now_to_datetime(Now) -> datetime1970() when + Now :: erlang:timestamp(). now_to_datetime({MSec, Sec, _uSec}) -> Sec0 = MSec*1000000 + Sec + ?DAYS_FROM_0_TO_1970*?SECONDS_PER_DAY, gregorian_seconds_to_datetime(Sec0). --spec now_to_universal_time(Now) -> t_datetime1970() when - Now :: t_now(). +-spec now_to_universal_time(Now) -> datetime1970() when + Now :: erlang:timestamp(). now_to_universal_time(Now) -> now_to_datetime(Now). @@ -325,8 +321,8 @@ now_to_universal_time(Now) -> %% %% Args: Now = now() %% --spec now_to_local_time(Now) -> t_datetime1970() when - Now :: t_now(). +-spec now_to_local_time(Now) -> datetime1970() when + Now :: erlang:timestamp(). now_to_local_time({MSec, Sec, _uSec}) -> erlang:universaltime_to_localtime( now_to_universal_time({MSec, Sec, _uSec})). @@ -338,7 +334,7 @@ now_to_local_time({MSec, Sec, _uSec}) -> -spec seconds_to_daystime(Seconds) -> {Days, Time} when Seconds :: integer(), Days :: integer(), - Time :: t_time(). + Time :: time(). seconds_to_daystime(Secs) -> Days0 = Secs div ?SECONDS_PER_DAY, Secs0 = Secs rem ?SECONDS_PER_DAY, @@ -356,7 +352,7 @@ seconds_to_daystime(Secs) -> %% Wraps. %% -type secs_per_day() :: 0..?SECONDS_PER_DAY. --spec seconds_to_time(Seconds) -> t_time() when +-spec seconds_to_time(Seconds) -> time() when Seconds :: secs_per_day(). seconds_to_time(Secs) when Secs >= 0, Secs < ?SECONDS_PER_DAY -> Secs0 = Secs rem ?SECONDS_PER_DAY, @@ -375,10 +371,10 @@ seconds_to_time(Secs) when Secs >= 0, Secs < ?SECONDS_PER_DAY -> %% Year = Month = Day = Hour = Minute = Sec = integer() %% -spec time_difference(T1, T2) -> {Days, Time} when - T1 :: t_datetime(), - T2 :: t_datetime(), + T1 :: datetime(), + T2 :: datetime(), Days :: integer(), - Time :: t_time(). + Time :: time(). time_difference({{Y1, Mo1, D1}, {H1, Mi1, S1}}, {{Y2, Mo2, D2}, {H2, Mi2, S2}}) -> Secs = datetime_to_gregorian_seconds({{Y2, Mo2, D2}, {H2, Mi2, S2}}) - @@ -390,7 +386,7 @@ time_difference({{Y1, Mo1, D1}, {H1, Mi1, S1}}, %% time_to_seconds(Time) %% -spec time_to_seconds(Time) -> secs_per_day() when - Time :: t_time(). + Time :: time(). time_to_seconds({H, M, S}) when is_integer(H), is_integer(M), is_integer(S) -> H * ?SECONDS_PER_HOUR + M * ?SECONDS_PER_MINUTE + S. @@ -399,15 +395,15 @@ time_to_seconds({H, M, S}) when is_integer(H), is_integer(M), is_integer(S) -> %% universal_time() %% %% Returns: {date(), time()}, date() = {Y, M, D}, time() = {H, M, S}. --spec universal_time() -> t_datetime(). +-spec universal_time() -> datetime(). universal_time() -> erlang:universaltime(). %% universal_time_to_local_time(DateTime) %% --spec universal_time_to_local_time(DateTime) -> t_datetime() when - DateTime :: t_datetime1970(). +-spec universal_time_to_local_time(DateTime) -> datetime() when + DateTime :: datetime1970(). universal_time_to_local_time(DateTime) -> erlang:universaltime_to_localtime(DateTime). @@ -429,7 +425,7 @@ valid_date1(_, _, _) -> false. -spec valid_date(Date) -> boolean() when - Date :: t_date(). + Date :: date(). valid_date({Y, M, D}) -> valid_date(Y, M, D). diff --git a/lib/stdlib/src/dets.erl b/lib/stdlib/src/dets.erl index 671b5a9dd4..fa0641ffd9 100644 --- a/lib/stdlib/src/dets.erl +++ b/lib/stdlib/src/dets.erl @@ -411,7 +411,8 @@ init_table(Tab, InitFun) -> InitFun :: fun((Arg) -> Res), Arg :: read | close, Res :: end_of_input | {[object()], InitFun} | {Data, InitFun} | term(), - Options :: [{min_no_slots,no_slots()} | {format,term | bchunk}], + Options :: Option | [Option], + Option :: {min_no_slots,no_slots()} | {format,term | bchunk}, Reason :: term(), Data :: binary() | tuple(). @@ -871,11 +872,15 @@ to_ets(DTab, ETab) -> -spec traverse(Name, Fun) -> Return | {'error', Reason} when Name :: tab_name(), Fun :: fun((Object) -> FunReturn), - FunReturn :: 'continue' | {'continue', Val} | {'done', Value}, + Object :: object(), + FunReturn :: 'continue' + | {'continue', Val} + | {'done', Value} + | OtherValue, + Return :: [term()] | OtherValue, Val :: term(), Value :: term(), - Object :: object(), - Return :: [term()], + OtherValue :: term(), Reason :: term(). traverse(Tab, Fun) -> diff --git a/lib/stdlib/src/erl_compile.erl b/lib/stdlib/src/erl_compile.erl index abff37e4bc..d833f626bf 100644 --- a/lib/stdlib/src/erl_compile.erl +++ b/lib/stdlib/src/erl_compile.erl @@ -41,7 +41,6 @@ compiler(".idl") -> {ic, compile}; compiler(".asn1") -> {asn1ct, compile_asn1}; compiler(".asn") -> {asn1ct, compile_asn}; compiler(".py") -> {asn1ct, compile_py}; -compiler(".xml") -> {xmerl_scan, process}; compiler(_) -> no. %% Entry from command line. diff --git a/lib/stdlib/src/erl_internal.erl b/lib/stdlib/src/erl_internal.erl index 478f05e792..3073fc0fb5 100644 --- a/lib/stdlib/src/erl_internal.erl +++ b/lib/stdlib/src/erl_internal.erl @@ -262,6 +262,7 @@ bif(bitsize, 1) -> true; bif(bit_size, 1) -> true; bif(bitstring_to_list, 1) -> true; bif(byte_size, 1) -> true; +bif(check_old_code, 1) -> true; bif(check_process_code, 2) -> true; bif(concat_binary, 1) -> true; bif(date, 0) -> true; diff --git a/lib/stdlib/src/erl_scan.erl b/lib/stdlib/src/erl_scan.erl index 718ca2e91a..10b2ed2e49 100644 --- a/lib/stdlib/src/erl_scan.erl +++ b/lib/stdlib/src/erl_scan.erl @@ -408,7 +408,12 @@ set_attr(line, {Line,Column}, Fun) when ?ALINE(Line), ?COLUMN(Column) -> end; set_attr(line=Tag, Attrs, Fun) when is_list(Attrs) -> {line,Line} = lists:keyfind(Tag, 1, Attrs), - lists:keyreplace(Tag, 1, Attrs, {line,Fun(Line)}); + case lists:keyreplace(Tag, 1, Attrs, {line,Fun(Line)}) of + [{line,Ln}] when ?ALINE(Ln) -> + Ln; + As -> + As + end; set_attr(T1, T2, T3) -> erlang:error(badarg, [T1,T2,T3]). diff --git a/lib/stdlib/src/erl_tar.erl b/lib/stdlib/src/erl_tar.erl index fd85c7aef5..306834e845 100644 --- a/lib/stdlib/src/erl_tar.erl +++ b/lib/stdlib/src/erl_tar.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% Copyright Ericsson AB 1997-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -798,30 +798,10 @@ set_extracted_file_info(Name, #tar_header{mode=Mode, mtime=Mtime}) -> %% Makes all directories leading up to the file. -make_dirs(Name, Type) -> - make_dirs1(filename:split(Name), Type). - -make_dirs1([Dir, Next|Rest], Type) -> - case file:read_file_info(Dir) of - {ok, #file_info{type=directory}} -> - make_dirs1([filename:join(Dir, Next)|Rest], Type); - {ok, #file_info{}} -> - throw({error, enotdir}); - {error, _} -> - case file:make_dir(Dir) of - ok -> - make_dirs1([filename:join(Dir, Next)|Rest], Type); - {error, Reason} -> - throw({error, Reason}) - end - end; -make_dirs1([_], file) -> ok; -make_dirs1([Dir], dir) -> - file:make_dir(Dir); -make_dirs1([], _) -> - %% There must be something wrong here. The list was not supposed - %% to be empty. - throw({error, enoent}). +make_dirs(Name, file) -> + filelib:ensure_dir(Name); +make_dirs(Name, dir) -> + filelib:ensure_dir(filename:join(Name,"*")). %% Prints the message on if the verbose option is given (for reading). diff --git a/lib/stdlib/src/escript.erl b/lib/stdlib/src/escript.erl index d67617260e..cd1bacd2f5 100644 --- a/lib/stdlib/src/escript.erl +++ b/lib/stdlib/src/escript.erl @@ -62,10 +62,10 @@ -type zip_create_option() :: term(). -type section() :: shebang - | {shebang, shebang()} + | {shebang, shebang() | default | undefined} | comment - | {comment, comment()} - | {emu_args, emu_args()} + | {comment, comment() | default | undefined} + | {emu_args, emu_args() | undefined} | {source, file:filename() | binary()} | {beam, file:filename() | binary()} | {archive, file:filename() | binary()} diff --git a/lib/stdlib/src/eval_bits.erl b/lib/stdlib/src/eval_bits.erl index 2cbd6cdae7..2c7192a7e7 100644 --- a/lib/stdlib/src/eval_bits.erl +++ b/lib/stdlib/src/eval_bits.erl @@ -34,12 +34,12 @@ %% @type matchfun(). A closure which performs a match given a value, a %% pattern and an environment %% -%% @type field() represents a field in a "bin" +%% @type field(). Represents a field in a "bin". %%% Part 1: expression evaluation (binary construction) %% @spec expr_grp(Fields::[field()], Bindings::bindings(), -%% EvalFun::evalfun()) -> +%% EvalFun::evalfun(), term(), term()) -> %% {value, binary(), bindings()} %% %% @doc Returns a tuple with {value,Bin,Bs} where Bin is the binary @@ -192,9 +192,9 @@ bin_gen_field({bin_element,Line,VE,Size0,Options0}, end. %%% Part 3: binary pattern matching -%% @spec match_bits(Fields::[field()], Bin::binary() +%% @spec match_bits(Fields::[field()], Bin::binary(), %% GlobalEnv::bindings(), LocalEnv::bindings(), -%% MatchFun::matchfun(),EvalFun::evalfun()) -> +%% MatchFun::matchfun(),EvalFun::evalfun(), term()) -> %% {match, bindings()} %% @doc Used to perform matching. If the match succeeds a new %% environment is returned. If the match have some syntactic or diff --git a/lib/stdlib/src/io_lib.erl b/lib/stdlib/src/io_lib.erl index 54c7283abf..0252cdf742 100644 --- a/lib/stdlib/src/io_lib.erl +++ b/lib/stdlib/src/io_lib.erl @@ -100,7 +100,7 @@ fwrite(Format, Args) -> -spec fread(Format, String) -> Result when Format :: string(), String :: string(), - Result :: {'ok', InputList :: chars(), LeftOverChars :: string()} + Result :: {'ok', InputList :: [term()], LeftOverChars :: string()} | {'more', RestFormat :: string(), Nchars :: non_neg_integer(), InputStack :: chars()} @@ -109,13 +109,13 @@ fwrite(Format, Args) -> fread(Chars, Format) -> io_lib_fread:fread(Chars, Format). --spec fread(Continuation, String, Format) -> Return when +-spec fread(Continuation, CharSpec, Format) -> Return when Continuation :: continuation() | [], - String :: string(), + CharSpec :: string() | eof, Format :: string(), Return :: {'more', Continuation1 :: continuation()} | {'done', Result, LeftOverChars :: string()}, - Result :: {'ok', InputList :: chars()} + Result :: {'ok', InputList :: [term()]} | 'eof' | {'error', What :: term()}. diff --git a/lib/stdlib/src/io_lib_fread.erl b/lib/stdlib/src/io_lib_fread.erl index 52aa4d073c..ded1346097 100644 --- a/lib/stdlib/src/io_lib_fread.erl +++ b/lib/stdlib/src/io_lib_fread.erl @@ -24,6 +24,10 @@ -import(lists, [reverse/1,reverse/2]). +-define(is_whitespace(C), + ((C) =:= $\s orelse (C) =:= $\t + orelse (C) =:= $\r orelse (C) =:= $\n)). + %%----------------------------------------------------------------------- %% fread(Continuation, CharList, FormatString) @@ -106,31 +110,27 @@ fread_line(Format0, Line, N0, Results0, More, Newline) -> fread(Format, Line) -> fread(Format, Line, 0, []). -fread([$~|Format0], Line, N, Results) -> +fread([$~|Format0]=AllFormat, Line, N, Results) -> {Format,F,Sup,Unicode} = fread_field(Format0), - fread1(Format, F, Sup, Unicode, Line, N, Results, Format0); -fread([$\s|Format], Line, N, Results) -> - fread_skip_white(Format, Line, N, Results); -fread([$\t|Format], Line, N, Results) -> - fread_skip_white(Format, Line, N, Results); -fread([$\r|Format], Line, N, Results) -> - fread_skip_white(Format, Line, N, Results); -fread([$\n|Format], Line, N, Results) -> + fread1(Format, F, Sup, Unicode, Line, N, Results, AllFormat); +fread([C|Format], Line, N, Results) when ?is_whitespace(C) -> fread_skip_white(Format, Line, N, Results); fread([C|Format], [C|Line], N, Results) -> fread(Format, Line, N+1, Results); fread([_F|_Format], [_C|_Line], _N, _Results) -> fread_error(input); +fread([_|_]=Format, [], N, Results) -> + {more,Format,N,Results}; +fread([_|_], eof, 0, []) -> + %% This is at start of input so no error. + eof; +fread([_|_], eof, _N, _Results) -> + %% This is an error as there is no more input. + fread_error(input); fread([], Line, _N, Results) -> {ok,reverse(Results),Line}. -fread_skip_white(Format, [$\s|Line], N, Results) -> - fread_skip_white(Format, Line, N+1, Results); -fread_skip_white(Format, [$\t|Line], N, Results) -> - fread_skip_white(Format, Line, N+1, Results); -fread_skip_white(Format, [$\r|Line], N, Results) -> - fread_skip_white(Format, Line, N+1, Results); -fread_skip_white(Format, [$\n|Line], N, Results) -> +fread_skip_white(Format, [C|Line], N, Results) when ?is_whitespace(C) -> fread_skip_white(Format, Line, N+1, Results); fread_skip_white(Format, Line, N, Results) -> fread(Format, Line, N, Results). @@ -166,9 +166,9 @@ fread1([$l|Format], _F, Sup, _U, Line, N, Res, _AllFormat) -> fread(Format, Line, N, fread_result(Sup, N, Res)); fread1(_Format, _F, _Sup, _U, [], N, Res, AllFormat) -> %% Need more input here. - {more,[$~|AllFormat],N,Res}; -fread1(_Format, _F, _Sup, _U, eof, _N, [], _AllFormat) -> - %% This is at start of format string so no error. + {more,AllFormat,N,Res}; +fread1(_Format, _F, _Sup, _U, eof, 0, [], _AllFormat) -> + %% This is at start of input so no error. eof; fread1(_Format, _F, _Sup, _U, eof, _N, _Res, _AllFormat) -> %% This is an error as there is no more input. @@ -386,26 +386,16 @@ fread_string_cs(Line0, N0, true) -> %% fread_digits(Line, N, Base, Characters) %% Read segments of things, return "thing" characters in reverse order. -fread_skip_white([$\s|Line]) -> fread_skip_white(Line); -fread_skip_white([$\t|Line]) -> fread_skip_white(Line); -fread_skip_white([$\r|Line]) -> fread_skip_white(Line); -fread_skip_white([$\n|Line]) -> fread_skip_white(Line); +fread_skip_white([C|Line]) when ?is_whitespace(C) -> + fread_skip_white(Line); fread_skip_white(Line) -> Line. -fread_skip_white([$\s|Line], N) -> - fread_skip_white(Line, N+1); -fread_skip_white([$\t|Line], N) -> - fread_skip_white(Line, N+1); -fread_skip_white([$\r|Line], N) -> - fread_skip_white(Line, N+1); -fread_skip_white([$\n|Line], N) -> +fread_skip_white([C|Line], N) when ?is_whitespace(C) -> fread_skip_white(Line, N+1); fread_skip_white(Line, N) -> {Line,N}. -fread_skip_latin1_nonwhite([$\s|Line], N, Cs) -> {[$\s|Line],N,Cs}; -fread_skip_latin1_nonwhite([$\t|Line], N, Cs) -> {[$\t|Line],N,Cs}; -fread_skip_latin1_nonwhite([$\r|Line], N, Cs) -> {[$\r|Line],N,Cs}; -fread_skip_latin1_nonwhite([$\n|Line], N, Cs) -> {[$\n|Line],N,Cs}; +fread_skip_latin1_nonwhite([C|Line], N, Cs) when ?is_whitespace(C) -> + {[C|Line],N,Cs}; fread_skip_latin1_nonwhite([C|Line], N, []) when C > 255 -> {[C|Line],N,error}; fread_skip_latin1_nonwhite([C|Line], N, Cs) when C > 255 -> @@ -414,10 +404,8 @@ fread_skip_latin1_nonwhite([C|Line], N, Cs) -> fread_skip_latin1_nonwhite(Line, N+1, [C|Cs]); fread_skip_latin1_nonwhite([], N, Cs) -> {[],N,Cs}. -fread_skip_nonwhite([$\s|Line], N, Cs) -> {[$\s|Line],N,Cs}; -fread_skip_nonwhite([$\t|Line], N, Cs) -> {[$\t|Line],N,Cs}; -fread_skip_nonwhite([$\r|Line], N, Cs) -> {[$\r|Line],N,Cs}; -fread_skip_nonwhite([$\n|Line], N, Cs) -> {[$\n|Line],N,Cs}; +fread_skip_nonwhite([C|Line], N, Cs) when ?is_whitespace(C) -> + {[C|Line],N,Cs}; fread_skip_nonwhite([C|Line], N, Cs) -> fread_skip_nonwhite(Line, N+1, [C|Cs]); fread_skip_nonwhite([], N, Cs) -> {[],N,Cs}. diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl index 39d017d430..5129ba5074 100644 --- a/lib/stdlib/src/otp_internal.erl +++ b/lib/stdlib/src/otp_internal.erl @@ -461,6 +461,14 @@ obsolete_1(public_key, pem_to_der, 1) -> obsolete_1(public_key, decode_private_key, A) when A =:= 1; A =:= 2 -> {deprecated,{public_key,pem_entry_decode,1},"R15A"}; +%% Added in R14B03. +obsolete_1(docb_gen, _, _) -> + {deprecated,"the DocBuilder application is deprecated (will be removed in R15B)"}; +obsolete_1(docb_transform, _, _) -> + {deprecated,"the DocBuilder application is deprecated (will be removed in R15B)"}; +obsolete_1(docb_xml_check, _, _) -> + {deprecated,"the DocBuilder application is deprecated (will be removed in R15B)"}; + obsolete_1(_, _, _) -> no. diff --git a/lib/stdlib/src/proplists.erl b/lib/stdlib/src/proplists.erl index 68697d0da2..e3eda5d932 100644 --- a/lib/stdlib/src/proplists.erl +++ b/lib/stdlib/src/proplists.erl @@ -49,9 +49,10 @@ %% --------------------------------------------------------------------- --export_type([property/0]). +-export_type([property/0, proplist/0]). -type property() :: atom() | tuple(). +-type proplist() :: [property()]. %% --------------------------------------------------------------------- diff --git a/lib/stdlib/src/queue.erl b/lib/stdlib/src/queue.erl index 4c6b4d710b..afe917b151 100644 --- a/lib/stdlib/src/queue.erl +++ b/lib/stdlib/src/queue.erl @@ -56,16 +56,14 @@ new() -> {[],[]}. %{RearList,FrontList} %% O(1) --spec is_queue(Term) -> boolean() when - Term :: term(). +-spec is_queue(Term :: term()) -> boolean(). is_queue({R,F}) when is_list(R), is_list(F) -> true; is_queue(_) -> false. %% O(1) --spec is_empty(Q) -> boolean() when - Q :: queue(). +-spec is_empty(Q :: queue()) -> boolean(). is_empty({[],[]}) -> true; is_empty({In,Out}) when is_list(In), is_list(Out) -> @@ -74,16 +72,14 @@ is_empty(Q) -> erlang:error(badarg, [Q]). %% O(len(Q)) --spec len(Q) -> non_neg_integer() when - Q :: queue(). +-spec len(Q :: queue()) -> non_neg_integer(). len({R,F}) when is_list(R), is_list(F) -> length(R)+length(F); len(Q) -> erlang:error(badarg, [Q]). %% O(len(Q)) --spec to_list(Q) -> list() when - Q :: queue(). +-spec to_list(Q :: queue()) -> list(). to_list({In,Out}) when is_list(In), is_list(Out) -> Out++lists:reverse(In, []); to_list(Q) -> @@ -92,8 +88,7 @@ to_list(Q) -> %% Create queue from list %% %% O(length(L)) --spec from_list(L) -> queue() when - L :: list(). +-spec from_list(L :: list()) -> queue(). from_list(L) when is_list(L) -> f2r(L); from_list(L) -> @@ -102,9 +97,7 @@ from_list(L) -> %% Return true or false depending on if element is in queue %% %% O(length(Q)) worst case --spec member(Item, Q) -> boolean() when - Item :: term(), - Q :: queue(). +-spec member(Item :: term(), Q :: queue()) -> boolean(). member(X, {R,F}) when is_list(R), is_list(F) -> lists:member(X, R) orelse lists:member(X, F); member(X, Q) -> @@ -117,10 +110,7 @@ member(X, Q) -> %% Put at least one element in each list, if it is cheap %% %% O(1) --spec in(Item, Q1) -> Q2 when - Item :: term(), - Q1 :: queue(), - Q2 :: queue(). +-spec in(Item :: term(), Q1 :: queue()) -> Q2 :: queue(). in(X, {[_]=In,[]}) -> {[X], In}; in(X, {In,Out}) when is_list(In), is_list(Out) -> @@ -132,10 +122,7 @@ in(X, Q) -> %% Put at least one element in each list, if it is cheap %% %% O(1) --spec in_r(Item, Q1) -> Q2 when - Item :: term(), - Q1 :: queue(), - Q2 :: queue(). +-spec in_r(Item :: term(), Q1 :: queue()) -> Q2 :: queue(). in_r(X, {[],[_]=F}) -> {F,[X]}; in_r(X, {R,F}) when is_list(R), is_list(F) -> @@ -146,10 +133,9 @@ in_r(X, Q) -> %% Take from head/front %% %% O(1) amortized, O(len(Q)) worst case --spec out(Q1) -> Result when - Q1 :: queue(), - Q2 :: queue(), - Result :: {{value, Item :: term()}, Q2} | {empty, Q1}. +-spec out(Q1 :: queue()) -> + {{value, Item :: term()}, Q2 :: queue()} | + {empty, Q1 :: queue()}. out({[],[]}=Q) -> {empty,Q}; out({[V],[]}) -> @@ -167,10 +153,9 @@ out(Q) -> %% Take from tail/rear %% %% O(1) amortized, O(len(Q)) worst case --spec out_r(Q1) -> Result when - Q1 :: queue(), - Q2 :: queue(), - Result :: {{value, Item :: term()}, Q2} | {empty, Q1}. +-spec out_r(Q1 :: queue()) -> + {{value, Item :: term()}, Q2 :: queue()} | + {empty, Q1 :: queue()}. out_r({[],[]}=Q) -> {empty,Q}; out_r({[],[V]}) -> @@ -191,9 +176,7 @@ out_r(Q) -> %% Return the first element in the queue %% %% O(1) since the queue is supposed to be well formed --spec get(Q) -> Item when - Q :: queue(), - Item :: term(). +-spec get(Q :: queue()) -> Item :: term(). get({[],[]}=Q) -> erlang:error(empty, [Q]); get({R,F}) when is_list(R), is_list(F) -> @@ -212,9 +195,7 @@ get([_|R], []) -> % malformed queue -> O(len(Q)) %% Return the last element in the queue %% %% O(1) since the queue is supposed to be well formed --spec get_r(Q) -> Item when - Q :: queue(), - Item :: term(). +-spec get_r(Q :: queue()) -> Item :: term(). get_r({[],[]}=Q) -> erlang:error(empty, [Q]); get_r({[H|_],F}) when is_list(F) -> @@ -229,9 +210,7 @@ get_r(Q) -> %% Return the first element in the queue %% %% O(1) since the queue is supposed to be well formed --spec peek(Q) -> 'empty' | {'value',Item} when - Q :: queue(), - Item :: term(). +-spec peek(Q :: queue()) -> empty | {value,Item :: term()}. peek({[],[]}) -> empty; peek({R,[H|_]}) when is_list(R) -> @@ -246,9 +225,7 @@ peek(Q) -> %% Return the last element in the queue %% %% O(1) since the queue is supposed to be well formed --spec peek_r(Q) -> 'empty' | {'value',Item} when - Q :: queue(), - Item :: term(). +-spec peek_r(Q :: queue()) -> empty | {value,Item :: term()}. peek_r({[],[]}) -> empty; peek_r({[H|_],F}) when is_list(F) -> @@ -263,9 +240,7 @@ peek_r(Q) -> %% Remove the first element and return resulting queue %% %% O(1) amortized --spec drop(Q1) -> Q2 when - Q1 :: queue(), - Q2 :: queue(). +-spec drop(Q1 :: queue()) -> Q2 :: queue(). drop({[],[]}=Q) -> erlang:error(empty, [Q]); drop({[_],[]}) -> @@ -283,9 +258,7 @@ drop(Q) -> %% Remove the last element and return resulting queue %% %% O(1) amortized --spec drop_r(Q1) -> Q2 when - Q1 :: queue(), - Q2 :: queue(). +-spec drop_r(Q1 :: queue()) -> Q2 :: queue(). drop_r({[],[]}=Q) -> erlang:error(empty, [Q]); drop_r({[],[_]}) -> @@ -306,9 +279,7 @@ drop_r(Q) -> %% Return reversed queue %% %% O(1) --spec reverse(Q1) -> Q2 when - Q1 :: queue(), - Q2 :: queue(). +-spec reverse(Q1 :: queue()) -> Q2 :: queue(). reverse({R,F}) when is_list(R), is_list(F) -> {F,R}; reverse(Q) -> @@ -318,10 +289,7 @@ reverse(Q) -> %% %% Q2 empty: O(1) %% else: O(len(Q1)) --spec join(Q1, Q2) -> Q3 when - Q1 :: queue(), - Q2 :: queue(), - Q3 :: queue(). +-spec join(Q1 :: queue(), Q2 :: queue()) -> Q3 :: queue(). join({R,F}=Q, {[],[]}) when is_list(R), is_list(F) -> Q; join({[],[]}, {R,F}=Q) when is_list(R), is_list(F) -> @@ -335,11 +303,8 @@ join(Q1, Q2) -> %% %% N = 0..len(Q) %% O(max(N, len(Q))) --spec split(N, Q1) -> {Q2,Q3} when - N :: non_neg_integer(), - Q1 :: queue(), - Q2 :: queue(), - Q3 :: queue(). +-spec split(N :: non_neg_integer(), Q1 :: queue()) -> + {Q2 :: queue(),Q3 :: queue()}. split(0, {R,F}=Q) when is_list(R), is_list(F) -> {{[],[]},Q}; split(N, {R,F}=Q) when is_integer(N), N >= 1, is_list(R), is_list(F) -> @@ -380,10 +345,8 @@ split_r1_to_f2(N, [X|R1], F1, R2, F2) -> %% %% Fun(_) -> List: O(length(List) * len(Q)) %% else: O(len(Q) --spec filter(Fun, Q1) -> Q2 when - Fun :: fun((Item :: term()) -> boolean() | list()), - Q1 :: queue(), - Q2 :: queue(). +-spec filter(Fun, Q1 :: queue()) -> Q2 :: queue() when + Fun :: fun((Item :: term()) -> boolean() | list()). filter(Fun, {R0,F0}) when is_function(Fun, 1), is_list(R0), is_list(F0) -> F = filter_f(Fun, F0), R = filter_r(Fun, R0), @@ -459,10 +422,7 @@ filter_r(Fun, [X|R0]) -> %% Cons to head %% --spec cons(Item, Q1) -> Q2 when - Item :: term(), - Q1 :: queue(), - Q2 :: queue(). +-spec cons(Item :: term(), Q1 :: queue()) -> Q2 :: queue(). cons(X, Q) -> in_r(X, Q). @@ -471,9 +431,7 @@ cons(X, Q) -> %% Return the first element in the queue %% %% O(1) since the queue is supposed to be well formed --spec head(Q) -> Item when - Q :: queue(), - Item :: term(). +-spec head(Q :: queue()) -> Item :: term(). head({[],[]}=Q) -> erlang:error(empty, [Q]); head({R,F}) when is_list(R), is_list(F) -> @@ -483,9 +441,7 @@ head(Q) -> %% Remove head element and return resulting queue %% --spec tail(Q1) -> Q2 when - Q1 :: queue(), - Q2 :: queue(). +-spec tail(Q1 :: queue()) -> Q2 :: queue(). tail(Q) -> drop(Q). @@ -493,35 +449,22 @@ tail(Q) -> %% Cons to tail %% --spec snoc(Q1, Item) -> Q2 when - Q1 :: queue(), - Q2 :: queue(), - Item :: term(). +-spec snoc(Q1 :: queue(), Item :: term()) -> Q2 :: queue(). snoc(Q, X) -> in(X, Q). %% Return last element --spec daeh(Q) -> Item when - Q :: queue(), - Item :: term(). +-spec daeh(Q :: queue()) -> Item :: term(). daeh(Q) -> get_r(Q). --spec last(Q) -> Item when - Q :: queue(), - Item :: term(). +-spec last(Q :: queue()) -> Item :: term(). last(Q) -> get_r(Q). %% Remove last element and return resulting queue --spec liat(Q1) -> Q2 when - Q1 :: queue(), - Q2 :: queue(). +-spec liat(Q1 :: queue()) -> Q2 :: queue(). liat(Q) -> drop_r(Q). --spec lait(Q1) -> Q2 when - Q1 :: queue(), - Q2 :: queue(). +-spec lait(Q1 :: queue()) -> Q2 :: queue(). lait(Q) -> drop_r(Q). %% Oops, mis-spelled 'tail' reversed. Forget this one. --spec init(Q1) -> Q2 when - Q1 :: queue(), - Q2 :: queue(). +-spec init(Q1 :: queue()) -> Q2 :: queue(). init(Q) -> drop_r(Q). %%-------------------------------------------------------------------------- diff --git a/lib/stdlib/src/sofs.erl b/lib/stdlib/src/sofs.erl index d38b8ab37a..34eb224647 100644 --- a/lib/stdlib/src/sofs.erl +++ b/lib/stdlib/src/sofs.erl @@ -81,7 +81,8 @@ -define(ORDTAG, 'OrdSet'). -record(?TAG, {data = [] :: list(), type = type :: term()}). --record(?ORDTAG, {orddata = {} :: tuple(), ordtype = type :: term()}). +-record(?ORDTAG, {orddata = {} :: tuple() | atom(), + ordtype = type :: term()}). -define(LIST(S), (S)#?TAG.data). -define(TYPE(S), (S)#?TAG.type). @@ -375,7 +376,7 @@ to_sets(S) when ?IS_ORDSET(S) -> -spec(no_elements(ASet) -> NoElements when ASet :: a_set() | ordset(), - NoElements :: pos_integer()). + NoElements :: non_neg_integer()). no_elements(S) when ?IS_SET(S) -> length(?LIST(S)); no_elements(S) when ?IS_ORDSET(S), is_tuple(?ORDTYPE(S)) -> diff --git a/lib/stdlib/src/supervisor.erl b/lib/stdlib/src/supervisor.erl index e60706ed05..dc31647eb5 100644 --- a/lib/stdlib/src/supervisor.erl +++ b/lib/stdlib/src/supervisor.erl @@ -735,6 +735,13 @@ restart(one_for_all, Child, State) -> terminate_children(Children, SupName) -> terminate_children(Children, SupName, []). +%% Temporary children should not be restarted and thus should +%% be skipped when building the list of terminated children, although +%% we do want them to be shut down as many functions from this module +%% use this function to just clear everything. +terminate_children([Child = #child{restart_type=temporary} | Children], SupName, Res) -> + do_terminate(Child, SupName), + terminate_children(Children, SupName, Res); terminate_children([Child | Children], SupName, Res) -> NChild = do_terminate(Child, SupName), terminate_children(Children, SupName, [NChild | Res]); diff --git a/lib/stdlib/src/sys.erl b/lib/stdlib/src/sys.erl index 8ab72c9b50..f34201604c 100644 --- a/lib/stdlib/src/sys.erl +++ b/lib/stdlib/src/sys.erl @@ -154,7 +154,7 @@ log_to_file(Name, FileName, Timeout) -> -spec statistics(Name, Flag) -> 'ok' | {'ok', Statistics} when Name :: name(), Flag :: 'true' | 'false' | 'get', - Statistics :: [StatisticsTuple], + Statistics :: [StatisticsTuple] | no_statistics, StatisticsTuple :: {'start_time', DateTime1} | {'current_time', DateTime2} | {'reductions', non_neg_integer()} @@ -168,7 +168,7 @@ statistics(Name, Flag) -> -spec statistics(Name, Flag, Timeout) -> 'ok' | {'ok', Statistics} when Name :: name(), Flag :: 'true' | 'false' | 'get', - Statistics :: [StatisticsTuple], + Statistics :: [StatisticsTuple] | no_statistics, StatisticsTuple :: {'start_time', DateTime1} | {'current_time', DateTime2} | {'reductions', non_neg_integer()} diff --git a/lib/stdlib/src/timer.erl b/lib/stdlib/src/timer.erl index 89fae05e4f..689e42051f 100644 --- a/lib/stdlib/src/timer.erl +++ b/lib/stdlib/src/timer.erl @@ -199,9 +199,9 @@ tc(M, F, A) -> %% Calculate the time difference (in microseconds) of two %% erlang:now() timestamps, T2-T1. %% --spec now_diff(T1, T2) -> Tdiff when - T1 :: calendar:t_now(), - T2 :: calendar:t_now(), +-spec now_diff(T2, T1) -> Tdiff when + T1 :: erlang:timestamp(), + T2 :: erlang:timestamp(), Tdiff :: integer(). now_diff({A2, B2, C2}, {A1, B1, C1}) -> ((A2-A1)*1000000 + B2-B1)*1000000 + C2-C1. diff --git a/lib/stdlib/src/zip.erl b/lib/stdlib/src/zip.erl index 524d709431..c82c8159b6 100644 --- a/lib/stdlib/src/zip.erl +++ b/lib/stdlib/src/zip.erl @@ -223,7 +223,7 @@ openzip_open(F, Options) -> do_openzip_open(F, Options) -> Opts = get_openzip_options(Options), #openzip_opts{output = Output, open_opts = OpO, cwd = CWD} = Opts, - Input = get_zip_input(F), + Input = get_input(F), In0 = Input({open, F, OpO -- [write]}, []), {[#zip_comment{comment = C} | Files], In1} = get_central_dir(In0, fun raw_file_info_etc/5, Input), @@ -489,7 +489,7 @@ do_list_dir(F, Options) -> %% Print zip directory in short form -spec(t(Archive) -> ok when - Archive :: file:name() | binary | ZipHandle, + Archive :: file:name() | binary() | ZipHandle, ZipHandle :: pid()). t(F) when is_pid(F) -> zip_t(F); @@ -513,7 +513,7 @@ do_t(F, RawPrint) -> %% Print zip directory in long form (like ls -l) -spec(tt(Archive) -> ok when - Archive :: file:name() | binary | ZipHandle, + Archive :: file:name() | binary() | ZipHandle, ZipHandle :: pid()). tt(F) when is_pid(F) -> zip_tt(F); @@ -1174,7 +1174,7 @@ zip_get(Pid) when is_pid(Pid) -> zip_close(Pid) when is_pid(Pid) -> request(self(), Pid, close). --spec(zip_get(FileName, ZipHandle) -> {ok, [Result]} | {error, Reason} when +-spec(zip_get(FileName, ZipHandle) -> {ok, Result} | {error, Reason} when FileName :: file:name(), ZipHandle :: pid(), Result :: file:name() | {file:name(), binary()}, @@ -1183,7 +1183,7 @@ zip_close(Pid) when is_pid(Pid) -> zip_get(FileName, Pid) when is_pid(Pid) -> request(self(), Pid, {get, FileName}). --spec(zip_list_dir(ZipHandle) -> Result | {error, Reason} when +-spec(zip_list_dir(ZipHandle) -> {ok, Result} | {error, Reason} when Result :: [zip_comment() | zip_file()], ZipHandle :: pid(), Reason :: term()). diff --git a/lib/stdlib/test/beam_lib_SUITE.erl b/lib/stdlib/test/beam_lib_SUITE.erl index 4ccc863795..91fff3cee4 100644 --- a/lib/stdlib/test/beam_lib_SUITE.erl +++ b/lib/stdlib/test/beam_lib_SUITE.erl @@ -242,8 +242,8 @@ cmp(doc) -> ["Compare contents of BEAM files and directories"]; cmp(Conf) when is_list(Conf) -> ?line PrivDir = ?privdir, - ?line Dir1 = filename:join(PrivDir, dir1), - ?line Dir2 = filename:join(PrivDir, dir2), + ?line Dir1 = filename:join(PrivDir, "dir1"), + ?line Dir2 = filename:join(PrivDir, "dir2"), ok = file:make_dir(Dir1), ok = file:make_dir(Dir2), @@ -292,8 +292,8 @@ cmp_literals(doc) -> ["Compare contents of BEAM files having literals"]; cmp_literals(Conf) when is_list(Conf) -> ?line PrivDir = ?privdir, - ?line Dir1 = filename:join(PrivDir, dir1), - ?line Dir2 = filename:join(PrivDir, dir2), + ?line Dir1 = filename:join(PrivDir, "dir1"), + ?line Dir2 = filename:join(PrivDir, "dir2"), ok = file:make_dir(Dir1), ok = file:make_dir(Dir2), @@ -381,7 +381,7 @@ otp_6711(Conf) when is_list(Conf) -> (catch {a, beam_lib:strip_files([3])}), ?line PrivDir = ?privdir, - ?line Dir = filename:join(PrivDir, dir), + ?line Dir = filename:join(PrivDir, "dir"), ?line Lib = filename:join(Dir, "lib"), ?line App = filename:join(Lib, "app"), ?line EBin = filename:join(App, "ebin"), @@ -417,8 +417,8 @@ building(doc) -> "Testing building of BEAM files."; building(Conf) when is_list(Conf) -> ?line PrivDir = ?privdir, - ?line Dir1 = filename:join(PrivDir, b_dir1), - ?line Dir2 = filename:join(PrivDir, b_dir2), + ?line Dir1 = filename:join(PrivDir, "b_dir1"), + ?line Dir2 = filename:join(PrivDir, "b_dir2"), ok = file:make_dir(Dir1), ok = file:make_dir(Dir2), @@ -688,7 +688,7 @@ chunk_info(File) -> Chunks. make_beam(Dir, Module, F) -> - ?line FileBase = filename:join(Dir, Module), + ?line FileBase = filename:join(Dir, atom_to_list(Module)), ?line Source = FileBase ++ ".erl", ?line BeamFile = FileBase ++ ".beam", ?line simple_file(Source, Module, F), diff --git a/lib/stdlib/test/dets_SUITE.erl b/lib/stdlib/test/dets_SUITE.erl index 698070368f..22a9d4a7ff 100644 --- a/lib/stdlib/test/dets_SUITE.erl +++ b/lib/stdlib/test/dets_SUITE.erl @@ -1516,7 +1516,7 @@ repair(Config, V) -> if V =:= 8 -> %% first estimated number of objects is wrong, repair once more - ?line {ok, Fd} = file:open(Fname, read_write), + ?line {ok, Fd} = file:open(Fname, [read,write]), NoPos = HeadSize - 8, % no_objects ?line file:pwrite(Fd, NoPos, <<0:32>>), % NoItems ok = file:close(Fd), @@ -3247,7 +3247,7 @@ otp_5402(suite) -> []; otp_5402(Config) when is_list(Config) -> Tab = otp_5402, - ?line File = filename:join([cannot, write, this, file]), + ?line File = filename:join(["cannot", "write", "this", "file"]), %% close ?line{ok, T} = dets:open_file(Tab, [{ram_file,true}, @@ -3887,7 +3887,7 @@ crash(File, Where) -> crash(File, Where, 10). crash(File, Where, What) when is_integer(What) -> - ?line {ok, Fd} = file:open(File, read_write), + ?line {ok, Fd} = file:open(File, [read,write]), ?line file:position(Fd, Where), ?line ok = file:write(Fd, [What]), ?line ok = file:close(Fd). @@ -4031,7 +4031,7 @@ writable(Fname) -> ?line file:write_file_info(Fname, Info#file_info{mode = Mode}). truncate(File, Where) -> - ?line {ok, Fd} = file:open(File, read_write), + ?line {ok, Fd} = file:open(File, [read,write]), ?line file:position(Fd, Where), ?line ok = file:truncate(Fd), ?line ok = file:close(Fd). diff --git a/lib/stdlib/test/epp_SUITE.erl b/lib/stdlib/test/epp_SUITE.erl index 9b024a5b49..57f3f4eddb 100644 --- a/lib/stdlib/test/epp_SUITE.erl +++ b/lib/stdlib/test/epp_SUITE.erl @@ -1280,7 +1280,7 @@ eval_tests(Config, Fun, Tests) -> check_test(Config, Test) -> - Filename = 'epp_test.erl', + Filename = "epp_test.erl", ?line PrivDir = ?config(priv_dir, Config), ?line File = filename:join(PrivDir, Filename), ?line ok = file:write_file(File, Test), @@ -1293,7 +1293,7 @@ check_test(Config, Test) -> compile_test(Config, Test0) -> Test = [<<"-module(epp_test). -compile(export_all). ">>, Test0], - Filename = 'epp_test.erl', + Filename = "epp_test.erl", ?line PrivDir = ?config(priv_dir, Config), ?line File = filename:join(PrivDir, Filename), ?line ok = file:write_file(File, Test), diff --git a/lib/stdlib/test/erl_eval_SUITE.erl b/lib/stdlib/test/erl_eval_SUITE.erl index 0bcf3c5b71..784c7cb86e 100644 --- a/lib/stdlib/test/erl_eval_SUITE.erl +++ b/lib/stdlib/test/erl_eval_SUITE.erl @@ -1189,7 +1189,7 @@ lfh() -> {eval, fun(F, As, Bs) -> local_func(F, As, Bs) end}. local_func(F, As0, Bs0) when is_atom(F) -> - {As,Bs} = erl_eval:expr_list(As0, Bs0, {eval,lfh()}), + {As,Bs} = erl_eval:expr_list(As0, Bs0, lfh()), case erlang:function_exported(?MODULE, F, length(As)) of true -> {value,apply(?MODULE, F, As),Bs}; diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl index f980d52e4e..9041adbe5c 100644 --- a/lib/stdlib/test/erl_lint_SUITE.erl +++ b/lib/stdlib/test/erl_lint_SUITE.erl @@ -2981,7 +2981,7 @@ run_test(Conf, Test0, Warnings0) -> run_test2(Conf, Test, Warnings0). run_test2(Conf, Test, Warnings0) -> - Filename = 'lint_test.erl', + Filename = "lint_test.erl", DataDir = ?privdir, File = filename:join(DataDir, Filename), Opts = case Warnings0 of diff --git a/lib/stdlib/test/erl_scan_SUITE.erl b/lib/stdlib/test/erl_scan_SUITE.erl index 31a4f94294..4298b2c701 100644 --- a/lib/stdlib/test/erl_scan_SUITE.erl +++ b/lib/stdlib/test/erl_scan_SUITE.erl @@ -737,6 +737,10 @@ set_attribute() -> (catch {foo, erl_scan:set_attribute(line, [], F2)}), % type error ?line {'EXIT',{badarg,_}} = (catch {foo, erl_scan:set_attribute(column, [], F2)}), % type error + + %% OTP-9412 + ?line 8 = erl_scan:set_attribute(line, [{line,{nos,'X',8}}], + fun({nos,_V,VL}) -> VL end), ok. column_errors() -> diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl index 9d348b5f1a..57df963ae2 100644 --- a/lib/stdlib/test/ets_SUITE.erl +++ b/lib/stdlib/test/ets_SUITE.erl @@ -72,6 +72,7 @@ exit_many_many_tables_owner/1]). -export([write_concurrency/1, heir/1, give_away/1, setopts/1]). -export([bad_table/1, types/1]). +-export([otp_9423/1]). -export([init_per_testcase/2, end_per_testcase/2]). %% Convenience for manual testing @@ -143,7 +144,8 @@ all() -> otp_8166, exit_large_table_owner, exit_many_large_table_owner, exit_many_tables_owner, exit_many_many_tables_owner, write_concurrency, heir, - give_away, setopts, bad_table, types]. + give_away, setopts, bad_table, types, + otp_9423]. groups() -> [{new, [], @@ -817,6 +819,14 @@ t_delete_all_objects(Config) when is_list(Config) -> repeat_for_opts(t_delete_all_objects_do), ?line verify_etsmem(EtsMem). +get_kept_objects(T) -> + case ets:info(T,stats) of + false -> + 0; + {_,_,_,_,_,_,KO} -> + KO + end. + t_delete_all_objects_do(Opts) -> ?line T=ets_new(x,Opts), ?line filltabint(T,4000), @@ -826,10 +836,10 @@ t_delete_all_objects_do(Opts) -> ?line true = ets:delete_all_objects(T), ?line '$end_of_table' = ets:next(T,O), ?line 0 = ets:info(T,size), - ?line 4000 = ets:info(T,kept_objects), + ?line 4000 = get_kept_objects(T), ?line ets:safe_fixtable(T,false), ?line 0 = ets:info(T,size), - ?line 0 = ets:info(T,kept_objects), + ?line 0 = get_kept_objects(T), ?line filltabint(T,4000), ?line 4000 = ets:info(T,size), ?line true = ets:delete_all_objects(T), @@ -859,10 +869,10 @@ t_delete_object_do(Opts) -> ?line ets:delete_object(T,{First, integer_to_list(First)}), ?line Next = ets:next(T,First), ?line 3999 = ets:info(T,size), - ?line 1 = ets:info(T,kept_objects), + ?line 1 = get_kept_objects(T), ?line ets:safe_fixtable(T,false), ?line 3999 = ets:info(T,size), - ?line 0 = ets:info(T,kept_objects), + ?line 0 = get_kept_objects(T), ?line ets:delete(T), ?line T1 = ets_new(x,[ordered_set | Opts]), ?line filltabint(T1,4000), @@ -2715,7 +2725,8 @@ ordered_do(Opts) -> 9,10,11,12, 1,2,3,4, 17,18,19,20, - 13,14,15,16 + 13,14,15,16, + 1 bsl 33 ], ?line lists:foreach(fun(X) -> ets:insert(T,{X,integer_to_list(X)}) @@ -2730,13 +2741,14 @@ ordered_do(Opts) -> ?line S2 = L2, ?line [{1,"1"}] = ets:slot(T,0), ?line [{28,"28"}] = ets:slot(T,27), + ?line [{1 bsl 33,_}] = ets:slot(T,28), ?line 27 = ets:prev(T,28), ?line [{7,"7"}] = ets:slot(T,6), - ?line '$end_of_table' = ets:next(T,28), + ?line '$end_of_table' = ets:next(T,1 bsl 33), ?line [{12,"12"}] = ets:slot(T,11), - ?line '$end_of_table' = ets:slot(T,28), + ?line '$end_of_table' = ets:slot(T,29), ?line [{1,"1"}] = ets:slot(T,0), - ?line 28 = ets:prev(T,29), + ?line 28 = ets:prev(T,1 bsl 33), ?line 1 = ets:next(T,0), ?line pick_all_forward(T), ?line [{7,"7"}] = ets:slot(T,6), @@ -4967,7 +4979,7 @@ grow_pseudo_deleted_do(Type) -> [true]}]), Left = Mult*(Mod-1), ?line Left = ets:info(T,size), - ?line Mult = ets:info(T,kept_objects), + ?line Mult = get_kept_objects(T), filltabstr(T,Mult), spawn_opt(fun()-> ?line true = ets:info(T,fixed), Self ! start, @@ -4981,7 +4993,7 @@ grow_pseudo_deleted_do(Type) -> ?line true = ets:safe_fixtable(T,false), io:format("Unfix table done. ~p nitems=~p\n",[now(),ets:info(T,size)]), ?line false = ets:info(T,fixed), - ?line 0 = ets:info(T,kept_objects), + ?line 0 = get_kept_objects(T), ?line done = receive_any(), %%verify_table_load(T), % may fail if concurrency is poor (genny) ets:delete(T), @@ -5008,7 +5020,7 @@ shrink_pseudo_deleted_do(Type) -> [{'>', '$1', Half}], [true]}]), ?line Half = ets:info(T,size), - ?line Half = ets:info(T,kept_objects), + ?line Half = get_kept_objects(T), spawn_opt(fun()-> ?line true = ets:info(T,fixed), Self ! start, io:format("Starting to delete... ~p\n",[now()]), @@ -5021,7 +5033,7 @@ shrink_pseudo_deleted_do(Type) -> ?line true = ets:safe_fixtable(T,false), io:format("Unfix table done. ~p nitems=~p\n",[now(),ets:info(T,size)]), ?line false = ets:info(T,fixed), - ?line 0 = ets:info(T,kept_objects), + ?line 0 = get_kept_objects(T), ?line done = receive_any(), %%verify_table_load(T), % may fail if concurrency is poor (genny) ets:delete(T), @@ -5137,7 +5149,7 @@ smp_fixed_delete_do() -> ?line 0 = ets:info(T,size), ?line true = ets:info(T,fixed), ?line Buckets = num_of_buckets(T), - ?line NumOfObjs = ets:info(T,kept_objects), + ?line NumOfObjs = get_kept_objects(T), ets:safe_fixtable(T,false), %% Will fail as unfix does not shrink the table: %%?line Mem = ets:info(T,memory), @@ -5169,7 +5181,7 @@ smp_unfix_fix_do() -> Left = NumOfObjs - Deleted, ?line Left = ets:info(T,size), ?line true = ets:info(T,fixed), - ?line Deleted = ets:info(T,kept_objects), + ?line Deleted = get_kept_objects(T), {Child, Mref} = spawn_opt(fun()-> ?line true = ets:info(T,fixed), @@ -5186,7 +5198,7 @@ smp_unfix_fix_do() -> end, Deleted), ?line 0 = ets:info(T,size), - ?line true = ets:info(T,kept_objects) >= Left, + ?line true = get_kept_objects(T) >= Left, ?line done = receive_any() end, [link, monitor, {scheduler,2}]), @@ -5199,7 +5211,7 @@ smp_unfix_fix_do() -> Child ! done, {'DOWN', Mref, process, Child, normal} = receive_any(), ?line false = ets:info(T,fixed), - ?line 0 = ets:info(T,kept_objects), + ?line 0 = get_kept_objects(T), %%verify_table_load(T), ets:delete(T), process_flag(scheduler,0). @@ -5237,7 +5249,7 @@ otp_8166_do(WC) -> ZombieCrPid ! quit, {'DOWN', ZombieCrMref, process, ZombieCrPid, normal} = receive_any(), ?line false = ets:info(T,fixed), - ?line 0 = ets:info(T,kept_objects), + ?line 0 = get_kept_objects(T), %%verify_table_load(T), ets:delete(T), process_flag(scheduler,0). @@ -5304,7 +5316,7 @@ otp_8166_zombie_creator(T,Deleted) -> verify_table_load(T) -> ?line Stats = ets:info(T,stats), - ?line {Buckets,AvgLen,StdDev,ExpSD,_MinLen,_MaxLen} = Stats, + ?line {Buckets,AvgLen,StdDev,ExpSD,_MinLen,_MaxLen,_} = Stats, ?line ok = if AvgLen > 7 -> io:format("Table overloaded: Stats=~p\n~p\n", @@ -5420,7 +5432,39 @@ types_do(Opts) -> ?line verify_etsmem(EtsMem). - +otp_9423(doc) -> ["vm-deadlock caused by race between ets:delete and others on write_concurrency table"]; +otp_9423(Config) when is_list(Config) -> + InitF = fun(_) -> {0,0} end, + ExecF = fun({S,F}) -> + receive + stop -> + io:format("~p got stop\n", [self()]), + [end_of_work | {"Succeded=",S,"Failed=",F}] + after 0 -> + %%io:format("~p (~p) doing lookup\n", [self(), {S,F}]), + try ets:lookup(otp_9423, key) of + [] -> {S+1,F} + catch + error:badarg -> {S,F+1} + end + end + end, + FiniF = fun(R) -> R end, + case run_workers(InitF, ExecF, FiniF, infinite, 1) of + Pids when is_list(Pids) -> + %%[P ! start || P <- Pids], + repeat(fun() -> ets:new(otp_9423, [named_table, public, {write_concurrency,true}]), + ets:delete(otp_9423) + end, 10000), + [P ! stop || P <- Pids], + wait_pids(Pids), + ok; + + Skipped -> Skipped + end. + + + % % Utility functions: @@ -5434,21 +5478,30 @@ add_lists([E1|T1], [E2|T2], Acc) -> add_lists(T1, T2, [E1+E2 | Acc]). run_workers(InitF,ExecF,FiniF,Laps) -> + run_workers(InitF,ExecF,FiniF,Laps, 0). +run_workers(InitF,ExecF,FiniF,Laps, Exclude) -> case erlang:system_info(smp_support) of true -> - run_workers_do(InitF,ExecF,FiniF,Laps); + run_workers_do(InitF,ExecF,FiniF,Laps, Exclude); false -> {skipped,"No smp support"} end. - + run_workers_do(InitF,ExecF,FiniF,Laps) -> - NumOfProcs = erlang:system_info(schedulers), + run_workers_do(InitF,ExecF,FiniF,Laps, 0). +run_workers_do(InitF,ExecF,FiniF,Laps, Exclude) -> + ?line NumOfProcs = case erlang:system_info(schedulers) of + N when (N > Exclude) -> N - Exclude + end, io:format("smp starting ~p workers\n",[NumOfProcs]), Seeds = [{ProcN,random:uniform(9999)} || ProcN <- lists:seq(1,NumOfProcs)], Parent = self(), Pids = [spawn_link(fun()-> worker(Seed,InitF,ExecF,FiniF,Laps,Parent,NumOfProcs) end) || Seed <- Seeds], - wait_pids(Pids). + case Laps of + infinite -> Pids; + _ -> wait_pids(Pids) + end. worker({ProcN,Seed}, InitF, ExecF, FiniF, Laps, Parent, NumOfProcs) -> io:format("smp worker ~p, seed=~p~n",[self(),Seed]), @@ -5463,6 +5516,8 @@ worker_loop(0, _, State) -> State; worker_loop(_, _, [end_of_work|State]) -> State; +worker_loop(infinite, ExecF, State) -> + worker_loop(infinite,ExecF,ExecF(State)); worker_loop(N, ExecF, State) -> worker_loop(N-1,ExecF,ExecF(State)). @@ -5517,20 +5572,21 @@ etsmem() -> case erlang:system_info({allocator,ets_alloc}) of false -> undefined; MemInfo -> - MSBCS = lists:foldl( - fun ({instance, _, L}, Acc) -> - {value,{_,MBCS}} = lists:keysearch(mbcs, 1, L), - {value,{_,SBCS}} = lists:keysearch(sbcs, 1, L), - [MBCS,SBCS | Acc] - end, - [], - MemInfo), + CS = lists:foldl( + fun ({instance, _, L}, Acc) -> + {value,{_,SBMBCS}} = lists:keysearch(sbmbcs, 1, L), + {value,{_,MBCS}} = lists:keysearch(mbcs, 1, L), + {value,{_,SBCS}} = lists:keysearch(sbcs, 1, L), + [SBMBCS,MBCS,SBCS | Acc] + end, + [], + MemInfo), lists:foldl( fun(L, {Bl0,BlSz0}) -> {value,{_,Bl,_,_}} = lists:keysearch(blocks, 1, L), {value,{_,BlSz,_,_}} = lists:keysearch(blocks_size, 1, L), {Bl0+Bl,BlSz0+BlSz} - end, {0,0}, MSBCS) + end, {0,0}, CS) end}, {Mem,AllTabs}. @@ -5872,7 +5928,7 @@ very_big_num(0, Result) -> ?line Result. make_port() -> - ?line open_port({spawn, efile}, [eof]). + ?line open_port({spawn, "efile"}, [eof]). make_pid() -> ?line spawn_link(?MODULE, sleeper, []). diff --git a/lib/stdlib/test/file_sorter_SUITE.erl b/lib/stdlib/test/file_sorter_SUITE.erl index 80d4ea5fdc..74c08912be 100644 --- a/lib/stdlib/test/file_sorter_SUITE.erl +++ b/lib/stdlib/test/file_sorter_SUITE.erl @@ -89,7 +89,7 @@ basic(suite) -> basic(Config) when is_list(Config) -> Fmt = binary, Arg = {format,Fmt}, - Foo = outfile(foo, Config), + Foo = outfile("foo", Config), P0 = pps(), ?line F1s = [F1] = to_files([[]], Fmt, Config), @@ -455,7 +455,7 @@ inout(suite) -> []; inout(Config) when is_list(Config) -> BTF = {format, binary_term}, - Foo = outfile(foo, Config), + Foo = outfile("foo", Config), %% Input is fun. End = fun(read) -> end_of_input end, @@ -522,7 +522,7 @@ many(doc) -> many(suite) -> []; many(Config) when is_list(Config) -> - Foo = outfile(foo, Config), + Foo = outfile("foo", Config), PrivDir = ?privdir(Config), P0 = pps(), @@ -587,7 +587,7 @@ misc(suite) -> []; misc(Config) when is_list(Config) -> BTF = {format, binary_term}, - Foo = outfile(foo, Config), + Foo = outfile("foo", Config), FFoo = filename:absname(Foo), P0 = pps(), @@ -704,7 +704,7 @@ misc(Config) when is_list(Config) -> sort(Fmt, XArgs, Config) -> Args = make_args(Fmt, [{size,5} | XArgs]), TmpArgs = [{tmpdir,?privdir(Config)} | Args], - Foo = outfile(foo, Config), + Foo = outfile("foo", Config), %% Input is a fun. Output is a fun. ?line [] = file_sorter:sort(input([], 2, Fmt), output([], Fmt), Args), @@ -777,7 +777,7 @@ sort(Fmt, XArgs, Config) -> keysort(Fmt, XArgs, Config) -> Args = make_args(Fmt, [{size,50}, {no_files, 2} | XArgs]), TmpArgs = Args ++ [{tmpdir,?privdir(Config)}], - Foo = outfile(foo, Config), + Foo = outfile("foo", Config), %% Input is files. Output is a file. ?line ok = file_sorter:keysort(2, [], Foo, Args), @@ -836,7 +836,7 @@ keysort(Fmt, XArgs, Config) -> merge(Fmt, XArgs, Config) -> Args = make_args(Fmt, [{size,5} | XArgs]), - Foo = outfile(foo, Config), + Foo = outfile("foo", Config), %% Input is a file. Output is a fun. ?line [] = file_sorter:merge([], output([], Fmt), Args), @@ -873,7 +873,7 @@ merge(Fmt, XArgs, Config) -> keymerge(Fmt, XArgs, Config) -> Args = make_args(Fmt, [{size,50}, {no_files, 2} | XArgs]), - Foo = outfile(foo, Config), + Foo = outfile("foo", Config), %% Input is files. Output is a file. ?line ok = file_sorter:keymerge(2, [], Foo, Args), diff --git a/lib/stdlib/test/filelib_SUITE.erl b/lib/stdlib/test/filelib_SUITE.erl index a355097fe2..3010f5e760 100644 --- a/lib/stdlib/test/filelib_SUITE.erl +++ b/lib/stdlib/test/filelib_SUITE.erl @@ -243,7 +243,7 @@ otp_5960(doc) -> ["Test that filelib:ensure_dir/1 returns ok or {error,Reason}"]; otp_5960(Config) when is_list(Config) -> ?line PrivDir = ?config(priv_dir, Config), - ?line Dir = filename:join(PrivDir, otp_5960_dir), + ?line Dir = filename:join(PrivDir, "otp_5960_dir"), ?line Name1 = filename:join(Dir, name1), ?line Name2 = filename:join(Dir, name2), ?line ok = filelib:ensure_dir(Name1), % parent is created @@ -268,7 +268,7 @@ otp_5960(Config) when is_list(Config) -> ensure_dir_eexist(Config) when is_list(Config) -> ?line PrivDir = ?config(priv_dir, Config), - ?line Dir = filename:join(PrivDir, ensure_dir_eexist), + ?line Dir = filename:join(PrivDir, "ensure_dir_eexist"), ?line Name = filename:join(Dir, "same_name_as_file_and_dir"), ?line ok = filelib:ensure_dir(Name), ?line ok = file:write_file(Name, <<"some string\n">>), diff --git a/lib/stdlib/test/io_SUITE.erl b/lib/stdlib/test/io_SUITE.erl index 54a98985cd..bb02a879c2 100644 --- a/lib/stdlib/test/io_SUITE.erl +++ b/lib/stdlib/test/io_SUITE.erl @@ -27,7 +27,7 @@ otp_6282/1, otp_6354/1, otp_6495/1, otp_6517/1, otp_6502/1, manpage/1, otp_6708/1, otp_7084/1, otp_7421/1, io_lib_collect_line_3_wb/1, cr_whitespace_in_string/1, - io_fread_newlines/1, otp_8989/1]). + io_fread_newlines/1, otp_8989/1, io_lib_fread_literal/1]). %-define(debug, true). @@ -62,7 +62,7 @@ all() -> otp_6282, otp_6354, otp_6495, otp_6517, otp_6502, manpage, otp_6708, otp_7084, otp_7421, io_lib_collect_line_3_wb, cr_whitespace_in_string, - io_fread_newlines, otp_8989]. + io_fread_newlines, otp_8989, io_lib_fread_literal]. groups() -> []. @@ -1995,3 +1995,29 @@ otp_8989(Suite) when is_list(Suite) -> ?line "Hel " = fmt("~-4.*s", [3,Hello]), ?line "Hel " = fmt("~*.*s", [-4,3,Hello]), ok. + +io_lib_fread_literal(doc) -> + "OTP-9439 io_lib:fread bug for literate at end"; +io_lib_fread_literal(Suite) when is_list(Suite) -> + ?line {more,"~d",0,""} = io_lib:fread("~d", ""), + ?line {error,{fread,integer}} = io_lib:fread("~d", " "), + ?line {more,"~d",1,""} = io_lib:fread(" ~d", " "), + ?line {ok,[17],"X"} = io_lib:fread(" ~d", " 17X"), + %% + ?line {more,"d",0,""} = io_lib:fread("d", ""), + ?line {error,{fread,input}} = io_lib:fread("d", " "), + ?line {more,"d",1,""} = io_lib:fread(" d", " "), + ?line {ok,[],"X"} = io_lib:fread(" d", " dX"), + %% + ?line {done,eof,_} = io_lib:fread([], eof, "~d"), + ?line {done,eof,_} = io_lib:fread([], eof, " ~d"), + ?line {more,C1} = io_lib:fread([], " \n", " ~d"), + ?line {done,{error,{fread,input}},_} = io_lib:fread(C1, eof, " ~d"), + ?line {done,{ok,[18]},""} = io_lib:fread(C1, "18\n", " ~d"), + %% + ?line {done,eof,_} = io_lib:fread([], eof, "d"), + ?line {done,eof,_} = io_lib:fread([], eof, " d"), + ?line {more,C2} = io_lib:fread([], " \n", " d"), + ?line {done,{error,{fread,input}},_} = io_lib:fread(C2, eof, " d"), + ?line {done,{ok,[]},[]} = io_lib:fread(C2, "d\n", " d"), + ok. diff --git a/lib/stdlib/test/string_SUITE.erl b/lib/stdlib/test/string_SUITE.erl index 1dcd4be21e..6969c095a0 100644 --- a/lib/stdlib/test/string_SUITE.erl +++ b/lib/stdlib/test/string_SUITE.erl @@ -273,9 +273,9 @@ words(Config) when is_list(Config) -> ?line 2 = string:words("2.35", $.), ?line 100 = string:words(string:copies(". ", 100)), %% invalid arg type - ?line {'EXIT',_} = (catch string:chars(hej)), + ?line {'EXIT',_} = (catch string:chars(hej, 1)), %% invalid arg type - ?line {'EXIT',_} = (catch string:chars("hej", " ")), + ?line {'EXIT',_} = (catch string:chars("hej", 1, " ")), ok. diff --git a/lib/stdlib/test/supervisor_SUITE.erl b/lib/stdlib/test/supervisor_SUITE.erl index c79a5002fb..b48450c151 100644 --- a/lib/stdlib/test/supervisor_SUITE.erl +++ b/lib/stdlib/test/supervisor_SUITE.erl @@ -42,7 +42,7 @@ -export([ permanent_normal/1, transient_normal/1, temporary_normal/1, permanent_abnormal/1, transient_abnormal/1, - temporary_abnormal/1]). + temporary_abnormal/1, temporary_bystander/1]). %% Restart strategy tests -export([ one_for_one/1, @@ -74,7 +74,7 @@ all() -> {group, abnormal_termination}, child_unlink, tree, count_children_memory, do_not_save_start_parameters_for_temporary_children, do_not_save_child_specs_for_temporary_children, - simple_one_for_one_scale_many_temporary_children]. + simple_one_for_one_scale_many_temporary_children, temporary_bystander]. groups() -> [{sup_start, [], @@ -114,10 +114,9 @@ end_per_group(_GroupName, Config) -> Config. init_per_testcase(count_children_memory, Config) -> - MemoryState = erlang:system_info(allocator), - case count_children_allocator_test(MemoryState) of - true -> Config; - false -> + try erlang:memory() of + _ -> Config + catch error:notsup -> {skip, "+Meamin used during test; erlang:memory/1 not available"} end; init_per_testcase(_Case, Config) -> @@ -608,6 +607,37 @@ temporary_abnormal(Config) when is_list(Config) -> [0,0,0,0] = get_child_counts(sup_test). %%------------------------------------------------------------------------- +temporary_bystander(doc) -> + ["A temporary process killed as part of a rest_for_one or one_for_all " + "restart strategy should not be restarted given its args are not " + " saved. Otherwise the supervisor hits its limit and crashes."]; +temporary_bystander(suite) -> []; +temporary_bystander(_Config) -> + Child1 = {child1, {supervisor_1, start_child, []}, permanent, 100, + worker, []}, + Child2 = {child2, {supervisor_1, start_child, []}, temporary, 100, + worker, []}, + {ok, SupPid1} = supervisor:start_link(?MODULE, {ok, {{one_for_all, 2, 300}, []}}), + {ok, SupPid2} = supervisor:start_link(?MODULE, {ok, {{rest_for_one, 2, 300}, []}}), + unlink(SupPid1), % otherwise we crash with it + unlink(SupPid2), % otherwise we crash with it + {ok, CPid1} = supervisor:start_child(SupPid1, Child1), + {ok, _CPid2} = supervisor:start_child(SupPid1, Child2), + {ok, CPid3} = supervisor:start_child(SupPid2, Child1), + {ok, _CPid4} = supervisor:start_child(SupPid2, Child2), + terminate(SupPid1, CPid1, child1, normal), + terminate(SupPid2, CPid3, child1, normal), + timer:sleep(350), + catch link(SupPid1), + catch link(SupPid2), + %% The supervisor would die attempting to restart child2 + true = erlang:is_process_alive(SupPid1), + true = erlang:is_process_alive(SupPid2), + %% Child2 has not been restarted + [{child1, _, _, _}] = supervisor:which_children(SupPid1), + [{child1, _, _, _}] = supervisor:which_children(SupPid2). + +%%------------------------------------------------------------------------- one_for_one(doc) -> ["Test the one_for_one base case."]; one_for_one(suite) -> []; @@ -1032,17 +1062,6 @@ count_children_memory(Config) when is_list(Config) -> [terminate(SupPid, Pid, child, kill) || {undefined, Pid, worker, _Modules} <- Children3], [1,0,0,0] = get_child_counts(sup_test). -count_children_allocator_test(MemoryState) -> - Allocators = [temp_alloc, eheap_alloc, binary_alloc, ets_alloc, - driver_alloc, sl_alloc, ll_alloc, fix_alloc, std_alloc, - sys_alloc], - MemoryStateList = element(4, MemoryState), - AllocTypes = [lists:keyfind(Alloc, 1, MemoryStateList) - || Alloc <- Allocators], - AllocStates = [lists:keyfind(e, 1, AllocValue) - || {_Type, AllocValue} <- AllocTypes], - lists:all(fun(State) -> State == {e, true} end, AllocStates). - %%------------------------------------------------------------------------- do_not_save_start_parameters_for_temporary_children(doc) -> ["Temporary children shall not be restarted so they should not " diff --git a/lib/stdlib/test/supervisor_bridge_SUITE.erl b/lib/stdlib/test/supervisor_bridge_SUITE.erl index f2dbad0b3b..c4d696564d 100644 --- a/lib/stdlib/test/supervisor_bridge_SUITE.erl +++ b/lib/stdlib/test/supervisor_bridge_SUITE.erl @@ -158,7 +158,7 @@ internal_loop(State) -> terminate(Reason,{Parent,Worker}) -> %% This func knows about supervisor_bridge io:format("Terminating bridge...\n"), - exit(kill,Worker), + exit(Worker,kill), Parent ! {dying,Reason}, anything. diff --git a/lib/stdlib/test/sys_SUITE.erl b/lib/stdlib/test/sys_SUITE.erl index 72b089aa3f..fe039e8bcc 100644 --- a/lib/stdlib/test/sys_SUITE.erl +++ b/lib/stdlib/test/sys_SUITE.erl @@ -71,7 +71,7 @@ log_to_file(Config) when is_list(Config) -> ?line ok = sys:log_to_file(?server,TempName), ?line {ok,-44} = public_call(44), ?line ok = sys:log_to_file(?server,false), - ?line {ok,Fd} = file:open(TempName,read), + ?line {ok,Fd} = file:open(TempName,[read]), ?line Msg1 = io:get_line(Fd,''), ?line Msg2 = io:get_line(Fd,''), ?line file:close(Fd), diff --git a/lib/stdlib/test/tar_SUITE.erl b/lib/stdlib/test/tar_SUITE.erl index e32704ca65..48f58cd05d 100644 --- a/lib/stdlib/test/tar_SUITE.erl +++ b/lib/stdlib/test/tar_SUITE.erl @@ -65,7 +65,7 @@ borderline(Config) when is_list(Config) -> ?line {ok, Cwd} = file:get_cwd(), ?line RootDir = ?config(priv_dir, Config), - ?line TempDir = remove_prefix(Cwd++"/", filename:join(RootDir, borderline)), + ?line TempDir = remove_prefix(Cwd++"/", filename:join(RootDir, "borderline")), ?line ok = file:make_dir(TempDir), ?line Record = 512, @@ -323,12 +323,12 @@ create_long_names(doc) -> create_long_names(Config) when is_list(Config) -> ?line PrivDir = ?config(priv_dir, Config), ?line ok = file:set_cwd(PrivDir), - Dirs = [aslfjkshjkhliuf, - asdhjfehnbfsky, - sahajfskdfhsz, - asldfkdlfy4y8rchg, - f7nafhjgffagkhsfkhsjk, - dfjasldkfjsdkfjashbv], + Dirs = ["aslfjkshjkhliuf", + "asdhjfehnbfsky", + "sahajfskdfhsz", + "asldfkdlfy4y8rchg", + "f7nafhjgffagkhsfkhsjk", + "dfjasldkfjsdkfjashbv"], ?line DeepDir = make_dirs(Dirs, []), ?line AFile = filename:join(DeepDir, "a_file"), @@ -487,7 +487,7 @@ extract_from_binary_compressed(Config) when is_list(Config) -> %% Trying extracting from a binary. ?line ok = erl_tar:extract({binary,Bin}, [compressed,{cwd,ExtractDir}]), - ?line {ok,List} = file:list_dir(filename:join(ExtractDir, ddll_SUITE_data)), + ?line {ok,List} = file:list_dir(filename:join(ExtractDir, "ddll_SUITE_data")), ?line io:format("~p\n", [List]), ?line 19 = length(List), @@ -676,7 +676,7 @@ cooked_compressed(Config) when is_list(Config) -> end, List), %% Clean up. - ?line delete_files([filename:join(PrivDir, ddll_SUITE_data)]), + ?line delete_files([filename:join(PrivDir, "ddll_SUITE_data")]), ok. memory(doc) -> diff --git a/lib/stdlib/test/zip_SUITE.erl b/lib/stdlib/test/zip_SUITE.erl index d5f2cd52d4..7233c061ef 100644 --- a/lib/stdlib/test/zip_SUITE.erl +++ b/lib/stdlib/test/zip_SUITE.erl @@ -375,7 +375,8 @@ zip_options(Config) when is_list(Config) -> ok = file:set_cwd(?config(data_dir, Config)), %% Create a zip archive - {ok, Zip} = zip:zip("filename_not_used.zip", Names, [memory, {cwd, PrivDir}]), + {ok, {_,Zip}} = + zip:zip("filename_not_used.zip", Names, [memory, {cwd, PrivDir}]), %% Open archive {ok, ZipSrv} = zip:zip_open(Zip, [memory]), diff --git a/lib/stdlib/vsn.mk b/lib/stdlib/vsn.mk index c0956030cf..9d4ed17774 100644 --- a/lib/stdlib/vsn.mk +++ b/lib/stdlib/vsn.mk @@ -1 +1 @@ -STDLIB_VSN = 1.17.4 +STDLIB_VSN = 1.17.5 diff --git a/lib/test_server/src/ts_install_cth.erl b/lib/test_server/src/ts_install_cth.erl index c5444a342f..a41916fd0a 100644 --- a/lib/test_server/src/ts_install_cth.erl +++ b/lib/test_server/src/ts_install_cth.erl @@ -49,8 +49,7 @@ -include_lib("kernel/include/file.hrl"). --type proplist() :: list({atom(),term()}). --type config() :: proplist(). +-type config() :: proplists:proplist(). -type reason() :: term(). -type skip_or_fail() :: {skip, reason()} | {auto_skip, reason()} | @@ -65,19 +64,19 @@ id(_Opts) -> ?MODULE. %% @doc Always called before any other callback function. --spec init(Id :: term(), Opts :: proplist()) -> - State :: #state{}. +-spec init(Id :: term(), Opts :: proplists:proplist()) -> + {ok, State :: #state{}}. init(_Id, Opts) -> Nodenames = proplists:get_value(nodenames, Opts, 0), Nodes = proplists:get_value(nodes, Opts, 0), TSConfDir = proplists:get_value(ts_conf_dir, Opts), TargetSystem = proplists:get_value(target_system, Opts, install_local), InstallOpts = proplists:get_value(install_opts, Opts, []), - #state{ nodenames = Nodenames, - nodes = Nodes, - ts_conf_dir = TSConfDir, - target_system = TargetSystem, - install_opts = InstallOpts }. + {ok, #state{ nodenames = Nodenames, + nodes = Nodes, + ts_conf_dir = TSConfDir, + target_system = TargetSystem, + install_opts = InstallOpts } }. %% @doc Called before init_per_suite is called. -spec pre_init_per_suite(Suite :: atom(), diff --git a/lib/test_server/test/Makefile b/lib/test_server/test/Makefile index ab72a9d579..198440bb17 100644 --- a/lib/test_server/test/Makefile +++ b/lib/test_server/test/Makefile @@ -85,7 +85,7 @@ release_spec: opt release_tests_spec: make_emakefile $(INSTALL_DIR) $(RELSYSDIR) $(INSTALL_DATA) $(EMAKEFILE) $(ERL_FILES) $(COVERFILE) $(RELSYSDIR) - $(INSTALL_DATA) test_server.spec test_server.cover $(RELSYSDIR) + $(INSTALL_DATA) test_server_test_lib.hrl test_server.spec test_server.cover $(RELSYSDIR) chmod -R u+w $(RELSYSDIR) @tar cf - *_SUITE_data | (cd $(RELSYSDIR); tar xf -) diff --git a/lib/tools/doc/src/xref.xml b/lib/tools/doc/src/xref.xml index 75ffa25311..17de66bb22 100644 --- a/lib/tools/doc/src/xref.xml +++ b/lib/tools/doc/src/xref.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>2000</year><year>2010</year> + <year>2000</year><year>2011</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -1465,8 +1465,8 @@ Evaluates a predefined analysis. <name>start(NameOrOptions) -> Return</name> <fsummary>Create an Xref server.</fsummary> <type> - <v>Name = atom()()</v> - <v>XrefOrOptions = Xref | Options</v> + <v>NameOrOptions = Name | Options</v> + <v>Name = atom()</v> <v>Options = [Option] | Option</v> <v>Option = {xref_mode, mode()} | term()</v> <v>Return = {ok, pid()} | {error, {already_started, pid()}}</v> @@ -1483,7 +1483,7 @@ Evaluates a predefined analysis. <name>start(Name, Options) -> Return</name> <fsummary>Create an Xref server.</fsummary> <type> - <v>Name = atom()()</v> + <v>Name = atom()</v> <v>Options = [Option] | Option</v> <v>Option = {xref_mode, mode()} | term()</v> <v>Return = {ok, pid()} | {error, {already_started, pid()}}</v> diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el index 6728bef2a4..a8dd3ec3ac 100644 --- a/lib/tools/emacs/erlang.el +++ b/lib/tools/emacs/erlang.el @@ -523,6 +523,32 @@ This is an elisp list of options. Each option can be either: - a string Example: '(bin_opt_info (i . \"/path1/include\") (i . \"/path2/include\"))") +(defvar erlang-compile-command-function-alist + '((".erl\\'" . inferior-erlang-compute-erl-compile-command) + (".xrl\\'" . inferior-erlang-compute-leex-compile-command) + (".yrl\\'" . inferior-erlang-compute-yecc-compile-command) + ("." . inferior-erlang-compute-erl-compile-command)) + "*Alist of filename patterns vs corresponding compilation functions. +Each element looks like (REGEXP . FUNCTION). Compiling a file whose name +matches REGEXP specifies FUNCTION to use to compute the compilation +command. The FUNCTION will be called with two arguments: module name and +default compilation options, like output directory. The FUNCTION +is expected to return a string.") + +(defvar erlang-leex-compile-opts '() + "*Options to pass to leex when compiling xrl files. +This is an elisp list of options. Each option can be either: +- an atom +- a dotted pair +- a string") + +(defvar erlang-yecc-compile-opts '() + "*Options to pass to yecc when compiling yrl files. +This is an elisp list of options. Each option can be either: +- an atom +- a dotted pair +- a string") + (eval-and-compile (defvar erlang-regexp-modern-p (if (> erlang-emacs-major-version 21) t nil) @@ -5276,6 +5302,22 @@ unless the optional NO-DISPLAY is non-nil." (file-name-as-directory buffer-dir)))) (defun inferior-erlang-compute-compile-command (module-name opts) + (let ((ccfn erlang-compile-command-function-alist) + (res (inferior-erlang-compute-erl-compile-command module-name opts)) + ccfn-entry + done) + (if (not (null (buffer-file-name))) + (while (and (not done) (not (null ccfn))) + (setq ccfn-entry (car ccfn)) + (setq ccfn (cdr ccfn)) + (if (string-match (car ccfn-entry) (buffer-file-name)) + (let ((c-fn (cdr ccfn-entry))) + (setq done t) + (if (not (null c-fn)) + (setq result (funcall c-fn module-name opts))))))) + result)) + +(defun inferior-erlang-compute-erl-compile-command (module-name opts) (let* ((out-dir-opt (assoc 'outdir opts)) (out-dir (cdr out-dir-opt))) (if erlang-compile-use-outdir @@ -5299,6 +5341,48 @@ unless the optional NO-DISPLAY is non-nil." (remq out-dir-opt opts)) tmpvar tmpvar tmpvar2))))) +(defun inferior-erlang-compute-leex-compile-command (module-name opts) + (let ((file-name (buffer-file-name)) + (erl-compile-expr (inferior-erlang-remove-any-trailing-dot + (inferior-erlang-compute-erl-compile-command + module-name opts)))) + (format (concat "f(LErr1__), f(LErr2__), " + "case case leex:file(\"%s\", [%s]) of" + " ok -> ok;" + " {ok,_} -> ok;" + " {ok,_,_} -> ok;" + " LErr1__ -> LErr1__ " + "end of" + " ok -> %s;" + " LErr2__ -> LErr2__ " + "end.") + file-name + (inferior-erlang-format-comma-opts erlang-leex-compile-opts) + erl-compile-expr))) + +(defun inferior-erlang-compute-yecc-compile-command (module-name opts) + (let ((file-name (buffer-file-name)) + (erl-compile-expr (inferior-erlang-remove-any-trailing-dot + (inferior-erlang-compute-erl-compile-command + module-name opts)))) + (format (concat "f(YErr1__), f(YErr2__), " + "case case yecc:file(\"%s\", [%s]) of" + " {ok,_} -> ok;" + " {ok,_,_} -> ok;" + " YErr1__ -> YErr1__ " + "end of" + " ok -> %s;" + " YErr2__ -> YErr2__ " + "end.") + file-name + (inferior-erlang-format-comma-opts erlang-yecc-compile-opts) + erl-compile-expr))) + +(defun inferior-erlang-remove-any-trailing-dot (str) + (if (string= (substring str -1) ".") + (substring str 0 (1- (length str))) + str)) + (defun inferior-erlang-format-comma-opts (opts) (if (null opts) "" diff --git a/lib/webtool/priv/Makefile b/lib/webtool/priv/Makefile index 56ab772c45..6e1c6606fe 100644 --- a/lib/webtool/priv/Makefile +++ b/lib/webtool/priv/Makefile @@ -39,8 +39,12 @@ HTDOCS_FILES = root/doc/index.html \ root/doc/tool_management.html \ root/doc/start_info.html -SCRIPTS = bin/start_webtool \ - bin/start_webtool.bat +ifeq ($(findstring win32,$(TARGET)),win32) +WIN32_SCRIPTS= bin/start_webtool.bat +else +WIN32_SCRIPTS= +endif +SCRIPTS = bin/start_webtool $(WIN32_SCRIPTS) # ---------------------------------------------------- # FLAGS diff --git a/lib/wx/test/wxt.erl b/lib/wx/test/wxt.erl index 1f5b1cc3b1..2f52c58f26 100644 --- a/lib/wx/test/wxt.erl +++ b/lib/wx/test/wxt.erl @@ -72,7 +72,7 @@ resolve({Suite0, Case}) when is_atom(Suite0), is_atom(Case) -> {Suite, Case2} -> {Suite, Case2} end; -resolve(List) when list(List) -> +resolve(List) when is_list(List) -> [resolve(Case) || Case <- List]. alias(Suite) when is_atom(Suite) -> @@ -104,7 +104,7 @@ read_config() -> end. %% Write new default config file -write_config(Config) when list(Config) -> +write_config(Config) when is_list(Config) -> Fname = config_fname(), {ok, Fd} = file:open(Fname, write), write_list(Fd, Config), diff --git a/lib/xmerl/include/xmerl_xsd.hrl b/lib/xmerl/include/xmerl_xsd.hrl index b527accc8c..6dad7d8ff0 100644 --- a/lib/xmerl/include/xmerl_xsd.hrl +++ b/lib/xmerl/include/xmerl_xsd.hrl @@ -36,6 +36,7 @@ schema_name, vsn, schema_preprocessed=false, + external_xsd_base=false, xsd_base, xml_options=[], scope=[], diff --git a/lib/xmerl/src/xmerl_scan.erl b/lib/xmerl/src/xmerl_scan.erl index 059c8f21b6..e598c5f56d 100644 --- a/lib/xmerl/src/xmerl_scan.erl +++ b/lib/xmerl/src/xmerl_scan.erl @@ -2276,7 +2276,7 @@ scan_att_chars([H|T], S0, H, Acc, TmpAcc,AttType,IsNorm) -> % End quote true -> normalize(Acc,S,IsNorm) end, - {lists:reverse(Acc2), T, S2,IsNorm2}; + {lists:flatten(lists:reverse(Acc2)), T, S2,IsNorm2}; scan_att_chars("&" ++ T, S0, Delim, Acc, TmpAcc,AT,IsNorm) -> % Reference ?bump_col(1), {ExpRef, T1, S1} = scan_reference(T, S), diff --git a/lib/xmerl/src/xmerl_xsd.erl b/lib/xmerl/src/xmerl_xsd.erl index e56f1470c0..f003cc74ba 100644 --- a/lib/xmerl/src/xmerl_xsd.erl +++ b/lib/xmerl/src/xmerl_xsd.erl @@ -287,10 +287,19 @@ process_schema(Schema) -> %% error reason. The error reason may be a list of several errors %% or a single error encountered during the processing. process_schema(Schema,Options) when is_list(Options) -> - S = initiate_state(Options,Schema), - process_schema2(xmerl_scan:file(filename:join(S#xsd_state.xsd_base, Schema)),S,Schema); -process_schema(Schema,State) when is_record(State,xsd_state) -> - process_schema2(xmerl_scan:file(filename:join(State#xsd_state.xsd_base, Schema)),State,Schema). + State = initiate_state(Options,Schema), + process_schema(Schema, State); +process_schema(Schema, State=#xsd_state{fetch_fun=Fetch})-> + case Fetch(Schema, State) of + {ok,{file,File},_} -> + process_schema2(xmerl_scan:file(File), State, Schema); + {ok,{string,Str},_} -> + process_schema2(xmerl_scan:string(Str), State, Schema); + {ok,[],_} -> + {error,enoent}; + Err -> + Err + end. process_schema2(Err={error,_},_,_) -> Err; @@ -319,12 +328,9 @@ process_schemas(Schemas) -> %% error reason. The error reason may be a list of several errors %% or a single error encountered during the processing. process_schemas(Schemas=[{_,Schema}|_],Options) when is_list(Options) -> - process_schemas(Schemas,initiate_state(Options,Schema)); + State = initiate_state(Options,Schema), + process_schemas(Schemas, State); process_schemas([{_NS,Schema}|Rest],State=#xsd_state{fetch_fun=Fetch}) -> -%% case process_external_schema_once(Schema,if_list_to_atom(NS),State) of -%% S when is_record(S,xsd_state) -> -%% case process_schema(filename:join([State#xsd_state.xsd_base,Schema]),State) of -%% {ok,S} -> Res= case Fetch(Schema,State) of {ok,{file,File},_} -> @@ -345,20 +351,20 @@ process_schemas([{_NS,Schema}|Rest],State=#xsd_state{fetch_fun=Fetch}) -> process_schemas([],S) when is_record(S,xsd_state) -> {ok,S}. - initiate_state(Opts,Schema) -> XSDBase = filename:dirname(Schema), {{state,S},RestOpts}=new_state(Opts), S2 = create_tables(S), - initiate_state2(S2#xsd_state{schema_name = Schema, - xsd_base = XSDBase, - fetch_fun = fun fetch/2},RestOpts). + S3 = initiate_state2(S2#xsd_state{schema_name = Schema, xsd_base=XSDBase, + fetch_fun = fun fetch/2}, + RestOpts). + initiate_state2(S,[]) -> S; initiate_state2(S,[{tab2file,Bool}|T]) -> initiate_state2(S#xsd_state{tab2file=Bool},T); -initiate_state2(S,[{xsdbase,XSDBase}|T]) -> - initiate_state2(S#xsd_state{xsd_base=XSDBase},T); +initiate_state2(S,[{xsdbase, XSDBase}|T]) -> + initiate_state2(S#xsd_state{xsd_base=XSDBase, external_xsd_base=true},T); initiate_state2(S,[{fetch_fun,FetchFun}|T]) -> initiate_state2(S#xsd_state{fetch_fun=FetchFun},T); initiate_state2(S,[{fetch_path,FetchPath}|T]) -> @@ -5232,7 +5238,12 @@ fetch(URI,S) -> [] -> %% empty systemliteral []; _ -> - filename:join(S#xsd_state.xsd_base, URI) + case S#xsd_state.external_xsd_base of + true -> + filename:join(S#xsd_state.xsd_base, URI); + false -> + filename:join(S#xsd_state.xsd_base, filename:basename(URI)) + end end, Path = path_locate(S#xsd_state.fetch_path, Filename, Fullname), ?dbg("fetch(~p) -> {file, ~p}.~n", [URI, Path]), diff --git a/lib/xmerl/test/Makefile b/lib/xmerl/test/Makefile index 9715aa054a..5a2a585841 100644 --- a/lib/xmerl/test/Makefile +++ b/lib/xmerl/test/Makefile @@ -124,4 +124,4 @@ release_tests_spec: opt @tar cfh - xmerl_xsd_MS2002-01-16_SUITE_data | (cd $(RELSYSDIR); tar xf -) @tar cfh - xmerl_xsd_NIST2002-01-16_SUITE_data | (cd $(RELSYSDIR); tar xf -) @tar cfh - xmerl_xsd_Sun2002-01-16_SUITE_data | (cd $(RELSYSDIR); tar xf -) - chmod -f -R u+w $(RELSYSDIR) + chmod -R u+w $(RELSYSDIR) diff --git a/lib/xmerl/test/xmerl_SUITE.erl b/lib/xmerl/test/xmerl_SUITE.erl index 392b2522e8..0c809dbcb6 100644 --- a/lib/xmerl/test/xmerl_SUITE.erl +++ b/lib/xmerl/test/xmerl_SUITE.erl @@ -57,7 +57,8 @@ groups() -> {eventp_tests, [], [sax_parse_and_export]}, {ticket_tests, [], [ticket_5998, ticket_7211, ticket_7214, ticket_7430, - ticket_6873, ticket_7496, ticket_8156, ticket_8697]}, + ticket_6873, ticket_7496, ticket_8156, ticket_8697, + ticket_9411]}, {app_test, [], [{xmerl_app_test, all}]}, {appup_test, [], [{xmerl_appup_test, all}]}]. @@ -575,7 +576,17 @@ ticket_8697(Config) -> ?line [16#545C] = HexEntityText, ok. +ticket_9411(suite) -> []; +ticket_9411(doc) -> + ["Test that xmerl_scan handles attribute that contains for example ""]; +ticket_9411(Config) -> + DataDir = ?config(data_dir,Config), + ?line {ok, Schema} = xmerl_xsd:process_schema(filename:join([DataDir,"misc/ticket_9411.xsd"])), + ?line {ok, Bin} = file:read_file(filename:join([DataDir,"misc/ticket_9411.xml"])), + ?line Xml = erlang:binary_to_list(Bin), + ?line {E, _} = xmerl_scan:string(Xml), + ?line {E, _} = xmerl_xsd:validate(E, Schema). diff --git a/lib/xmerl/test/xmerl_SUITE_data/misc.tar.gz b/lib/xmerl/test/xmerl_SUITE_data/misc.tar.gz Binary files differindex c48a6f897b..fef7431845 100644 --- a/lib/xmerl/test/xmerl_SUITE_data/misc.tar.gz +++ b/lib/xmerl/test/xmerl_SUITE_data/misc.tar.gz diff --git a/lib/xmerl/test/xmerl_xsd_SUITE.erl b/lib/xmerl/test/xmerl_xsd_SUITE.erl index a0d3b1e667..421fa48054 100644 --- a/lib/xmerl/test/xmerl_xsd_SUITE.erl +++ b/lib/xmerl/test/xmerl_xsd_SUITE.erl @@ -62,7 +62,7 @@ groups() -> sis2, state2file_file2state, union]}, {ticket_tests, [], [ticket_6910, ticket_7165, ticket_7190, ticket_7288, - ticket_7736, ticket_8599]}, + ticket_7736, ticket_8599, ticket_9410]}, {facets, [], [length, minLength, maxLength, pattern, enumeration, whiteSpace, maxInclusive, maxExclusive, minExclusive, @@ -1146,3 +1146,8 @@ ticket_8599(Config) -> ?line {{xmlElement,persons,persons,_,_,_,_,_,_,_,_,_},_GlobalState} = xmerl_xsd:validate(E, S). + +ticket_9410(suite) -> []; +ticket_9410(Config) -> + file:set_cwd(filename:join([?config(data_dir,Config),".."])), + ?line {ok, _S} = xmerl_xsd:process_schema("xmerl_xsd_SUITE_data/small.xsd"). diff --git a/make/otp.mk.in b/make/otp.mk.in index a4e9dad46f..1ba74a3048 100644 --- a/make/otp.mk.in +++ b/make/otp.mk.in @@ -239,7 +239,9 @@ FOP = @FOP@ DOCGEN=$(ERL_TOP)/lib/erl_docgen +ifneq (,$(findstring $(origin SPECS_ESRC),$(DUBIOUS_ORIGINS))) SPECS_ESRC = ../../src +endif SPECS_EXTRACTOR=$(DOCGEN)/priv/bin/specs_gen.escript # Extract specifications and types from Erlang source files (-spec, -type) $(SPECDIR)/specs_%.xml: $(SPECS_ESRC)/%.erl diff --git a/system/doc/reference_manual/distributed.xml b/system/doc/reference_manual/distributed.xml index 52222c6d9d..9c8e88250c 100644 --- a/system/doc/reference_manual/distributed.xml +++ b/system/doc/reference_manual/distributed.xml @@ -78,7 +78,7 @@ dilbert@uab</pre> using the command line flag <c>-connect_all false</c>, see <c>erl(1)</c>.</p> <p>If a node goes down, all connections to that node are removed. - Calling <c>erlang:disconnect(Node)</c> will force disconnection + Calling <c>erlang:disconnect_node(Node)</c> will force disconnection of a node.</p> <p>The list of (visible) nodes currently connected to is returned by <c>nodes()</c>.</p> |