diff options
245 files changed, 7802 insertions, 1711 deletions
diff --git a/HOWTO/INSTALL.md b/HOWTO/INSTALL.md index 702c949297..533960ef99 100644 --- a/HOWTO/INSTALL.md +++ b/HOWTO/INSTALL.md @@ -332,7 +332,7 @@ Erlang/OTP system which you can try by typing `bin/erl`. This should start up Erlang/OTP and give you a prompt: $ bin/erl - Erlang %OTP-REL% (erts-%ERTS-VSN%) [source] [smp:4:4] [rq:4] [async-threads:0] [kernel-poll:false] + Erlang/OTP %OTP-REL% [erts-%ERTS-VSN%] [source] [smp:4:4] [async-threads:0] [kernel-poll:false] Eshell V%ERTS-VSN% (abort with ^G) 1> _ diff --git a/bootstrap/bin/start.boot b/bootstrap/bin/start.boot Binary files differindex 6f7fb5d7ca..f5800105d3 100644 --- a/bootstrap/bin/start.boot +++ b/bootstrap/bin/start.boot diff --git a/bootstrap/bin/start_clean.boot b/bootstrap/bin/start_clean.boot Binary files differindex 6f7fb5d7ca..f5800105d3 100644 --- a/bootstrap/bin/start_clean.boot +++ b/bootstrap/bin/start_clean.boot diff --git a/bootstrap/lib/compiler/ebin/beam_a.beam b/bootstrap/lib/compiler/ebin/beam_a.beam Binary files differindex a4965abd48..459db28f43 100644 --- a/bootstrap/lib/compiler/ebin/beam_a.beam +++ b/bootstrap/lib/compiler/ebin/beam_a.beam diff --git a/bootstrap/lib/compiler/ebin/beam_block.beam b/bootstrap/lib/compiler/ebin/beam_block.beam Binary files differindex 6513a0f33b..c161220c93 100644 --- a/bootstrap/lib/compiler/ebin/beam_block.beam +++ b/bootstrap/lib/compiler/ebin/beam_block.beam diff --git a/bootstrap/lib/compiler/ebin/beam_clean.beam b/bootstrap/lib/compiler/ebin/beam_clean.beam Binary files differindex abe390267e..f6e3059e86 100644 --- a/bootstrap/lib/compiler/ebin/beam_clean.beam +++ b/bootstrap/lib/compiler/ebin/beam_clean.beam diff --git a/bootstrap/lib/compiler/ebin/beam_disasm.beam b/bootstrap/lib/compiler/ebin/beam_disasm.beam Binary files differindex eba17a7bbd..c19e467785 100644 --- a/bootstrap/lib/compiler/ebin/beam_disasm.beam +++ b/bootstrap/lib/compiler/ebin/beam_disasm.beam diff --git a/bootstrap/lib/compiler/ebin/beam_except.beam b/bootstrap/lib/compiler/ebin/beam_except.beam Binary files differindex 5a23c95f54..0de15769c4 100644 --- a/bootstrap/lib/compiler/ebin/beam_except.beam +++ b/bootstrap/lib/compiler/ebin/beam_except.beam diff --git a/bootstrap/lib/compiler/ebin/beam_flatten.beam b/bootstrap/lib/compiler/ebin/beam_flatten.beam Binary files differindex f0a3dfac91..bf2d341c05 100644 --- a/bootstrap/lib/compiler/ebin/beam_flatten.beam +++ b/bootstrap/lib/compiler/ebin/beam_flatten.beam diff --git a/bootstrap/lib/compiler/ebin/beam_jump.beam b/bootstrap/lib/compiler/ebin/beam_jump.beam Binary files differindex 5c0f4a9996..75c02f082f 100644 --- a/bootstrap/lib/compiler/ebin/beam_jump.beam +++ b/bootstrap/lib/compiler/ebin/beam_jump.beam diff --git a/bootstrap/lib/compiler/ebin/beam_opcodes.beam b/bootstrap/lib/compiler/ebin/beam_opcodes.beam Binary files differindex 8425c2b2b5..5047d223c2 100644 --- a/bootstrap/lib/compiler/ebin/beam_opcodes.beam +++ b/bootstrap/lib/compiler/ebin/beam_opcodes.beam diff --git a/bootstrap/lib/compiler/ebin/beam_split.beam b/bootstrap/lib/compiler/ebin/beam_split.beam Binary files differindex 64a946db25..874245d501 100644 --- a/bootstrap/lib/compiler/ebin/beam_split.beam +++ b/bootstrap/lib/compiler/ebin/beam_split.beam diff --git a/bootstrap/lib/compiler/ebin/beam_utils.beam b/bootstrap/lib/compiler/ebin/beam_utils.beam Binary files differindex ff455ce50f..7da67b85ee 100644 --- a/bootstrap/lib/compiler/ebin/beam_utils.beam +++ b/bootstrap/lib/compiler/ebin/beam_utils.beam diff --git a/bootstrap/lib/compiler/ebin/beam_validator.beam b/bootstrap/lib/compiler/ebin/beam_validator.beam Binary files differindex fed0bb3c48..9f154f58b8 100644 --- a/bootstrap/lib/compiler/ebin/beam_validator.beam +++ b/bootstrap/lib/compiler/ebin/beam_validator.beam diff --git a/bootstrap/lib/compiler/ebin/beam_z.beam b/bootstrap/lib/compiler/ebin/beam_z.beam Binary files differindex 4d28344035..2c4ca55563 100644 --- a/bootstrap/lib/compiler/ebin/beam_z.beam +++ b/bootstrap/lib/compiler/ebin/beam_z.beam diff --git a/bootstrap/lib/compiler/ebin/cerl.beam b/bootstrap/lib/compiler/ebin/cerl.beam Binary files differindex 2cba88e8c3..dc6bd455e7 100644 --- a/bootstrap/lib/compiler/ebin/cerl.beam +++ b/bootstrap/lib/compiler/ebin/cerl.beam diff --git a/bootstrap/lib/compiler/ebin/cerl_inline.beam b/bootstrap/lib/compiler/ebin/cerl_inline.beam Binary files differindex fcd22e932e..5604f26896 100644 --- a/bootstrap/lib/compiler/ebin/cerl_inline.beam +++ b/bootstrap/lib/compiler/ebin/cerl_inline.beam diff --git a/bootstrap/lib/compiler/ebin/cerl_trees.beam b/bootstrap/lib/compiler/ebin/cerl_trees.beam Binary files differindex ce81e67924..53e45c6742 100644 --- a/bootstrap/lib/compiler/ebin/cerl_trees.beam +++ b/bootstrap/lib/compiler/ebin/cerl_trees.beam diff --git a/bootstrap/lib/compiler/ebin/compile.beam b/bootstrap/lib/compiler/ebin/compile.beam Binary files differindex 34b3cc86a9..5dcacbacc8 100644 --- a/bootstrap/lib/compiler/ebin/compile.beam +++ b/bootstrap/lib/compiler/ebin/compile.beam diff --git a/bootstrap/lib/compiler/ebin/compiler.appup b/bootstrap/lib/compiler/ebin/compiler.appup index 577ebb149d..2c0d46d5f5 100644 --- a/bootstrap/lib/compiler/ebin/compiler.appup +++ b/bootstrap/lib/compiler/ebin/compiler.appup @@ -1 +1 @@ -{"4.9.1",[],[]}. +{"4.9.4",[],[]}. diff --git a/bootstrap/lib/compiler/ebin/core_lib.beam b/bootstrap/lib/compiler/ebin/core_lib.beam Binary files differindex 5e40c086c2..06edfdc396 100644 --- a/bootstrap/lib/compiler/ebin/core_lib.beam +++ b/bootstrap/lib/compiler/ebin/core_lib.beam diff --git a/bootstrap/lib/compiler/ebin/core_lint.beam b/bootstrap/lib/compiler/ebin/core_lint.beam Binary files differindex 831e2acc43..dca9efc2f3 100644 --- a/bootstrap/lib/compiler/ebin/core_lint.beam +++ b/bootstrap/lib/compiler/ebin/core_lint.beam diff --git a/bootstrap/lib/compiler/ebin/core_parse.beam b/bootstrap/lib/compiler/ebin/core_parse.beam Binary files differindex 3f9c212fe7..8c5816c52d 100644 --- a/bootstrap/lib/compiler/ebin/core_parse.beam +++ b/bootstrap/lib/compiler/ebin/core_parse.beam diff --git a/bootstrap/lib/compiler/ebin/core_pp.beam b/bootstrap/lib/compiler/ebin/core_pp.beam Binary files differindex f7e0dc40ae..5de821db8b 100644 --- a/bootstrap/lib/compiler/ebin/core_pp.beam +++ b/bootstrap/lib/compiler/ebin/core_pp.beam diff --git a/bootstrap/lib/compiler/ebin/core_scan.beam b/bootstrap/lib/compiler/ebin/core_scan.beam Binary files differindex f4742b98db..73f588232a 100644 --- a/bootstrap/lib/compiler/ebin/core_scan.beam +++ b/bootstrap/lib/compiler/ebin/core_scan.beam diff --git a/bootstrap/lib/compiler/ebin/sys_core_dsetel.beam b/bootstrap/lib/compiler/ebin/sys_core_dsetel.beam Binary files differindex 120c4f4a76..29dfdfb755 100644 --- a/bootstrap/lib/compiler/ebin/sys_core_dsetel.beam +++ b/bootstrap/lib/compiler/ebin/sys_core_dsetel.beam diff --git a/bootstrap/lib/compiler/ebin/sys_core_fold.beam b/bootstrap/lib/compiler/ebin/sys_core_fold.beam Binary files differindex 5c87bdd3dd..b8cc09084d 100644 --- a/bootstrap/lib/compiler/ebin/sys_core_fold.beam +++ b/bootstrap/lib/compiler/ebin/sys_core_fold.beam diff --git a/bootstrap/lib/compiler/ebin/sys_pre_expand.beam b/bootstrap/lib/compiler/ebin/sys_pre_expand.beam Binary files differindex d726c3ca07..6a6216e80f 100644 --- a/bootstrap/lib/compiler/ebin/sys_pre_expand.beam +++ b/bootstrap/lib/compiler/ebin/sys_pre_expand.beam diff --git a/bootstrap/lib/compiler/ebin/v3_codegen.beam b/bootstrap/lib/compiler/ebin/v3_codegen.beam Binary files differindex c683fc6c46..f371e3c171 100644 --- a/bootstrap/lib/compiler/ebin/v3_codegen.beam +++ b/bootstrap/lib/compiler/ebin/v3_codegen.beam diff --git a/bootstrap/lib/compiler/ebin/v3_core.beam b/bootstrap/lib/compiler/ebin/v3_core.beam Binary files differindex 8004afb882..5d81b6ba31 100644 --- a/bootstrap/lib/compiler/ebin/v3_core.beam +++ b/bootstrap/lib/compiler/ebin/v3_core.beam diff --git a/bootstrap/lib/compiler/ebin/v3_kernel.beam b/bootstrap/lib/compiler/ebin/v3_kernel.beam Binary files differindex 0566a7ff51..6896fe5421 100644 --- a/bootstrap/lib/compiler/ebin/v3_kernel.beam +++ b/bootstrap/lib/compiler/ebin/v3_kernel.beam diff --git a/bootstrap/lib/compiler/ebin/v3_kernel_pp.beam b/bootstrap/lib/compiler/ebin/v3_kernel_pp.beam Binary files differindex 1b2d02c1d5..907abff30d 100644 --- a/bootstrap/lib/compiler/ebin/v3_kernel_pp.beam +++ b/bootstrap/lib/compiler/ebin/v3_kernel_pp.beam diff --git a/bootstrap/lib/compiler/ebin/v3_life.beam b/bootstrap/lib/compiler/ebin/v3_life.beam Binary files differindex bb0ceefdd1..3934425ad9 100644 --- a/bootstrap/lib/compiler/ebin/v3_life.beam +++ b/bootstrap/lib/compiler/ebin/v3_life.beam diff --git a/bootstrap/lib/kernel/ebin/file.beam b/bootstrap/lib/kernel/ebin/file.beam Binary files differindex 3141747738..4444b79bf7 100644 --- a/bootstrap/lib/kernel/ebin/file.beam +++ b/bootstrap/lib/kernel/ebin/file.beam diff --git a/bootstrap/lib/kernel/ebin/kernel.appup b/bootstrap/lib/kernel/ebin/kernel.appup index 382d9deea1..b58d066898 100644 --- a/bootstrap/lib/kernel/ebin/kernel.appup +++ b/bootstrap/lib/kernel/ebin/kernel.appup @@ -15,13 +15,13 @@ %% under the License. %% %% %CopyrightEnd% -{"2.17", +{"3.0", %% Up from - max two major revisions back - [{<<"2\\.17(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R17 + [{<<"3\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R17 {<<"2\\.16(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R16 {<<"2\\.15(\\.[0-9]+)*">>,[restart_new_emulator]}],%% R15 %% Down to - max two major revisions back - [{<<"2\\.17(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R17 + [{<<"3\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R17 {<<"2\\.16(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R16 {<<"2\\.15(\\.[0-9]+)*">>,[restart_new_emulator]}] %% R15 }. diff --git a/bootstrap/lib/stdlib/ebin/c.beam b/bootstrap/lib/stdlib/ebin/c.beam Binary files differindex 3c34406adc..b184c21d94 100644 --- a/bootstrap/lib/stdlib/ebin/c.beam +++ b/bootstrap/lib/stdlib/ebin/c.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_eval.beam b/bootstrap/lib/stdlib/ebin/erl_eval.beam Binary files differindex d58dd86070..19fadc9585 100644 --- a/bootstrap/lib/stdlib/ebin/erl_eval.beam +++ b/bootstrap/lib/stdlib/ebin/erl_eval.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_expand_records.beam b/bootstrap/lib/stdlib/ebin/erl_expand_records.beam Binary files differindex 0563699d5e..c8f45fd838 100644 --- a/bootstrap/lib/stdlib/ebin/erl_expand_records.beam +++ b/bootstrap/lib/stdlib/ebin/erl_expand_records.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_internal.beam b/bootstrap/lib/stdlib/ebin/erl_internal.beam Binary files differindex 01c6598cdc..b851ca484e 100644 --- a/bootstrap/lib/stdlib/ebin/erl_internal.beam +++ b/bootstrap/lib/stdlib/ebin/erl_internal.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_lint.beam b/bootstrap/lib/stdlib/ebin/erl_lint.beam Binary files differindex 10d32c9865..289ff4c812 100644 --- a/bootstrap/lib/stdlib/ebin/erl_lint.beam +++ b/bootstrap/lib/stdlib/ebin/erl_lint.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_parse.beam b/bootstrap/lib/stdlib/ebin/erl_parse.beam Binary files differindex 2815cad4a3..c1c114dd3c 100644 --- a/bootstrap/lib/stdlib/ebin/erl_parse.beam +++ b/bootstrap/lib/stdlib/ebin/erl_parse.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_scan.beam b/bootstrap/lib/stdlib/ebin/erl_scan.beam Binary files differindex 851270bd37..fe45755343 100644 --- a/bootstrap/lib/stdlib/ebin/erl_scan.beam +++ b/bootstrap/lib/stdlib/ebin/erl_scan.beam diff --git a/bootstrap/lib/stdlib/ebin/io_lib.beam b/bootstrap/lib/stdlib/ebin/io_lib.beam Binary files differindex d34f69097a..ad77021190 100644 --- a/bootstrap/lib/stdlib/ebin/io_lib.beam +++ b/bootstrap/lib/stdlib/ebin/io_lib.beam diff --git a/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam b/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam Binary files differindex 720f19461e..f7b0b05ebb 100644 --- a/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam +++ b/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam diff --git a/bootstrap/lib/stdlib/ebin/maps.beam b/bootstrap/lib/stdlib/ebin/maps.beam Binary files differnew file mode 100644 index 0000000000..f524bc516c --- /dev/null +++ b/bootstrap/lib/stdlib/ebin/maps.beam diff --git a/bootstrap/lib/stdlib/ebin/ms_transform.beam b/bootstrap/lib/stdlib/ebin/ms_transform.beam Binary files differindex 6e7a19c78a..9a55c521f8 100644 --- a/bootstrap/lib/stdlib/ebin/ms_transform.beam +++ b/bootstrap/lib/stdlib/ebin/ms_transform.beam diff --git a/bootstrap/lib/stdlib/ebin/stdlib.app b/bootstrap/lib/stdlib/ebin/stdlib.app index d1da05048b..31c7222100 100644 --- a/bootstrap/lib/stdlib/ebin/stdlib.app +++ b/bootstrap/lib/stdlib/ebin/stdlib.app @@ -71,6 +71,7 @@ lib, lists, log_mf_h, + maps, math, ms_transform, orddict, diff --git a/bootstrap/lib/stdlib/ebin/stdlib.appup b/bootstrap/lib/stdlib/ebin/stdlib.appup index b8460d543c..0871dc5a98 100644 --- a/bootstrap/lib/stdlib/ebin/stdlib.appup +++ b/bootstrap/lib/stdlib/ebin/stdlib.appup @@ -15,13 +15,13 @@ %% under the License. %% %% %CopyrightEnd% -{"1.20", +{"2.0", %% Up from - max two major revisions back - [{<<"1\\.20(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R17 + [{<<"2\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R17 {<<"1\\.19(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R16 {<<"1\\.18(\\.[0-9]+)*">>,[restart_new_emulator]}],%% R15 %% Down to - max two major revisions back - [{<<"1\\.20(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R17 + [{<<"2\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R17 {<<"1\\.19(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R16 {<<"1\\.18(\\.[0-9]+)*">>,[restart_new_emulator]}] %% R15 }. diff --git a/erts/doc/src/erl.xml b/erts/doc/src/erl.xml index 27a23174d5..4aa3033f40 100644 --- a/erts/doc/src/erl.xml +++ b/erts/doc/src/erl.xml @@ -535,12 +535,15 @@ </item> <tag><marker id="file_name_encoding"></marker><c><![CDATA[+fnl]]></c></tag> <item> - <p>The VM works with file names as if they are encoded using the ISO-latin-1 encoding, disallowing Unicode characters with codepoints beyond 255. This is default on operating systems that have transparent file naming, i.e. all Unixes except MacOSX.</p> + <p>The VM works with file names as if they are encoded using the ISO-latin-1 encoding, disallowing Unicode characters with codepoints beyond 255.</p> <p>See <seealso marker="stdlib:unicode_usage#unicode_file_names">STDLIB User's Guide</seealso> for more infomation about unicode file names.</p> </item> <tag><c><![CDATA[+fnu[{w|i|e}]]]></c></tag> <item> - <p>The VM works with file names as if they are encoded using UTF-8 (or some other system specific Unicode encoding). This is the default on operating systems that enforce Unicode encoding, i.e. Windows and MacOSX.</p> + <p>The VM works with file names as if they are encoded using + UTF-8 (or some other system specific Unicode encoding). This + is the default on operating systems that enforce Unicode + encoding, i.e. Windows and MacOS X.</p> <p>The <c>+fnu</c> switch can be followed by <c>w</c>, <c>i</c>, or <c>e</c> to control the way wrongly encoded file names are to be reported. <c>w</c> means that a warning is @@ -556,7 +559,12 @@ </item> <tag><c><![CDATA[+fna[{w|i|e}]]]></c></tag> <item> - <p>Selection between <c>+fnl</c> and <c>+fnu</c> is done based on the current locale settings in the OS, meaning that if you have set your terminal for UTF-8 encoding, the filesystem is expected to use the same encoding for file names (use with care).</p> + <p>Selection between <c>+fnl</c> and <c>+fnu</c> is done based + on the current locale settings in the OS, meaning that if you + have set your terminal for UTF-8 encoding, the filesystem is + expected to use the same encoding for file names. This is + default on all operating systems except MacOS X and + Windows.</p> <p>The <c>+fna</c> switch can be followed by <c>w</c>, <c>i</c>, or <c>e</c>. This will have effect if the locale settings cause the behavior of <c>+fnu</c> to be selected. diff --git a/erts/doc/src/erl_driver.xml b/erts/doc/src/erl_driver.xml index c2f7fa4588..710c9b19cf 100644 --- a/erts/doc/src/erl_driver.xml +++ b/erts/doc/src/erl_driver.xml @@ -4,7 +4,7 @@ <cref> <header> <copyright> - <year>2001</year><year>2013</year> + <year>2001</year><year>2014</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -1742,15 +1742,19 @@ typedef struct ErlIOVec { term consists of one to four elements in the array. The term first has a term type, and then arguments. The <c>port</c> parameter specifies the sending port.</p> - <p>Tuple and lists (with the exception of strings, see below), + <p>Tuples, maps and lists (with the exception of strings, see below), are built in reverse polish notation, so that to build a tuple, the elements are given first, and then the tuple - term, with a count. Likewise for lists.</p> + term, with a count. Likewise for lists and maps.</p> <p>A tuple must be specified with the number of elements. (The elements precede the <c>ERL_DRV_TUPLE</c> term.)</p> <p>A list must be specified with the number of elements, including the tail, which is the last term preceding <c>ERL_DRV_LIST</c>.</p> + <p>A map must be specified with the number of key-value pairs <c>N</c>. + The key-value pairs must precede the <c>ERL_DRV_MAP</c> in this order: + <c>key1,value1,key2,value2,...,keyN,valueN</c>. + Duplicate keys are not allowed.</p> <p>The special term <c>ERL_DRV_STRING_CONS</c> is used to "splice" in a string in a list, a string given this way is not a list per se, but the elements are elements of the @@ -1774,6 +1778,7 @@ ERL_DRV_PID ErlDrvTermData pid (from driver_connected(ErlDrvPort port) ERL_DRV_STRING_CONS char *str, int len ERL_DRV_FLOAT double *dbl ERL_DRV_EXT2TERM char *buf, ErlDrvUInt len +ERL_DRV_MAP int sz </pre> <p>The unsigned integer data type <c>ErlDrvUInt</c> and the signed integer data type <c>ErlDrvSInt</c> are 64 bits wide @@ -1856,6 +1861,24 @@ ERL_DRV_EXT2TERM char *buf, ErlDrvUInt len }; erl_drv_output_term(driver_mk_port(drvport), spec, sizeof(spec) / sizeof(spec[0])); ]]></code> + + <p>To build the map <c>#{key1 => 100, key2 => {200, 300}}</c>, the + following call could be made.</p> + <code type="none"><![CDATA[ + ErlDrvPort port = ... + ErlDrvTermData spec[] = { + ERL_DRV_ATOM, driver_mk_atom("key1"), + ERL_DRV_INT, 100, + ERL_DRV_ATOM, driver_mk_atom("key2"), + ERL_DRV_INT, 200, + ERL_DRV_INT, 300, + ERL_DRV_TUPLE, 2, + ERL_DRV_MAP, 2 + }; + erl_drv_output_term(driver_mk_port(drvport), spec, sizeof(spec) / sizeof(spec[0])); + ]]> + </code> + <p>If you want to pass a binary and don't already have the content of the binary in an <c>ErlDrvBinary</c>, you can benefit from using <c>ERL_DRV_BUF2BINARY</c> instead of creating an <c>ErlDrvBinary</c> diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in index 9125a8024f..f88a4ccc24 100644 --- a/erts/emulator/Makefile.in +++ b/erts/emulator/Makefile.in @@ -779,7 +779,7 @@ RUN_OBJS = \ $(OBJDIR)/erl_zlib.o $(OBJDIR)/erl_nif.o \ $(OBJDIR)/erl_bif_binary.o $(OBJDIR)/erl_ao_firstfit_alloc.o \ $(OBJDIR)/erl_thr_queue.o $(OBJDIR)/erl_sched_spec_pre_alloc.o \ - $(OBJDIR)/erl_ptab.o + $(OBJDIR)/erl_ptab.o $(OBJDIR)/erl_map.o ifeq ($(TARGET),win32) DRV_OBJS = \ diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 7fecdd5c5f..89d9442526 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -31,6 +31,7 @@ #include "big.h" #include "beam_load.h" #include "erl_binary.h" +#include "erl_map.h" #include "erl_bits.h" #include "dist.h" #include "beam_bp.h" @@ -701,6 +702,19 @@ extern int count_instructions; Fail; \ } +#define IsMap(Src, Fail) if (is_not_map(Src)) { Fail; } + +#define HasMapField(Src, Key, Fail) if (has_not_map_field(Src, Key)) { Fail; } + +#define GetMapElement(Src, Key, Dst, Fail) \ + do { \ + Eterm _res = get_map_element(Src, Key); \ + if (is_non_value(_res)) { \ + Fail; \ + } \ + Dst = _res; \ + } while (0) + #define IsFunction(X, Action) \ do { \ if ( !(is_any_fun(X)) ) { \ @@ -944,7 +958,13 @@ static BeamInstr* apply_fun(Process* p, Eterm fun, Eterm args, Eterm* reg) NOINLINE; static Eterm new_fun(Process* p, Eterm* reg, ErlFunEntry* fe, int num_free) NOINLINE; - +static Eterm new_map(Process* p, Eterm* reg, BeamInstr* I) NOINLINE; +static Eterm update_map_assoc(Process* p, Eterm* reg, + Eterm map, BeamInstr* I) NOINLINE; +static Eterm update_map_exact(Process* p, Eterm* reg, + Eterm map, BeamInstr* I) NOINLINE; +static int has_not_map_field(Eterm map, Eterm key); +static Eterm get_map_element(Eterm map, Eterm key); /* * Functions not directly called by process_main(). OK to inline. @@ -2323,6 +2343,55 @@ void process_main(void) Goto(*I); } + OpCase(new_map_jdII): { + Eterm res; + + x(0) = r(0); + SWAPOUT; + res = new_map(c_p, reg, I); + SWAPIN; + r(0) = x(0); + StoreResult(res, Arg(1)); + Next(4+Arg(3)); + } + + OpCase(update_map_assoc_jddII): { + Eterm res; + Eterm map; + + GetArg1(1, map); + x(0) = r(0); + SWAPOUT; + res = update_map_assoc(c_p, reg, map, I); + SWAPIN; + if (is_value(res)) { + r(0) = x(0); + StoreResult(res, Arg(2)); + Next(5+Arg(4)); + } else { + goto badarg; + } + } + + OpCase(update_map_exact_jddII): { + Eterm res; + Eterm map; + + GetArg1(1, map); + x(0) = r(0); + SWAPOUT; + res = update_map_exact(c_p, reg, map, I); + SWAPIN; + if (is_value(res)) { + r(0) = x(0); + StoreResult(res, Arg(2)); + Next(5+Arg(4)); + } else { + goto badarg; + } + } + + /* * All guards with zero arguments have special instructions: * self/0 @@ -5031,6 +5100,8 @@ translate_gc_bif(void* gcf) return bit_size_1; } else if (gcf == erts_gc_byte_size_1) { return byte_size_1; + } else if (gcf == erts_gc_map_size_1) { + return map_size_1; } else if (gcf == erts_gc_abs_1) { return abs_1; } else if (gcf == erts_gc_float_1) { @@ -6227,6 +6298,397 @@ new_fun(Process* p, Eterm* reg, ErlFunEntry* fe, int num_free) return make_fun(funp); } +static int has_not_map_field(Eterm map, Eterm key) +{ + map_t* mp; + Eterm* keys; + Uint i; + Uint n; + + mp = (map_t *)map_val(map); + keys = map_get_keys(mp); + n = map_get_size(mp); + if (is_immed(key)) { + for (i = 0; i < n; i++) { + if (keys[i] == key) { + return 0; + } + } + } else { + for (i = 0; i < n; i++) { + if (EQ(keys[i], key)) { + return 0; + } + } + } + return 1; +} + +static Eterm get_map_element(Eterm map, Eterm key) +{ + map_t *mp; + Eterm* ks, *vs; + Uint i; + Uint n; + + mp = (map_t *)map_val(map); + ks = map_get_keys(mp); + vs = map_get_values(mp); + n = map_get_size(mp); + if (is_immed(key)) { + for (i = 0; i < n; i++) { + if (ks[i] == key) { + return vs[i]; + } + } + } else { + for (i = 0; i < n; i++) { + if (EQ(ks[i], key)) { + return vs[i]; + } + } + } + return THE_NON_VALUE; +} + +#define GET_TERM(term, dest) \ +do { \ + Eterm src = (Eterm)(term); \ + switch (src & _TAG_IMMED1_MASK) { \ + case (R_REG_DEF << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER: \ + dest = x(0); \ + break; \ + case (X_REG_DEF << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER: \ + dest = x(src >> _TAG_IMMED1_SIZE); \ + break; \ + case (Y_REG_DEF << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER: \ + dest = y(src >> _TAG_IMMED1_SIZE); \ + break; \ + default: \ + dest = src; \ + break; \ + } \ +} while(0) + + +static Eterm +new_map(Process* p, Eterm* reg, BeamInstr* I) +{ + Uint n = Arg(3); + Uint i; + Uint need = n + 1 /* hdr */ + 1 /*size*/ + 1 /* ptr */ + 1 /* arity */; + Eterm keys; + Eterm *mhp,*thp; + Eterm *E; + BeamInstr *ptr; + map_t *mp; + + if (HeapWordsLeft(p) < need) { + erts_garbage_collect(p, need, reg, Arg(2)); + } + + thp = p->htop; + mhp = thp + 1 + n/2; + E = p->stop; + ptr = &Arg(4); + keys = make_tuple(thp); + *thp++ = make_arityval(n/2); + + mp = (map_t *)mhp; mhp += MAP_HEADER_SIZE; + mp->thing_word = MAP_HEADER; + mp->size = n/2; + mp->keys = keys; + + for (i = 0; i < n/2; i++) { + GET_TERM(*ptr++, *thp++); + GET_TERM(*ptr++, *mhp++); + } + p->htop = mhp; + return make_map(mp); +} + +static Eterm +update_map_assoc(Process* p, Eterm* reg, Eterm map, BeamInstr* I) +{ + Uint n; + Uint num_old; + Uint num_updates; + Uint need; + map_t *old_mp, *mp; + Eterm res; + Eterm* hp; + Eterm* E; + Eterm* old_keys; + Eterm* old_vals; + BeamInstr* new_p; + Eterm new_key; + Eterm* kp; + + if (is_not_map(map)) { + return THE_NON_VALUE; + } + + old_mp = (map_t *) map_val(map); + num_old = map_get_size(old_mp); + + /* + * If the old map is empty, create a new map. + */ + + if (num_old == 0) { + return new_map(p, reg, I+1); + } + + /* + * Allocate heap space for the worst case (i.e. all keys in the + * update list are new). + */ + + num_updates = Arg(4) / 2; + need = 2*(num_old+num_updates) + 1 + MAP_HEADER_SIZE; + if (HeapWordsLeft(p) < need) { + Uint live = Arg(3); + reg[live] = map; + erts_garbage_collect(p, need, reg, live+1); + map = reg[live]; + old_mp = (map_t *)map_val(map); + } + + /* + * Build the skeleton for the map, ready to be filled in. + * + * +-----------------------------------+ + * | (Space for aritvyal for keys) | <-----------+ + * +-----------------------------------+ | + * | (Space for key 1) | | <-- kp + * +-----------------------------------+ | + * . | + * . | + * . | + * +-----------------------------------+ | + * | (Space for last key) | | + * +-----------------------------------+ | + * | MAP_HEADER | | + * +-----------------------------------+ | + * | (Space for number of keys/values) | | + * +-----------------------------------+ | + * | Boxed tuple pointer >----------------+ + * +-----------------------------------+ + * | (Space for value 1) | <-- hp + * +-----------------------------------+ + */ + + E = p->stop; + kp = p->htop + 1; /* Point to first key */ + hp = kp + num_old + num_updates; + + res = make_map(hp); + mp = (map_t *)hp; + hp += MAP_HEADER_SIZE; + mp->thing_word = MAP_HEADER; + mp->keys = make_tuple(kp-1); + + old_vals = map_get_values(old_mp); + old_keys = map_get_keys(old_mp); + + new_p = &Arg(5); + GET_TERM(*new_p, new_key); + n = num_updates; + + /* + * Fill in keys and values, until we run out of either updates + * or old values and keys. + */ + + for (;;) { + Eterm key; + Sint c; + + ASSERT(kp < (Eterm *)mp); + key = *old_keys; + if ((c = CMP_TERM(key, new_key)) < 0) { + /* Copy old key and value */ + *kp++ = key; + *hp++ = *old_vals; + old_keys++, old_vals++, num_old--; + } else { /* Replace or insert new */ + GET_TERM(new_p[1], *hp++); + if (c > 0) { /* If new new key */ + *kp++ = new_key; + } else { /* If replacement */ + *kp++ = key; + old_keys++, old_vals++, num_old--; + } + n--; + if (n == 0) { + break; + } else { + new_p += 2; + GET_TERM(*new_p, new_key); + } + } + if (num_old == 0) { + break; + } + } + + /* + * At this point, we have run out of either old keys and values, + * or the update list. In other words, at least of one n and + * num_old must be zero. + */ + + if (n > 0) { + /* + * All old keys and values have been copied, but there + * are still new keys and values in the update list that + * must be copied. + */ + ASSERT(num_old == 0); + while (n-- > 0) { + GET_TERM(new_p[0], *kp++); + GET_TERM(new_p[1], *hp++); + new_p += 2; + } + } else { + /* + * All updates are now done. We may still have old + * keys and values that we must copy. + */ + ASSERT(n == 0); + while (num_old-- > 0) { + ASSERT(kp < (Eterm *)mp); + *kp++ = *old_keys++; + *hp++ = *old_vals++; + } + } + + /* + * Calculate how many values that are unused at the end of the + * key tuple and fill it out with a bignum header. + */ + if ((n = (Eterm *)mp - kp) > 0) { + *kp = make_pos_bignum_header(n-1); + } + + /* + * Fill in the size of the map in both the key tuple and in the map. + */ + + n = kp - p->htop - 1; /* Actual number of keys/values */ + *p->htop = make_arityval(n); + mp->size = n; + p->htop = hp; + return res; +} + +/* + * Update values for keys that already exist in the map. + */ + +static Eterm +update_map_exact(Process* p, Eterm* reg, Eterm map, BeamInstr* I) +{ + Uint n; + Uint i; + Uint num_old; + Uint need; + map_t *old_mp, *mp; + Eterm res; + Eterm* hp; + Eterm* E; + Eterm* old_keys; + Eterm* old_vals; + BeamInstr* new_p; + Eterm new_key; + + if (is_not_map(map)) { + return THE_NON_VALUE; + } + + old_mp = (map_t *) map_val(map); + num_old = map_get_size(old_mp); + + /* + * If the old map is empty, create a new map. + */ + + if (num_old == 0) { + return new_map(p, reg, I+1); + } + + /* + * Allocate the exact heap space needed. + */ + + need = num_old + MAP_HEADER_SIZE; + if (HeapWordsLeft(p) < need) { + Uint live = Arg(3); + reg[live] = map; + erts_garbage_collect(p, need, reg, live+1); + map = reg[live]; + old_mp = (map_t *)map_val(map); + } + + /* + * Update map, keeping the old key tuple. + */ + + hp = p->htop; + E = p->stop; + + old_vals = map_get_values(old_mp); + old_keys = map_get_keys(old_mp); + + res = make_map(hp); + mp = (map_t *)hp; + hp += MAP_HEADER_SIZE; + mp->thing_word = MAP_HEADER; + mp->size = num_old; + mp->keys = old_mp->keys; + + /* Get array of key/value pairs to be updated */ + new_p = &Arg(5); + GET_TERM(*new_p, new_key); + + /* Update all values */ + n = Arg(4) / 2; /* Number of values to be updated */ + ASSERT(n > 0); + for (i = 0; i < num_old; i++) { + if (!EQ(*old_keys, new_key)) { + /* Not same keys */ + *hp++ = *old_vals; + } else { + GET_TERM(new_p[1], *hp); + hp++; + n--; + if (n == 0) { + /* + * All updates done. Copy remaining values + * and return the result. + */ + for (i++, old_vals++; i < num_old; i++) { + *hp++ = *old_vals++; + } + ASSERT(hp == p->htop + need); + p->htop = hp; + return res; + } else { + new_p += 2; + GET_TERM(*new_p, new_key); + } + } + old_vals++, old_keys++; + } + + /* + * Updates left. That means that at least one the keys in the + * update list did not previously exist. + */ + ASSERT(hp == p->htop + need); + return THE_NON_VALUE; +} +#undef GET_TERM int catchlevel(Process *p) { diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index 938fd8f2c9..b589d1c930 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -3783,6 +3783,8 @@ gen_guard_bif1(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif, op->a[1].val = (BeamInstr) (void *) erts_gc_bit_size_1; } else if (bf == byte_size_1) { op->a[1].val = (BeamInstr) (void *) erts_gc_byte_size_1; + } else if (bf == map_size_1) { + op->a[1].val = (BeamInstr) (void *) erts_gc_map_size_1; } else if (bf == abs_1) { op->a[1].val = (BeamInstr) (void *) erts_gc_abs_1; } else if (bf == float_1) { @@ -4376,6 +4378,7 @@ transform_engine(LoaderState* st) Uint* restart; /* Where to restart if current match fails. */ GenOpArg def_vars[TE_MAX_VARS]; /* Default buffer for variables. */ GenOpArg* var = def_vars; + int num_vars = 0; int i; /* General index. */ Uint mask; GenOp* instr; @@ -4578,9 +4581,9 @@ transform_engine(LoaderState* st) { int n = *pc++; int formal_arity = gen_opc[instr->op].arity; - int num_vars = n + (instr->arity - formal_arity); int j = formal_arity; + num_vars = n + (instr->arity - formal_arity); var = erts_alloc(ERTS_ALC_T_LOADER_TMP, num_vars * sizeof(GenOpArg)); for (i = 0; i < n; i++) { @@ -4592,7 +4595,6 @@ transform_engine(LoaderState* st) } break; #endif - case TOP_next_arg: ap++; break; @@ -4680,6 +4682,20 @@ transform_engine(LoaderState* st) instr->a[ap].val = var[i].val; ap++; break; +#if defined(TOP_store_rest_args) + case TOP_store_rest_args: + { + int n = *pc++; + int num_extra = num_vars - n; + + ASSERT(n <= num_vars); + GENOP_ARITY(instr, instr->arity+num_extra); + memcpy(instr->a, instr->def_args, ap*sizeof(GenOpArg)); + memcpy(instr->a+ap, var+n, num_extra*sizeof(GenOpArg)); + ap += num_extra; + } + break; +#endif case TOP_try_me_else: restart = pc + 1; restart += *pc++; diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index 61c1abedb5..9c4801041f 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -4615,6 +4615,17 @@ BIF_RETTYPE bump_reductions_1(BIF_ALIST_1) BIF_RET2(am_true, reds); } +BIF_RETTYPE erts_internal_cmp_term_2(BIF_ALIST_2) { + int res = CMP_TERM(BIF_ARG_1,BIF_ARG_2); + + /* ensure -1, 0, 1 result */ + if (res < 0) { + BIF_RET(make_small(-1)); + } else if (res > 0) { + BIF_RET(make_small(1)); + } + BIF_RET(make_small(0)); +} /* * Processes doing yield on return in a bif ends up in bif_return_trap(). */ diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab index 3ec534f0bc..2d888862bf 100644 --- a/erts/emulator/beam/bif.tab +++ b/erts/emulator/beam/bif.tab @@ -578,6 +578,23 @@ bif os:unsetenv/1 bif re:inspect/2 +ubif erlang:is_map/1 +ubif erlang:map_size/1 +bif maps:to_list/1 +bif maps:find/2 +bif maps:get/2 +bif maps:from_list/1 +bif maps:is_key/2 +bif maps:keys/1 +bif maps:merge/2 +bif maps:new/0 +bif maps:put/3 +bif maps:remove/2 +bif maps:update/3 +bif maps:values/1 + +bif erts_internal:cmp_term/2 + # # Obsolete # diff --git a/erts/emulator/beam/copy.c b/erts/emulator/beam/copy.c index 23c0fca6aa..3a987e213b 100644 --- a/erts/emulator/beam/copy.c +++ b/erts/emulator/beam/copy.c @@ -27,6 +27,7 @@ #include "erl_process.h" #include "erl_gc.h" #include "big.h" +#include "erl_map.h" #include "erl_binary.h" #include "erl_bits.h" #include "dtrace-wrapper.h" @@ -150,6 +151,24 @@ Uint size_object(Eterm obj) goto pop_next; } break; + case MAP_SUBTAG: + { + Uint n; + map_t *mp; + mp = (map_t*)map_val_rel(obj,base); + ptr = (Eterm *)mp; + n = map_get_size(mp) + 1; + sum += n + 2; + ptr += 2; /* hdr + size words */ + while (n--) { + obj = *ptr++; + if (!IS_CONST(obj)) { + ESTACK_PUSH(s, obj); + } + } + goto pop_next; + } + break; case BIN_MATCHSTATE_SUBTAG: erl_exit(ERTS_ABORT_EXIT, "size_object: matchstate term not allowed"); @@ -318,6 +337,15 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) } } break; + case MAP_SUBTAG: + { + i = map_get_size(objp) + 3; + *argp = make_map_rel(htop, dst_base); + while (i--) { + *htop++ = *objp++; + } + } + break; case REFC_BINARY_SUBTAG: { ProcBin* pb; @@ -537,6 +565,10 @@ Eterm copy_shallow(Eterm* ptr, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) } goto off_heap_common; + case MAP_SUBTAG: + *hp++ = *tp++; + sz--; + break; case EXTERNAL_PID_SUBTAG: case EXTERNAL_PORT_SUBTAG: case EXTERNAL_REF_SUBTAG: diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c index c6b324dc15..ca7e39041b 100644 --- a/erts/emulator/beam/erl_alloc.c +++ b/erts/emulator/beam/erl_alloc.c @@ -242,32 +242,13 @@ do { \ sys_memcpy((void *) (IP), (void *) &aui__, sizeof(struct au_init)); \ } while (0) -#if ERTS_ALC_DEFAULT_ACUL \ - || ERTS_ALC_DEFAULT_ACUL_LL_ALLOC \ - || ERTS_ALC_DEFAULT_ACUL_EHEAP_ALLOC - -static ERTS_INLINE void -set_default_acul(struct au_init *ip, int acul) -{ - ip->thr_spec = 1; - ip->atype = AOFIRSTFIT; - ip->init.aoff.flavor = AOFF_BF; - ip->init.util.acul = acul; -} - -#endif - static void set_default_sl_alloc_opts(struct au_init *ip) { SET_DEFAULT_ALLOC_OPTS(ip); ip->enable = AU_ALLOC_DEFAULT_ENABLE(1); -#if ERTS_ALC_DEFAULT_ACUL - set_default_acul(ip, ERTS_ALC_DEFAULT_ACUL); -#else ip->thr_spec = 1; ip->atype = GOODFIT; -#endif ip->init.util.name_prefix = "sl_"; ip->init.util.alloc_no = ERTS_ALC_A_SHORT_LIVED; #ifndef SMALL_MEMORY @@ -281,7 +262,7 @@ set_default_sl_alloc_opts(struct au_init *ip) ip->init.util.force = 1; ip->init.util.low_mem = 1; #endif - + ip->init.util.acul = ERTS_ALC_DEFAULT_ACUL; } static void @@ -289,12 +270,8 @@ set_default_std_alloc_opts(struct au_init *ip) { SET_DEFAULT_ALLOC_OPTS(ip); ip->enable = AU_ALLOC_DEFAULT_ENABLE(1); -#if ERTS_ALC_DEFAULT_ACUL - set_default_acul(ip, ERTS_ALC_DEFAULT_ACUL); -#else ip->thr_spec = 1; ip->atype = BESTFIT; -#endif ip->init.util.name_prefix = "std_"; ip->init.util.alloc_no = ERTS_ALC_A_STANDARD; #ifndef SMALL_MEMORY @@ -303,6 +280,7 @@ set_default_std_alloc_opts(struct au_init *ip) ip->init.util.mmbcs = 32*1024; /* Main carrier size */ #endif ip->init.util.ts = ERTS_ALC_MTA_STANDARD; + ip->init.util.acul = ERTS_ALC_DEFAULT_ACUL; } static void @@ -310,13 +288,9 @@ set_default_ll_alloc_opts(struct au_init *ip) { SET_DEFAULT_ALLOC_OPTS(ip); ip->enable = AU_ALLOC_DEFAULT_ENABLE(1); -#if ERTS_ALC_DEFAULT_ACUL_LL_ALLOC - set_default_acul(ip, ERTS_ALC_DEFAULT_ACUL_LL_ALLOC); -#else ip->thr_spec = 0; ip->atype = BESTFIT; ip->init.bf.ao = 1; -#endif ip->init.util.ramv = 0; ip->init.util.mmsbc = 0; ip->init.util.sbct = ~((UWord) 0); @@ -332,6 +306,7 @@ 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.acul = ERTS_ALC_DEFAULT_ACUL_LL_ALLOC; } static void @@ -363,12 +338,8 @@ set_default_eheap_alloc_opts(struct au_init *ip) { SET_DEFAULT_ALLOC_OPTS(ip); ip->enable = AU_ALLOC_DEFAULT_ENABLE(1); -#if ERTS_ALC_DEFAULT_ACUL_EHEAP_ALLOC - set_default_acul(ip, ERTS_ALC_DEFAULT_ACUL_EHEAP_ALLOC); -#else ip->thr_spec = 1; ip->atype = GOODFIT; -#endif ip->init.util.name_prefix = "eheap_"; ip->init.util.alloc_no = ERTS_ALC_A_EHEAP; #ifndef SMALL_MEMORY @@ -382,6 +353,7 @@ set_default_eheap_alloc_opts(struct au_init *ip) ip->init.util.force = 1; ip->init.util.low_mem = 1; #endif + ip->init.util.acul = ERTS_ALC_DEFAULT_ACUL_EHEAP_ALLOC; } static void @@ -389,12 +361,8 @@ set_default_binary_alloc_opts(struct au_init *ip) { SET_DEFAULT_ALLOC_OPTS(ip); ip->enable = AU_ALLOC_DEFAULT_ENABLE(1); -#if ERTS_ALC_DEFAULT_ACUL - set_default_acul(ip, ERTS_ALC_DEFAULT_ACUL); -#else ip->thr_spec = 1; ip->atype = BESTFIT; -#endif ip->init.util.name_prefix = "binary_"; ip->init.util.alloc_no = ERTS_ALC_A_BINARY; #ifndef SMALL_MEMORY @@ -403,6 +371,7 @@ set_default_binary_alloc_opts(struct au_init *ip) ip->init.util.mmbcs = 32*1024; /* Main carrier size */ #endif ip->init.util.ts = ERTS_ALC_MTA_BINARY; + ip->init.util.acul = ERTS_ALC_DEFAULT_ACUL; } static void @@ -410,12 +379,8 @@ set_default_ets_alloc_opts(struct au_init *ip) { SET_DEFAULT_ALLOC_OPTS(ip); ip->enable = AU_ALLOC_DEFAULT_ENABLE(1); -#if ERTS_ALC_DEFAULT_ACUL - set_default_acul(ip, ERTS_ALC_DEFAULT_ACUL); -#else ip->thr_spec = 1; ip->atype = BESTFIT; -#endif ip->init.util.name_prefix = "ets_"; ip->init.util.alloc_no = ERTS_ALC_A_ETS; #ifndef SMALL_MEMORY @@ -424,6 +389,7 @@ set_default_ets_alloc_opts(struct au_init *ip) ip->init.util.mmbcs = 32*1024; /* Main carrier size */ #endif ip->init.util.ts = ERTS_ALC_MTA_ETS; + ip->init.util.acul = ERTS_ALC_DEFAULT_ACUL; } static void @@ -431,12 +397,8 @@ set_default_driver_alloc_opts(struct au_init *ip) { SET_DEFAULT_ALLOC_OPTS(ip); ip->enable = AU_ALLOC_DEFAULT_ENABLE(1); -#if ERTS_ALC_DEFAULT_ACUL - set_default_acul(ip, ERTS_ALC_DEFAULT_ACUL); -#else ip->thr_spec = 1; ip->atype = BESTFIT; -#endif ip->init.util.name_prefix = "driver_"; ip->init.util.alloc_no = ERTS_ALC_A_DRIVER; #ifndef SMALL_MEMORY @@ -445,6 +407,7 @@ set_default_driver_alloc_opts(struct au_init *ip) ip->init.util.mmbcs = 32*1024; /* Main carrier size */ #endif ip->init.util.ts = ERTS_ALC_MTA_DRIVER; + ip->init.util.acul = ERTS_ALC_DEFAULT_ACUL; } static void @@ -453,12 +416,8 @@ set_default_fix_alloc_opts(struct au_init *ip, { SET_DEFAULT_ALLOC_OPTS(ip); ip->enable = AU_ALLOC_DEFAULT_ENABLE(1); -#if ERTS_ALC_DEFAULT_ACUL - set_default_acul(ip, ERTS_ALC_DEFAULT_ACUL); -#else ip->thr_spec = 1; ip->atype = BESTFIT; -#endif ip->init.bf.ao = 1; ip->init.util.name_prefix = "fix_"; ip->init.util.fix_type_size = fix_type_sizes; @@ -469,6 +428,7 @@ set_default_fix_alloc_opts(struct au_init *ip, ip->init.util.mmbcs = 128*1024; /* Main carrier size */ #endif ip->init.util.ts = ERTS_ALC_MTA_FIXED_SIZE; + ip->init.util.acul = ERTS_ALC_DEFAULT_ACUL; } #ifdef ERTS_SMP @@ -560,26 +520,25 @@ strategy_support_carrier_migration(struct au_init *auip) } static ERTS_INLINE void -check_disable_carrier_migration(struct au_init *auip) -{ - if (!strategy_support_carrier_migration(auip) || !auip->thr_spec) - auip->init.util.acul = 0; -} - -static ERTS_INLINE void -ensure_carrier_migration_support(struct au_init *auip) +adjust_carrier_migration_support(struct au_init *auip) { - auip->thr_spec = 1; /* Need thread preferred */ +#ifdef ERTS_SMP + if (auip->init.util.acul) { + auip->thr_spec = -1; /* Need thread preferred */ - /* - * If strategy cannot handle carrier migration, - * default to a strategy that can... - */ - if (!strategy_support_carrier_migration(auip)) { - /* Default to aoffcbf */ - auip->atype = AOFIRSTFIT; - auip->init.aoff.flavor = AOFF_BF; + /* + * If strategy cannot handle carrier migration, + * default to a strategy that can... + */ + if (!strategy_support_carrier_migration(auip)) { + /* Default to aoffcbf */ + auip->atype = AOFIRSTFIT; + auip->init.aoff.flavor = AOFF_BF; + } } +#else + auip->init.util.acul = 0; +#endif } void @@ -683,15 +642,16 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) init.fix_alloc.thr_spec = 0; } - check_disable_carrier_migration(&init.sl_alloc); - check_disable_carrier_migration(&init.std_alloc); - check_disable_carrier_migration(&init.ll_alloc); - check_disable_carrier_migration(&init.eheap_alloc); - check_disable_carrier_migration(&init.binary_alloc); - check_disable_carrier_migration(&init.ets_alloc); - check_disable_carrier_migration(&init.driver_alloc); - check_disable_carrier_migration(&init.fix_alloc); - + /* Make adjustments for carrier migration support */ + init.temp_alloc.init.util.acul = 0; + adjust_carrier_migration_support(&init.sl_alloc); + adjust_carrier_migration_support(&init.std_alloc); + adjust_carrier_migration_support(&init.ll_alloc); + adjust_carrier_migration_support(&init.eheap_alloc); + adjust_carrier_migration_support(&init.binary_alloc); + adjust_carrier_migration_support(&init.ets_alloc); + adjust_carrier_migration_support(&init.driver_alloc); + adjust_carrier_migration_support(&init.fix_alloc); #ifdef ERTS_SMP /* Only temp_alloc can use thread specific interface */ @@ -1290,8 +1250,6 @@ handle_au_arg(struct au_init *auip, break; } } - ensure_carrier_migration_support(auip); - auip->init.util.acul = get_acul_value(auip, sub_param + 4, argv, ip); } else if(has_prefix("asbcst", sub_param)) { @@ -1328,7 +1286,8 @@ handle_au_arg(struct au_init *auip, else { bad_value(param, sub_param + 1, alg); } - check_disable_carrier_migration(auip); + if (!strategy_support_carrier_migration(auip)) + auip->init.util.acul = 0; } else goto bad_switch; @@ -1409,7 +1368,7 @@ handle_au_arg(struct au_init *auip, } else if (res == 0) { auip->thr_spec = 0; - check_disable_carrier_migration(auip); + auip->init.util.acul = 0; break; } goto bad_switch; @@ -1607,7 +1566,7 @@ handle_args(int *argc, char **argv, erts_alc_hndl_args_init_t *init) for (a = 0; a < aui_sz; a++) { aui[a]->thr_spec = 0; - check_disable_carrier_migration(aui[a]); + aui[a]->init.util.acul = 0; aui[a]->init.util.ramv = 0; aui[a]->init.util.lmbcs = 5*1024*1024; } diff --git a/erts/emulator/beam/erl_bif_guard.c b/erts/emulator/beam/erl_bif_guard.c index a715756c15..bbd8aa31d9 100644 --- a/erts/emulator/beam/erl_bif_guard.c +++ b/erts/emulator/beam/erl_bif_guard.c @@ -33,6 +33,7 @@ #include "bif.h" #include "big.h" #include "erl_binary.h" +#include "erl_map.h" static Eterm gc_double_to_integer(Process* p, double x, Eterm* reg, Uint live); @@ -455,6 +456,28 @@ Eterm erts_gc_byte_size_1(Process* p, Eterm* reg, Uint live) } } +Eterm erts_gc_map_size_1(Process* p, Eterm* reg, Uint live) +{ + Eterm arg = reg[live]; + if (is_map(arg)) { + map_t *mp = (map_t*)map_val(arg); + Uint size = map_get_size(mp); + if (IS_USMALL(0, size)) { + return make_small(size); + } else { + Eterm* hp; + if (ERTS_NEED_GC(p, BIG_UINT_HEAP_SIZE)) { + erts_garbage_collect(p, BIG_UINT_HEAP_SIZE, reg, live); + } + hp = p->htop; + p->htop += BIG_UINT_HEAP_SIZE; + return uint_to_big(size, hp); + } + } else { + BIF_ERROR(p, BADARG); + } +} + Eterm erts_gc_abs_1(Process* p, Eterm* reg, Uint live) { Eterm arg; diff --git a/erts/emulator/beam/erl_bif_op.c b/erts/emulator/beam/erl_bif_op.c index adac0052d6..37dd6457db 100644 --- a/erts/emulator/beam/erl_bif_op.c +++ b/erts/emulator/beam/erl_bif_op.c @@ -36,6 +36,7 @@ #include "dist.h" #include "erl_version.h" #include "erl_binary.h" +#include "erl_map.h" BIF_RETTYPE and_2(BIF_ALIST_2) { @@ -321,7 +322,10 @@ BIF_RETTYPE is_record_3(BIF_ALIST_3) BIF_RET(am_false); } - - - - +BIF_RETTYPE is_map_1(BIF_ALIST_1) +{ + if (is_map(BIF_ARG_1)) { + BIF_RET(am_true); + } + BIF_RET(am_false); +} diff --git a/erts/emulator/beam/erl_db_util.c b/erts/emulator/beam/erl_db_util.c index a358ecf326..3986ccd4d3 100644 --- a/erts/emulator/beam/erl_db_util.c +++ b/erts/emulator/beam/erl_db_util.c @@ -35,6 +35,7 @@ #include "bif.h" #include "big.h" #include "erl_binary.h" +#include "erl_map.h" #include "erl_thr_progress.h" #include "erl_db_util.h" @@ -565,6 +566,12 @@ static DMCGuardBif guard_tab[] = DBIF_ALL }, { + am_is_map, + &is_map_1, + 1, + DBIF_ALL + }, + { am_is_binary, &is_binary_1, 1, @@ -631,6 +638,12 @@ static DMCGuardBif guard_tab[] = DBIF_ALL }, { + am_map_size, + &map_size_1, + 1, + DBIF_ALL + }, + { am_bit_size, &bit_size_1, 1, diff --git a/erts/emulator/beam/erl_debug.c b/erts/emulator/beam/erl_debug.c index 873a9860da..50bdc79506 100644 --- a/erts/emulator/beam/erl_debug.c +++ b/erts/emulator/beam/erl_debug.c @@ -29,6 +29,7 @@ #include "bif.h" #include "beam_catches.h" #include "erl_debug.h" +#include "erl_map.h" #define WITHIN(ptr, x, y) ((x) <= (ptr) && (ptr) < (y)) diff --git a/erts/emulator/beam/erl_driver.h b/erts/emulator/beam/erl_driver.h index 2bd3181bdc..ab9ee63104 100644 --- a/erts/emulator/beam/erl_driver.h +++ b/erts/emulator/beam/erl_driver.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1999-2013. All Rights Reserved. + * Copyright Ericsson AB 1999-2014. 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 @@ -605,6 +605,8 @@ EXTERN int null_func(void); #define ERL_DRV_INT64 ((ErlDrvTermData) 15) /* ErlDrvSInt64 * */ #define ERL_DRV_UINT64 ((ErlDrvTermData) 16) /* ErlDrvUInt64 * */ +#define ERL_DRV_MAP ((ErlDrvTermData) 17) /* ErlDrvUInt */ + #ifndef ERL_DRIVER_TYPES_ONLY /* make terms for driver_output_term and driver_send_term */ diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c index ab8448e8a1..2022f70cbb 100644 --- a/erts/emulator/beam/erl_gc.c +++ b/erts/emulator/beam/erl_gc.c @@ -28,6 +28,7 @@ #include "beam_catches.h" #include "erl_binary.h" #include "erl_bits.h" +#include "erl_map.h" #include "error.h" #include "big.h" #include "erl_gc.h" diff --git a/erts/emulator/beam/erl_gc.h b/erts/emulator/beam/erl_gc.h index 1801df359a..5203dda263 100644 --- a/erts/emulator/beam/erl_gc.h +++ b/erts/emulator/beam/erl_gc.h @@ -20,6 +20,8 @@ #ifndef __ERL_GC_H__ #define __ERL_GC_H__ +#include "erl_map.h" + /* GC declarations shared by beam/erl_gc.c and hipe/hipe_gc.c */ #if defined(DEBUG) && !ERTS_GLB_INLINE_INCL_FUNC_DEF @@ -42,23 +44,24 @@ do { \ HTOP += 2; /* update tospace htop */ \ } while(0) -#define MOVE_BOXED(PTR,HDR,HTOP,ORIG) \ -do { \ - Eterm gval; \ - Sint nelts; \ - \ - ASSERT(is_header(HDR)); \ - gval = make_boxed(HTOP); \ - *ORIG = gval; \ - *HTOP++ = HDR; \ - *PTR++ = gval; \ - nelts = header_arity(HDR); \ - switch ((HDR) & _HEADER_SUBTAG_MASK) { \ - case SUB_BINARY_SUBTAG: nelts++; break; \ - case FUN_SUBTAG: nelts+=((ErlFunThing*)(PTR-1))->num_free+1; break; \ - } \ - while (nelts--) \ - *HTOP++ = *PTR++; \ +#define MOVE_BOXED(PTR,HDR,HTOP,ORIG) \ +do { \ + Eterm gval; \ + Sint nelts; \ + \ + ASSERT(is_header(HDR)); \ + nelts = header_arity(HDR); \ + switch ((HDR) & _HEADER_SUBTAG_MASK) { \ + case SUB_BINARY_SUBTAG: nelts++; break; \ + case MAP_SUBTAG: nelts+=map_get_size(PTR) + 1; break; \ + case FUN_SUBTAG: nelts+=((ErlFunThing*)(PTR))->num_free+1; break; \ + } \ + gval = make_boxed(HTOP); \ + *ORIG = gval; \ + *HTOP++ = HDR; \ + *PTR++ = gval; \ + while (nelts--) *HTOP++ = *PTR++; \ + \ } while(0) #define in_area(ptr,start,nbytes) \ diff --git a/erts/emulator/beam/erl_map.c b/erts/emulator/beam/erl_map.c new file mode 100644 index 0000000000..2fff7f9390 --- /dev/null +++ b/erts/emulator/beam/erl_map.c @@ -0,0 +1,819 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2014. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + * Author: Björn-Egil Dahlberg + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include "erl_vm.h" +#include "global.h" +#include "erl_process.h" +#include "error.h" +#include "bif.h" + +#include "erl_map.h" + +/* BIFs + * + * DONE: + * - erlang:is_map/1 + * - erlang:map_size/1 + * + * - maps:find/2 + * - maps:from_list/1 + * - maps:get/2 + * - maps:is_key/2 + * - maps:keys/1 + * - maps:merge/2 + * - maps:new/0 + * - maps:put/3 + * - maps:remove/2 + * - maps:to_list/1 + * - maps:update/3 + * - maps:values/1 + * + * TODO: + * - maps:foldl/3 + * - maps:foldr/3 + * - maps:map/3 + * - maps:size/1 + * - maps:without/2 + * + */ + +/* erlang:map_size/1 + * the corresponding instruction is implemented in: + * beam/erl_bif_guard.c + */ + +BIF_RETTYPE map_size_1(BIF_ALIST_1) { + if (is_map(BIF_ARG_1)) { + Eterm *hp; + Uint hsz = 0; + map_t *mp = (map_t*)map_val(BIF_ARG_1); + Uint n = map_get_size(mp); + + erts_bld_uint(NULL, &hsz, n); + hp = HAlloc(BIF_P, hsz); + BIF_RET(erts_bld_uint(&hp, NULL, n)); + } + + BIF_ERROR(BIF_P, BADARG); +} + +/* maps:to_list/1 + */ + +BIF_RETTYPE maps_to_list_1(BIF_ALIST_1) { + if (is_map(BIF_ARG_1)) { + Uint n; + Eterm* hp; + Eterm *ks,*vs, res, tup; + map_t *mp = (map_t*)map_val(BIF_ARG_1); + + ks = map_get_keys(mp); + vs = map_get_values(mp); + n = map_get_size(mp); + hp = HAlloc(BIF_P, (2 + 3) * n); + res = NIL; + + while(n--) { + tup = TUPLE2(hp, ks[n], vs[n]); hp += 3; + res = CONS(hp, tup, res); hp += 2; + } + + BIF_RET(res); + } + + BIF_ERROR(BIF_P, BADARG); +} + +/* maps:find/2 + * return value if key *matches* a key in the map + */ + +int erts_maps_find(Eterm key, Eterm map, Eterm *value) { + + Eterm *ks,*vs; + map_t *mp; + Uint n,i; + + mp = (map_t*)map_val(map); + n = map_get_size(mp); + ks = map_get_keys(mp); + vs = map_get_values(mp); + + for( i = 0; i < n; i++) { + if (EQ(ks[i], key)) { + *value = vs[i]; + return 1; + } + } + return 0; +} + +BIF_RETTYPE maps_find_2(BIF_ALIST_2) { + if (is_map(BIF_ARG_2)) { + Eterm *hp, value,res; + + if (erts_maps_find(BIF_ARG_1, BIF_ARG_2, &value)) { + hp = HAlloc(BIF_P, 3); + res = make_tuple(hp); + *hp++ = make_arityval(2); + *hp++ = am_ok; + *hp++ = value; + BIF_RET(res); + } + + BIF_RET(am_error); + } + BIF_ERROR(BIF_P, BADARG); +} +/* maps:get/2 + * return value if key *matches* a key in the map + * exception bad_key if none matches + */ + + +int erts_maps_get(Eterm key, Eterm map, Eterm *value) { + Eterm *ks,*vs; + map_t *mp; + Uint n,i; + + mp = (map_t*)map_val(map); + n = map_get_size(mp); + + if (n == 0) + return 0; + + ks = map_get_keys(mp); + vs = map_get_values(mp); + + if (is_immed(key)) { + for( i = 0; i < n; i++) { + if (ks[i] == key) { + *value = vs[i]; + return 1; + } + } + } + + for( i = 0; i < n; i++) { + if (EQ(ks[i], key)) { + *value = vs[i]; + return 1; + } + } + return 0; +} + +BIF_RETTYPE maps_get_2(BIF_ALIST_2) { + if (is_map(BIF_ARG_2)) { + Eterm *hp; + Eterm value, error; + char *s_error; + + if (erts_maps_get(BIF_ARG_1, BIF_ARG_2, &value)) { + BIF_RET(value); + } + + s_error = "bad_key"; + error = am_atom_put(s_error, sys_strlen(s_error)); + + hp = HAlloc(BIF_P, 3); + BIF_P->fvalue = TUPLE2(hp, error, BIF_ARG_1); + BIF_ERROR(BIF_P, EXC_ERROR_2); + } + BIF_ERROR(BIF_P, BADARG); +} + +/* maps:from_list/1 + * List may be unsorted [{K,V}] + */ + +BIF_RETTYPE maps_from_list_1(BIF_ALIST_1) { + Eterm *kv, item = BIF_ARG_1; + Eterm *hp, *thp,*vs, *ks, keys, res; + map_t *mp; + Uint size = 0, unused_size = 0; + Sint c = 0; + Sint idx = 0; + + if (is_list(item) || is_nil(item)) { + + /* Calculate size and check validity */ + + while(is_list(item)) { + res = CAR(list_val(item)); + if (is_not_tuple(res)) + goto error; + + kv = tuple_val(res); + if (*kv != make_arityval(2)) + goto error; + + size++; + item = CDR(list_val(item)); + } + + if (is_not_nil(item)) + goto error; + + hp = HAlloc(BIF_P, 3 + 1 + (2 * size)); + thp = hp; + keys = make_tuple(hp); + *hp++ = make_arityval(size); + ks = hp; + hp += size; + mp = (map_t*)hp; + res = make_map(mp); + hp += MAP_HEADER_SIZE; + vs = hp; + + mp->thing_word = MAP_HEADER; + mp->size = size; /* set later, might shrink*/ + mp->keys = keys; + + if (size == 0) + BIF_RET(res); + + item = BIF_ARG_1; + + /* first entry */ + kv = tuple_val(CAR(list_val(item))); + ks[0] = kv[1]; + vs[0] = kv[2]; + size = 1; + item = CDR(list_val(item)); + + /* insert sort key/value pairs */ + while(is_list(item)) { + + kv = tuple_val(CAR(list_val(item))); + + /* compare ks backwards + * idx represent word index to be written (hole position). + * We cannot copy the elements when searching since we might + * have an equal key. So we search for just the index first =( + * + * It is perhaps faster to move the values in the first pass. + * Check for uniqueness during insert phase and then have a + * second phace compacting the map if duplicates are found + * during insert. .. or do someother sort .. shell-sort perhaps. + */ + + idx = size; + + while(idx > 0 && (c = CMP_TERM(kv[1],ks[idx-1])) < 0) { idx--; } + + if (c == 0) { + /* last compare was equal, + * i.e. we have to release memory + * and overwrite that key/value + */ + ks[idx-1] = kv[1]; + vs[idx-1] = kv[2]; + unused_size++; + } else { + Uint i = size; + while(i > idx) { + ks[i] = ks[i-1]; + vs[i] = vs[i-1]; + i--; + } + ks[idx] = kv[1]; + vs[idx] = kv[2]; + size++; + } + item = CDR(list_val(item)); + } + + if (unused_size) { + /* the key tuple is embedded in the heap + * write a bignum to clear it. + */ + /* release values as normal since they are on the top of the heap */ + + ks[size] = make_pos_bignum_header(unused_size - 1); + HRelease(BIF_P, vs + size + unused_size, vs + size); + } + + *thp = make_arityval(size); + mp->size = size; + BIF_RET(res); + } + +error: + + BIF_ERROR(BIF_P, BADARG); +} + +/* maps:is_key/2 + */ + +BIF_RETTYPE maps_is_key_2(BIF_ALIST_2) { + if (is_map(BIF_ARG_2)) { + Eterm *ks, key; + map_t *mp; + Uint n,i; + + mp = (map_t*)map_val(BIF_ARG_2); + key = BIF_ARG_1; + n = map_get_size(mp); + ks = map_get_keys(mp); + + if (n == 0) + BIF_RET(am_false); + + if (is_immed(key)) { + for( i = 0; i < n; i++) { + if (ks[i] == key) { + BIF_RET(am_true); + } + } + } + + for( i = 0; i < n; i++) { + if (EQ(ks[i], key)) { + BIF_RET(am_true); + } + } + BIF_RET(am_false); + } + BIF_ERROR(BIF_P, BADARG); +} + +/* maps:keys/1 + */ + +BIF_RETTYPE maps_keys_1(BIF_ALIST_1) { + if (is_map(BIF_ARG_1)) { + Eterm *hp, *ks, res = NIL; + map_t *mp; + Uint n; + + mp = (map_t*)map_val(BIF_ARG_1); + n = map_get_size(mp); + + if (n == 0) + BIF_RET(res); + + hp = HAlloc(BIF_P, (2 * n)); + ks = map_get_keys(mp); + + while(n--) { + res = CONS(hp, ks[n], res); hp += 2; + } + + BIF_RET(res); + } + BIF_ERROR(BIF_P, BADARG); +} +/* maps:merge/2 + */ + +BIF_RETTYPE maps_merge_2(BIF_ALIST_2) { + if (is_map(BIF_ARG_1) && is_map(BIF_ARG_2)) { + Eterm *hp,*thp; + Eterm tup; + Eterm *ks,*vs,*ks1,*vs1,*ks2,*vs2; + map_t *mp1,*mp2,*mp_new; + Uint n1,n2,i1,i2,need,unused_size=0; + int c = 0; + + mp1 = (map_t*)map_val(BIF_ARG_1); + mp2 = (map_t*)map_val(BIF_ARG_2); + n1 = map_get_size(mp1); + n2 = map_get_size(mp2); + + need = MAP_HEADER_SIZE + 1 + 2*(n1 + n2); + + hp = HAlloc(BIF_P, need); + thp = hp; + tup = make_tuple(thp); + ks = hp + 1; hp += 1 + n1 + n2; + mp_new = (map_t*)hp; hp += MAP_HEADER_SIZE; + vs = hp; hp += n1 + n2; + + mp_new->thing_word = MAP_HEADER; + mp_new->size = 0; + mp_new->keys = tup; + + i1 = 0; i2 = 0; + ks1 = map_get_keys(mp1); + vs1 = map_get_values(mp1); + ks2 = map_get_keys(mp2); + vs2 = map_get_values(mp2); + + while(i1 < n1 && i2 < n2) { + c = CMP_TERM(ks1[i1],ks2[i2]); + if ( c == 0) { + /* use righthand side arguments map value, + * but advance both maps */ + *ks++ = ks2[i2]; + *vs++ = vs2[i2]; + i1++, i2++, unused_size++; + } else if ( c < 0) { + *ks++ = ks1[i1]; + *vs++ = vs1[i1]; + i1++; + } else { + *ks++ = ks2[i2]; + *vs++ = vs2[i2]; + i2++; + } + } + + /* copy remaining */ + while (i1 < n1) { + *ks++ = ks1[i1]; + *vs++ = vs1[i1]; + i1++; + } + + while (i2 < n2) { + *ks++ = ks2[i2]; + *vs++ = vs2[i2]; + i2++; + } + + if (unused_size) { + /* the key tuple is embedded in the heap, write a bignum to clear it. + * + * release values as normal since they are on the top of the heap + * size = n1 + n1 - unused_size + */ + + *ks = make_pos_bignum_header(unused_size - 1); + HRelease(BIF_P, vs + unused_size, vs); + } + + mp_new->size = n1 + n2 - unused_size; + *thp = make_arityval(n1 + n2 - unused_size); + + BIF_RET(make_map(mp_new)); + } + BIF_ERROR(BIF_P, BADARG); +} +/* maps:new/2 + */ + +BIF_RETTYPE maps_new_0(BIF_ALIST_0) { + Eterm* hp; + Eterm tup; + map_t *mp; + + hp = HAlloc(BIF_P, (MAP_HEADER_SIZE + 1)); + tup = make_tuple(hp); + *hp++ = make_arityval(0); + + mp = (map_t*)hp; + mp->thing_word = MAP_HEADER; + mp->size = 0; + mp->keys = tup; + + BIF_RET(make_map(mp)); +} + +/* maps:put/3 + */ + +Eterm erts_maps_put(Process *p, Eterm key, Eterm value, Eterm map) { + Sint n,i; + Sint c = 0; + Eterm* hp, *shp; + Eterm *ks,*vs, res, tup; + map_t *mp = (map_t*)map_val(map); + + n = map_get_size(mp); + + if (n == 0) { + hp = HAlloc(p, MAP_HEADER_SIZE + 1 + 2); + tup = make_tuple(hp); + *hp++ = make_arityval(1); + *hp++ = key; + res = make_map(hp); + *hp++ = MAP_HEADER; + *hp++ = 1; + *hp++ = tup; + *hp++ = value; + + return res; + } + + ks = map_get_keys(mp); + vs = map_get_values(mp); + + /* only allocate for values, + * assume key-tuple will be intact + */ + + hp = HAlloc(p, MAP_HEADER_SIZE + n); + shp = hp; /* save hp, used if optimistic update fails */ + res = make_map(hp); + *hp++ = MAP_HEADER; + *hp++ = n; + *hp++ = mp->keys; + + if (is_immed(key)) { + for( i = 0; i < n; i ++) { + if (ks[i] == key) { + *hp++ = value; + vs++; + c = 1; + } else { + *hp++ = *vs++; + } + } + } else { + for( i = 0; i < n; i ++) { + if (EQ(ks[i], key)) { + *hp++ = value; + vs++; + c = 1; + } else { + *hp++ = *vs++; + } + } + } + + if (c) + return res; + + /* need to make a new tuple, + * use old hp since it needs to be recreated anyway. + */ + tup = make_tuple(shp); + *shp++ = make_arityval(n+1); + + hp = HAlloc(p, 3 + n + 1); + res = make_map(hp); + *hp++ = MAP_HEADER; + *hp++ = n + 1; + *hp++ = tup; + + ks = map_get_keys(mp); + vs = map_get_values(mp); + + ASSERT(n >= 0); + + /* copy map in order */ + while (n && ((c = CMP_TERM(*ks, key)) < 0)) { + *shp++ = *ks++; + *hp++ = *vs++; + n--; + } + + *shp++ = key; + *hp++ = value; + + ASSERT(n >= 0); + + while(n--) { + *shp++ = *ks++; + *hp++ = *vs++; + } + /* we have one word remaining + * this will work out fine once we get the size word + * in the header. + */ + *shp = make_pos_bignum_header(0); + return res; +} + +BIF_RETTYPE maps_put_3(BIF_ALIST_3) { + if (is_map(BIF_ARG_3)) { + BIF_RET(erts_maps_put(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3)); + } + BIF_ERROR(BIF_P, BADARG); +} + +/* maps:remove/3 + */ + +int erts_maps_remove(Process *p, Eterm key, Eterm map, Eterm *res) { + Sint n; + Uint need; + Eterm *hp_start; + Eterm *thp, *mhp; + Eterm *ks, *vs, tup; + map_t *mp = (map_t*)map_val(map); + + n = map_get_size(mp); + + if (n == 0) { + *res = map; + return 1; + } + + ks = map_get_keys(mp); + vs = map_get_values(mp); + + /* Assume key exists. + * Release allocated if it didn't. + * Allocate key tuple first. + */ + + need = n + 1 - 1 + 3 + n - 1; /* tuple - 1 + map - 1 */ + hp_start = HAlloc(p, need); + thp = hp_start; + mhp = thp + n; /* offset with tuple heap size */ + + tup = make_tuple(thp); + *thp++ = make_arityval(n - 1); + + *res = make_map(mhp); + *mhp++ = MAP_HEADER; + *mhp++ = n - 1; + *mhp++ = tup; + + if (is_immed(key)) { + while(n--) { + if (*ks == key) { + goto found_key; + } else { + *mhp++ = *vs++; + *thp++ = *ks++; + } + } + } else { + while(n--) { + if (EQ(*ks, key)) { + goto found_key; + } else { + *mhp++ = *vs++; + *thp++ = *ks++; + } + } + } + + /* Not found, remove allocated memory + * and return previous map. + */ + HRelease(p, hp_start + need, hp_start); + + *res = map; + return 1; + +found_key: + /* Copy rest of keys and values */ + if (n) { + sys_memcpy(mhp, vs+1, n*sizeof(Eterm)); + sys_memcpy(thp, ks+1, n*sizeof(Eterm)); + } + return 1; +} + +BIF_RETTYPE maps_remove_2(BIF_ALIST_2) { + if (is_map(BIF_ARG_2)) { + Eterm res; + if (erts_maps_remove(BIF_P, BIF_ARG_1, BIF_ARG_2, &res)) { + BIF_RET(res); + } + } + BIF_ERROR(BIF_P, BADARG); +} + +/* maps:update/3 + */ + +int erts_maps_update(Process *p, Eterm key, Eterm value, Eterm map, Eterm *res) { + Sint n,i; + Eterm* hp,*shp; + Eterm *ks,*vs; + map_t *mp = (map_t*)map_val(map); + + if ((n = map_get_size(mp)) == 0) { + return 0; + } + + ks = map_get_keys(mp); + vs = map_get_values(mp); + + /* only allocate for values, + * assume key-tuple will be intact + */ + + hp = HAlloc(p, MAP_HEADER_SIZE + n); + shp = hp; + *hp++ = MAP_HEADER; + *hp++ = n; + *hp++ = mp->keys; + + if (is_immed(key)) { + for( i = 0; i < n; i ++) { + if (ks[i] == key) { + goto found_key; + } else { + *hp++ = *vs++; + } + } + } else { + for( i = 0; i < n; i ++) { + if (EQ(ks[i], key)) { + goto found_key; + } else { + *hp++ = *vs++; + } + } + } + + HRelease(p, shp + MAP_HEADER_SIZE + n, shp); + return 0; + +found_key: + *hp++ = value; + vs++; + if (++i < n) + sys_memcpy(hp, vs, (n - i)*sizeof(Eterm)); + *res = make_map(shp); + return 1; +} + +BIF_RETTYPE maps_update_3(BIF_ALIST_3) { + if (is_map(BIF_ARG_3)) { + Eterm res; + if (erts_maps_update(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3, &res)) { + BIF_RET(res); + } + } + BIF_ERROR(BIF_P, BADARG); +} + + +/* maps:values/1 + */ + +BIF_RETTYPE maps_values_1(BIF_ALIST_1) { + if (is_map(BIF_ARG_1)) { + Eterm *hp, *vs, res = NIL; + map_t *mp; + Uint n; + + mp = (map_t*)map_val(BIF_ARG_1); + n = map_get_size(mp); + + if (n == 0) + BIF_RET(res); + + hp = HAlloc(BIF_P, (2 * n)); + vs = map_get_values(mp); + + while(n--) { + res = CONS(hp, vs[n], res); hp += 2; + } + + BIF_RET(res); + } + BIF_ERROR(BIF_P, BADARG); +} + +int erts_validate_and_sort_map(map_t* mp) +{ + Eterm *ks = map_get_keys(mp); + Eterm *vs = map_get_values(mp); + Uint sz = map_get_size(mp); + Uint ix,jx; + Eterm tmp; + int c; + + /* sort */ + + for (ix = 1; ix < sz; ix++) { + jx = ix; + while( jx > 0 && (c = CMP_TERM(ks[jx],ks[jx-1])) <= 0 ) { + /* identical key -> error */ + if (c == 0) return 0; + + tmp = ks[jx]; + ks[jx] = ks[jx - 1]; + ks[jx - 1] = tmp; + + tmp = vs[jx]; + vs[jx] = vs[jx - 1]; + vs[jx - 1] = tmp; + + jx--; + } + } + return 1; +} diff --git a/erts/emulator/beam/erl_map.h b/erts/emulator/beam/erl_map.h new file mode 100644 index 0000000000..cfacb2ec28 --- /dev/null +++ b/erts/emulator/beam/erl_map.h @@ -0,0 +1,72 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2014. 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_MAP_H__ +#define __ERL_MAP_H__ + +#include "sys.h" +/* MAP */ + +typedef struct map_s { + Eterm thing_word; + Uint size; + Eterm keys; /* tuple */ +} map_t; +/* map node + * + * ----------- + * Eterm THING + * Uint size + * Eterm Keys -> {K1, K2, K3, ..., Kn} where n = size + * ---- + * Eterm V1 + * ... + * Eterm Vn, where n = size + * ----------- + */ + + + +/* erl_term.h stuff */ +#define make_map(x) make_boxed((Eterm*)(x)) +#define make_map_rel(x, BASE) make_boxed_rel((Eterm*)(x),(BASE)) +#define is_map(x) (is_boxed((x)) && is_map_header(*boxed_val((x)))) +#define is_map_rel(RTERM,BASE) is_map(rterm2wterm(RTERM,BASE)) +#define is_not_map(x) (!is_map((x))) +#define is_map_header(x) (((x) & (_TAG_HEADER_MASK)) == _TAG_HEADER_MAP) +#define header_is_map(x) ((((x) & (_HEADER_SUBTAG_MASK)) == MAP_SUBTAG)) +#define map_val(x) (_unchecked_boxed_val((x))) +#define map_val_rel(RTERM, BASE) map_val(rterm2wterm(RTERM, BASE)) + +#define map_get_values(x) (((Eterm *)(x)) + 3) +#define map_get_keys(x) (((Eterm *)tuple_val(((map_t *)(x))->keys)) + 1) +#define map_get_size(x) (((map_t*)(x))->size) + +#define MAP_HEADER _make_header(1,_TAG_HEADER_MAP) +#define MAP_HEADER_SIZE (sizeof(map_t) / sizeof(Eterm)) + +Eterm erts_maps_put(Process *p, Eterm key, Eterm value, Eterm map); +int erts_maps_update(Process *p, Eterm key, Eterm value, Eterm map, Eterm *res); +int erts_maps_find(Eterm key, Eterm map, Eterm *value); +int erts_maps_get(Eterm key, Eterm map, Eterm *value); +int erts_maps_remove(Process *p, Eterm key, Eterm map, Eterm *res); +int erts_validate_and_sort_map(map_t* map); +#endif + diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c index e1e213c4eb..c35f1fc2c6 100644 --- a/erts/emulator/beam/erl_nif.c +++ b/erts/emulator/beam/erl_nif.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2009-2013. All Rights Reserved. + * Copyright Ericsson AB 2009-2014. 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 @@ -31,6 +31,7 @@ #include "bif.h" #include "error.h" #include "big.h" +#include "erl_map.h" #include "beam_bp.h" #include "erl_thr_progress.h" #include "dtrace-wrapper.h" @@ -1602,6 +1603,197 @@ enif_have_dirty_schedulers() #endif /* ERL_NIF_DIRTY_SCHEDULER_SUPPORT */ +/* Maps */ + +int enif_is_map(ErlNifEnv* env, ERL_NIF_TERM term) +{ + return is_map(term); +} + +int enif_get_map_size(ErlNifEnv* env, ERL_NIF_TERM term, size_t *size) +{ + if (is_map(term)) { + map_t *mp; + mp = (map_t*)map_val(term); + *size = map_get_size(mp); + return 1; + } + return 0; +} + +ERL_NIF_TERM enif_make_new_map(ErlNifEnv* env) +{ + Eterm* hp = alloc_heap(env,MAP_HEADER_SIZE+1); + Eterm tup; + map_t *mp; + + tup = make_tuple(hp); + *hp++ = make_arityval(0); + mp = (map_t*)hp; + mp->thing_word = MAP_HEADER; + mp->size = 0; + mp->keys = tup; + + return make_map(mp); +} + +int enif_make_map_put(ErlNifEnv* env, + Eterm map_in, + Eterm key, + Eterm value, + Eterm *map_out) +{ + if (is_not_map(map_in)) { + return 0; + } + flush_env(env); + *map_out = erts_maps_put(env->proc, key, value, map_in); + cache_env(env); + return 1; +} + +int enif_get_map_value(ErlNifEnv* env, + Eterm map, + Eterm key, + Eterm *value) +{ + if (is_not_map(map)) { + return 0; + } + return erts_maps_get(key, map, value); +} + +int enif_make_map_update(ErlNifEnv* env, + Eterm map_in, + Eterm key, + Eterm value, + Eterm *map_out) +{ + int res; + if (is_not_map(map_in)) { + return 0; + } + + flush_env(env); + res = erts_maps_update(env->proc, key, value, map_in, map_out); + cache_env(env); + return res; +} + +int enif_make_map_remove(ErlNifEnv* env, + Eterm map_in, + Eterm key, + Eterm *map_out) +{ + int res; + if (is_not_map(map_in)) { + return 0; + } + flush_env(env); + res = erts_maps_remove(env->proc, key, map_in, map_out); + cache_env(env); + return res; +} + +int enif_map_iterator_create(ErlNifEnv *env, + Eterm map, + ErlNifMapIterator *iter, + ErlNifMapIteratorEntry entry) +{ + if (is_map(map)) { + map_t *mp = (map_t*)map_val(map); + size_t offset; + + switch (entry) { + case ERL_NIF_MAP_ITERATOR_HEAD: offset = 0; break; + case ERL_NIF_MAP_ITERATOR_TAIL: offset = map_get_size(mp) - 1; break; + default: goto error; + } + + /* empty maps are ok but will leave the iterator + * in bad shape. + */ + + iter->map = map; + iter->ks = ((Eterm *)map_get_keys(mp)) + offset; + iter->vs = ((Eterm *)map_get_values(mp)) + offset; + iter->t_limit = map_get_size(mp) + 1; + iter->idx = offset + 1; + + return 1; + } + +error: +#ifdef DEBUG + iter->map = THE_NON_VALUE; +#endif + return 0; +} + +void enif_map_iterator_destroy(ErlNifEnv *env, ErlNifMapIterator *iter) +{ + /* not used */ +#ifdef DEBUG + iter->map = THE_NON_VALUE; +#endif + +} + +int enif_map_iterator_is_tail(ErlNifEnv *env, ErlNifMapIterator *iter) +{ + ASSERT(iter && is_map(iter->map)); + ASSERT(iter->idx >= 0 && (iter->idx <= map_get_size(map_val(iter->map)) + 1)); + return (iter->t_limit == 1 || iter->idx == iter->t_limit); +} + +int enif_map_iterator_is_head(ErlNifEnv *env, ErlNifMapIterator *iter) +{ + ASSERT(iter && is_map(iter->map)); + ASSERT(iter->idx >= 0 && (iter->idx <= map_get_size(map_val(iter->map)) + 1)); + return (iter->t_limit == 1 || iter->idx == 0); +} + + +int enif_map_iterator_next(ErlNifEnv *env, ErlNifMapIterator *iter) +{ + ASSERT(iter && is_map(iter->map)); + if (iter->idx < iter->t_limit) { + iter->idx++; + iter->ks++; + iter->vs++; + } + return (iter->idx != iter->t_limit); +} + +int enif_map_iterator_prev(ErlNifEnv *env, ErlNifMapIterator *iter) +{ + ASSERT(iter && is_map(iter->map)); + if (iter->idx > 0) { + iter->idx--; + iter->ks--; + iter->vs--; + } + return (iter->idx > 0); +} + +int enif_map_iterator_get_pair(ErlNifEnv *env, + ErlNifMapIterator *iter, + Eterm *key, + Eterm *value) +{ + ASSERT(iter && is_map(iter->map)); + if (iter->idx > 0 && iter->idx < iter->t_limit) { + ASSERT(iter->ks >= map_get_keys(map_val(iter->map)) && + iter->ks < (map_get_keys(map_val(iter->map)) + map_get_size(map_val(iter->map)))); + ASSERT(iter->vs >= map_get_values(map_val(iter->map)) && + iter->vs < (map_get_values(map_val(iter->map)) + map_get_size(map_val(iter->map)))); + *key = *(iter->ks); + *value = *(iter->vs); + return 1; + } + return 0; +} + /*************************************************************************** ** load_nif/2 ** ***************************************************************************/ @@ -1798,7 +1990,8 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2) ret = load_nif_error(BIF_P, bad_lib, "Library init-call unsuccessful"); } else if (entry->major != ERL_NIF_MAJOR_VERSION - || entry->minor > ERL_NIF_MINOR_VERSION) { + || entry->minor > ERL_NIF_MINOR_VERSION + || (entry->major==2 && entry->minor == 5)) { /* experimental maps */ ret = load_nif_error(BIF_P, bad_lib, "Library version (%d.%d) not compatible (with %d.%d).", entry->major, entry->minor, ERL_NIF_MAJOR_VERSION, ERL_NIF_MINOR_VERSION); diff --git a/erts/emulator/beam/erl_nif.h b/erts/emulator/beam/erl_nif.h index fb3c359ec9..7613446f64 100644 --- a/erts/emulator/beam/erl_nif.h +++ b/erts/emulator/beam/erl_nif.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2009-2013. All Rights Reserved. + * Copyright Ericsson AB 2009-2014. 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 @@ -38,14 +38,13 @@ ** 2.2: R14B03 enif_is_exception ** 2.3: R15 enif_make_reverse_list, enif_is_number ** 2.4: R16 enif_consume_timeslice -** 2.5: R17 dirty schedulers +** 2.5: First experimental maps API additions (libs of this version is not compatible with any other VM) +** 2.5: R17 Maps API additions +** 2.6: R17 with maps +** R17 dirty schedulers */ #define ERL_NIF_MAJOR_VERSION 2 -#ifdef ERL_NIF_DIRTY_SCHEDULER_SUPPORT -#define ERL_NIF_MINOR_VERSION 5 -#else -#define ERL_NIF_MINOR_VERSION 4 -#endif +#define ERL_NIF_MINOR_VERSION 6 #include <stdlib.h> @@ -104,6 +103,8 @@ typedef unsigned long long ERL_NIF_TERM; # endif #endif +typedef ERL_NIF_TERM ERL_NIF_UINT; + struct enif_environment_t; typedef struct enif_environment_t ErlNifEnv; @@ -176,6 +177,21 @@ typedef enum }ErlNifDirtyTaskFlags; #endif +typedef struct /* All fields all internal and may change */ +{ + ERL_NIF_TERM map; + ERL_NIF_UINT t_limit; + ERL_NIF_UINT idx; + ERL_NIF_TERM *ks; + ERL_NIF_TERM *vs; + void* __spare__[2]; /* for future additions to be ABI compatible (same struct size) */ +} ErlNifMapIterator; + +typedef enum { + ERL_NIF_MAP_ITERATOR_HEAD = 1, + ERL_NIF_MAP_ITERATOR_TAIL = 2 +} ErlNifMapIteratorEntry; + #if (defined(__WIN32__) || defined(_WIN32) || defined(_WIN32_)) # define ERL_NIF_API_FUNC_DECL(RET_TYPE, NAME, ARGS) RET_TYPE (*NAME) ARGS typedef struct { diff --git a/erts/emulator/beam/erl_nif_api_funcs.h b/erts/emulator/beam/erl_nif_api_funcs.h index f5b27dfdfa..d7c554e60b 100644 --- a/erts/emulator/beam/erl_nif_api_funcs.h +++ b/erts/emulator/beam/erl_nif_api_funcs.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2009-2013. All Rights Reserved. + * Copyright Ericsson AB 2009-2014. 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 @@ -149,6 +149,22 @@ ERL_NIF_API_FUNC_DECL(int,enif_is_on_dirty_scheduler,(ErlNifEnv*)); ERL_NIF_API_FUNC_DECL(int,enif_have_dirty_schedulers,(void)); #endif +ERL_NIF_API_FUNC_DECL(int, enif_is_map, (ErlNifEnv* env, ERL_NIF_TERM term)); +ERL_NIF_API_FUNC_DECL(int, enif_get_map_size, (ErlNifEnv* env, ERL_NIF_TERM term, size_t *size)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM, enif_make_new_map, (ErlNifEnv* env)); +ERL_NIF_API_FUNC_DECL(int, enif_make_map_put, (ErlNifEnv* env, ERL_NIF_TERM map_in, ERL_NIF_TERM key, ERL_NIF_TERM value, ERL_NIF_TERM* map_out)); +ERL_NIF_API_FUNC_DECL(int, enif_get_map_value, (ErlNifEnv* env, ERL_NIF_TERM map, ERL_NIF_TERM key, ERL_NIF_TERM* value)); +ERL_NIF_API_FUNC_DECL(int, enif_make_map_update, (ErlNifEnv* env, ERL_NIF_TERM map_in, ERL_NIF_TERM key, ERL_NIF_TERM value, ERL_NIF_TERM* map_out)); +ERL_NIF_API_FUNC_DECL(int, enif_make_map_remove, (ErlNifEnv* env, ERL_NIF_TERM map_in, ERL_NIF_TERM key, ERL_NIF_TERM* map_out)); +ERL_NIF_API_FUNC_DECL(int, enif_map_iterator_create, (ErlNifEnv *env, ERL_NIF_TERM map, ErlNifMapIterator *iter, ErlNifMapIteratorEntry entry)); +ERL_NIF_API_FUNC_DECL(void, enif_map_iterator_destroy, (ErlNifEnv *env, ErlNifMapIterator *iter)); +ERL_NIF_API_FUNC_DECL(int, enif_map_iterator_is_head, (ErlNifEnv *env, ErlNifMapIterator *iter)); +ERL_NIF_API_FUNC_DECL(int, enif_map_iterator_is_tail, (ErlNifEnv *env, ErlNifMapIterator *iter)); +ERL_NIF_API_FUNC_DECL(int, enif_map_iterator_next, (ErlNifEnv *env, ErlNifMapIterator *iter)); +ERL_NIF_API_FUNC_DECL(int, enif_map_iterator_prev, (ErlNifEnv *env, ErlNifMapIterator *iter)); +ERL_NIF_API_FUNC_DECL(int, enif_map_iterator_get_pair, (ErlNifEnv *env, ErlNifMapIterator *iter, ERL_NIF_TERM *key, ERL_NIF_TERM *value)); + + /* ** Add new entries here to keep compatibility on Windows!!! */ @@ -281,6 +297,21 @@ ERL_NIF_API_FUNC_DECL(int,enif_have_dirty_schedulers,(void)); # define enif_have_dirty_schedulers ERL_NIF_API_FUNC_MACRO(enif_have_dirty_schedulers) #endif +# define enif_is_map ERL_NIF_API_FUNC_MACRO(enif_is_map) +# define enif_get_map_size ERL_NIF_API_FUNC_MACRO(enif_get_map_size) +# define enif_make_new_map ERL_NIF_API_FUNC_MACRO(enif_make_new_map) +# define enif_make_map_put ERL_NIF_API_FUNC_MACRO(enif_make_map_put) +# define enif_get_map_value ERL_NIF_API_FUNC_MACRO(enif_get_map_value) +# define enif_make_map_update ERL_NIF_API_FUNC_MACRO(enif_make_map_update) +# define enif_make_map_remove ERL_NIF_API_FUNC_MACRO(enif_make_map_remove) +# define enif_map_iterator_create ERL_NIF_API_FUNC_MACRO(enif_map_iterator_create) +# define enif_map_iterator_destroy ERL_NIF_API_FUNC_MACRO(enif_map_iterator_destroy) +# define enif_map_iterator_is_head ERL_NIF_API_FUNC_MACRO(enif_map_iterator_is_head) +# define enif_map_iterator_is_tail ERL_NIF_API_FUNC_MACRO(enif_map_iterator_is_tail) +# define enif_map_iterator_next ERL_NIF_API_FUNC_MACRO(enif_map_iterator_next) +# define enif_map_iterator_prev ERL_NIF_API_FUNC_MACRO(enif_map_iterator_prev) +# define enif_map_iterator_get_pair ERL_NIF_API_FUNC_MACRO(enif_map_iterator_get_pair) + /* ** Add new entries here */ diff --git a/erts/emulator/beam/erl_printf_term.c b/erts/emulator/beam/erl_printf_term.c index 436147749e..d18760dc43 100644 --- a/erts/emulator/beam/erl_printf_term.c +++ b/erts/emulator/beam/erl_printf_term.c @@ -24,6 +24,7 @@ #include "erl_printf_term.h" #include "sys.h" #include "big.h" +#include "erl_map.h" #define PRINT_CHAR(CNT, FN, ARG, C) \ do { \ @@ -216,14 +217,15 @@ static int print_atom_name(fmtfn_t fn, void* arg, Eterm atom, long *dcount) } -#define PRT_BAR ((Eterm) 0) -#define PRT_COMMA ((Eterm) 1) -#define PRT_CLOSE_LIST ((Eterm) 2) -#define PRT_CLOSE_TUPLE ((Eterm) 3) -#define PRT_TERM ((Eterm) 4) -#define PRT_ONE_CONS ((Eterm) 5) -#define PRT_PATCH_FUN_SIZE ((Eterm) 6) -#define PRT_LAST_ARRAY_ELEMENT ((Eterm) 7) /* Note! Must be last... */ +#define PRT_BAR ((Eterm) 0) +#define PRT_COMMA ((Eterm) 1) +#define PRT_CLOSE_LIST ((Eterm) 2) +#define PRT_CLOSE_TUPLE ((Eterm) 3) +#define PRT_ASSOC ((Eterm) 4) +#define PRT_TERM ((Eterm) 5) +#define PRT_ONE_CONS ((Eterm) 6) +#define PRT_PATCH_FUN_SIZE ((Eterm) 7) +#define PRT_LAST_ARRAY_ELEMENT ((Eterm) 8) /* Note! Must be last... */ static int print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount, @@ -260,6 +262,9 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount, case PRT_CLOSE_TUPLE: PRINT_CHAR(res, fn, arg, '}'); goto L_outer_loop; + case PRT_ASSOC: + PRINT_STRING(res, fn, arg, "=>"); + goto L_outer_loop; default: popped.word = WSTACK_POP(s); @@ -483,6 +488,37 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount, PRINT_CHAR(res, fn, arg, '>'); } break; + case MAP_DEF: + { + Uint n; + Eterm *ks, *vs; + map_t *mp = (map_t *)map_val(wobj); + n = map_get_size(mp); + ks = map_get_keys(mp); + vs = map_get_values(mp); + + PRINT_CHAR(res, fn, arg, '#'); + PRINT_CHAR(res, fn, arg, '{'); + WSTACK_PUSH(s, PRT_CLOSE_TUPLE); + if (n > 0) { + n--; + WSTACK_PUSH(s, vs[n]); + WSTACK_PUSH(s, PRT_TERM); + WSTACK_PUSH(s, PRT_ASSOC); + WSTACK_PUSH(s, ks[n]); + WSTACK_PUSH(s, PRT_TERM); + + while (n--) { + WSTACK_PUSH(s, PRT_COMMA); + WSTACK_PUSH(s, vs[n]); + WSTACK_PUSH(s, PRT_TERM); + WSTACK_PUSH(s, PRT_ASSOC); + WSTACK_PUSH(s, ks[n]); + WSTACK_PUSH(s, PRT_TERM); + } + } + } + break; default: PRINT_STRING(res, fn, arg, "<unknown:"); PRINT_POINTER(res, fn, arg, wobj); diff --git a/erts/emulator/beam/erl_term.c b/erts/emulator/beam/erl_term.c index 2f206ffbec..28cbe7004f 100644 --- a/erts/emulator/beam/erl_term.c +++ b/erts/emulator/beam/erl_term.c @@ -23,6 +23,7 @@ #include "sys.h" #include "erl_vm.h" #include "global.h" +#include "erl_map.h" #include <stdlib.h> #include <stdio.h> @@ -85,7 +86,10 @@ unsigned tag_val_def(Wterm x) case (_TAG_HEADER_EXTERNAL_PID >> _TAG_PRIMARY_SIZE): return EXTERNAL_PID_DEF; case (_TAG_HEADER_EXTERNAL_PORT >> _TAG_PRIMARY_SIZE): return EXTERNAL_PORT_DEF; case (_TAG_HEADER_EXTERNAL_REF >> _TAG_PRIMARY_SIZE): return EXTERNAL_REF_DEF; - default: return BINARY_DEF; + case (_TAG_HEADER_REFC_BIN >> _TAG_PRIMARY_SIZE): return BINARY_DEF; + case (_TAG_HEADER_HEAP_BIN >> _TAG_PRIMARY_SIZE): return BINARY_DEF; + case (_TAG_HEADER_SUB_BIN >> _TAG_PRIMARY_SIZE): return BINARY_DEF; + case (_TAG_HEADER_MAP >> _TAG_PRIMARY_SIZE): return MAP_DEF; } break; } diff --git a/erts/emulator/beam/erl_term.h b/erts/emulator/beam/erl_term.h index 50d3e63c58..f10a3a9d38 100644 --- a/erts/emulator/beam/erl_term.h +++ b/erts/emulator/beam/erl_term.h @@ -135,11 +135,12 @@ struct erl_node_; /* Declared in erl_node_tables.h */ #define REF_SUBTAG (0x4 << _TAG_PRIMARY_SIZE) /* REF */ #define FUN_SUBTAG (0x5 << _TAG_PRIMARY_SIZE) /* FUN */ #define FLOAT_SUBTAG (0x6 << _TAG_PRIMARY_SIZE) /* FLOAT */ -#define EXPORT_SUBTAG (0x7 << _TAG_PRIMARY_SIZE) /* FLOAT */ +#define EXPORT_SUBTAG (0x7 << _TAG_PRIMARY_SIZE) /* FLOAT */ #define _BINARY_XXX_MASK (0x3 << _TAG_PRIMARY_SIZE) #define REFC_BINARY_SUBTAG (0x8 << _TAG_PRIMARY_SIZE) /* BINARY */ #define HEAP_BINARY_SUBTAG (0x9 << _TAG_PRIMARY_SIZE) /* BINARY */ #define SUB_BINARY_SUBTAG (0xA << _TAG_PRIMARY_SIZE) /* BINARY */ +#define MAP_SUBTAG (0xB << _TAG_PRIMARY_SIZE) /* MAP */ #define EXTERNAL_PID_SUBTAG (0xC << _TAG_PRIMARY_SIZE) /* EXTERNAL_PID */ #define EXTERNAL_PORT_SUBTAG (0xD << _TAG_PRIMARY_SIZE) /* EXTERNAL_PORT */ #define EXTERNAL_REF_SUBTAG (0xE << _TAG_PRIMARY_SIZE) /* EXTERNAL_REF */ @@ -155,6 +156,7 @@ struct erl_node_; /* Declared in erl_node_tables.h */ #define _TAG_HEADER_REFC_BIN (TAG_PRIMARY_HEADER|REFC_BINARY_SUBTAG) #define _TAG_HEADER_HEAP_BIN (TAG_PRIMARY_HEADER|HEAP_BINARY_SUBTAG) #define _TAG_HEADER_SUB_BIN (TAG_PRIMARY_HEADER|SUB_BINARY_SUBTAG) +#define _TAG_HEADER_MAP (TAG_PRIMARY_HEADER|MAP_SUBTAG) #define _TAG_HEADER_EXTERNAL_PID (TAG_PRIMARY_HEADER|EXTERNAL_PID_SUBTAG) #define _TAG_HEADER_EXTERNAL_PORT (TAG_PRIMARY_HEADER|EXTERNAL_PORT_SUBTAG) #define _TAG_HEADER_EXTERNAL_REF (TAG_PRIMARY_HEADER|EXTERNAL_REF_SUBTAG) @@ -354,7 +356,10 @@ _ET_DECLARE_CHECKED(Uint,thing_subtag,Eterm) #define is_value(x) ((x) != THE_NON_VALUE) /* binary object access methods */ -#define is_binary_header(x) (((x) & (_TAG_HEADER_MASK-_BINARY_XXX_MASK)) == _TAG_HEADER_REFC_BIN) +#define is_binary_header(x) \ + ((((x) & (_TAG_HEADER_MASK)) == _TAG_HEADER_REFC_BIN) || \ + (((x) & (_TAG_HEADER_MASK)) == _TAG_HEADER_HEAP_BIN) || \ + (((x) & (_TAG_HEADER_MASK)) == _TAG_HEADER_SUB_BIN)) #define make_binary(x) make_boxed((Eterm*)(x)) #define is_binary(x) (is_boxed((x)) && is_binary_header(*boxed_val((x)))) #define is_not_binary(x) (!is_binary((x))) @@ -1064,8 +1069,8 @@ _ET_DECLARE_CHECKED(Uint,y_reg_index,Uint) /* * Backwards compatibility definitions: - * - #define virtal *_DEF constants with values that fit term order: - * number < atom < ref < fun < port < pid < tuple < nil < cons < binary + * - #define virtual *_DEF constants with values that fit term order: + * number < atom < ref < fun < port < pid < tuple < map < nil < cons < binary * - tag_val_def() function generates virtual _DEF tag * - not_eq_tags() and NUMBER_CODE() defined in terms * of the tag_val_def() function @@ -1074,19 +1079,20 @@ _ET_DECLARE_CHECKED(Uint,y_reg_index,Uint) #define BINARY_DEF 0x0 #define LIST_DEF 0x1 #define NIL_DEF 0x2 -#define TUPLE_DEF 0x3 -#define PID_DEF 0x4 -#define EXTERNAL_PID_DEF 0x5 -#define PORT_DEF 0x6 -#define EXTERNAL_PORT_DEF 0x7 -#define EXPORT_DEF 0x8 -#define FUN_DEF 0x9 -#define REF_DEF 0xa -#define EXTERNAL_REF_DEF 0xb -#define ATOM_DEF 0xc -#define FLOAT_DEF 0xd -#define BIG_DEF 0xe -#define SMALL_DEF 0xf +#define MAP_DEF 0x3 +#define TUPLE_DEF 0x4 +#define PID_DEF 0x5 +#define EXTERNAL_PID_DEF 0x6 +#define PORT_DEF 0x7 +#define EXTERNAL_PORT_DEF 0x8 +#define EXPORT_DEF 0x9 +#define FUN_DEF 0xa +#define REF_DEF 0xb +#define EXTERNAL_REF_DEF 0xc +#define ATOM_DEF 0xd +#define FLOAT_DEF 0xe +#define BIG_DEF 0xf +#define SMALL_DEF 0x10 #if ET_DEBUG extern unsigned tag_val_def_debug(Wterm, const char*, unsigned); @@ -1096,8 +1102,8 @@ extern unsigned tag_val_def(Wterm); #endif #define not_eq_tags(X,Y) (tag_val_def((X)) ^ tag_val_def((Y))) -#define NUMBER_CODE(x,y) ((tag_val_def(x) << 4) | tag_val_def(y)) -#define _NUMBER_CODE(TX,TY) ((TX << 4) | TY) +#define NUMBER_CODE(x,y) ((tag_val_def(x) << 5) | tag_val_def(y)) +#define _NUMBER_CODE(TX,TY) ((TX << 5) | TY) #define SMALL_SMALL _NUMBER_CODE(SMALL_DEF,SMALL_DEF) #define SMALL_BIG _NUMBER_CODE(SMALL_DEF,BIG_DEF) #define SMALL_FLOAT _NUMBER_CODE(SMALL_DEF,FLOAT_DEF) diff --git a/erts/emulator/beam/erl_utils.h b/erts/emulator/beam/erl_utils.h index 292d135946..5b81d814c6 100644 --- a/erts/emulator/beam/erl_utils.h +++ b/erts/emulator/beam/erl_utils.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2012-2013. All Rights Reserved. + * Copyright Ericsson AB 2012-2014. 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 @@ -202,23 +202,37 @@ int eq(Eterm, Eterm); #define EQ(x,y) (((x) == (y)) || (is_not_both_immed((x),(y)) && eq((x),(y)))) #if HALFWORD_HEAP -Sint cmp_rel(Eterm, Eterm*, Eterm, Eterm*); -#define CMP(A,B) cmp_rel(A,NULL,B,NULL) +Sint cmp_rel_opt(Eterm, Eterm*, Eterm, Eterm*, int); +#define cmp_rel(A,A_BASE,B,B_BASE) cmp_rel_opt(A,A_BASE,B,B_BASE,0) +#define cmp_rel_term(A,A_BASE,B,B_BASE) cmp_rel_opt(A,A_BASE,B,B_BASE,1) +#define CMP(A,B) cmp_rel_opt(A,NULL,B,NULL,0) +#define CMP_TERM(A,B) cmp_rel_opt(A,NULL,B,NULL,1) #else -Sint cmp(Eterm, Eterm); -#define cmp_rel(A,A_BASE,B,B_BASE) cmp(A,B) -#define CMP(A,B) cmp(A,B) +Sint cmp(Eterm, Eterm, int); +#define cmp_rel(A,A_BASE,B,B_BASE) cmp(A,B,0) +#define cmp_rel_term(A,A_BASE,B,B_BASE) cmp(A,B,1) +#define CMP(A,B) cmp(A,B,0) +#define CMP_TERM(A,B) cmp(A,B,1) #endif -#define cmp_lt(a,b) (CMP((a),(b)) < 0) -#define cmp_le(a,b) (CMP((a),(b)) <= 0) -#define cmp_eq(a,b) (CMP((a),(b)) == 0) -#define cmp_ne(a,b) (CMP((a),(b)) != 0) -#define cmp_ge(a,b) (CMP((a),(b)) >= 0) -#define cmp_gt(a,b) (CMP((a),(b)) > 0) - -#define CMP_LT(a,b) ((a) != (b) && cmp_lt((a),(b))) -#define CMP_GE(a,b) ((a) == (b) || cmp_ge((a),(b))) -#define CMP_EQ(a,b) ((a) == (b) || cmp_eq((a),(b))) -#define CMP_NE(a,b) ((a) != (b) && cmp_ne((a),(b))) + +#define cmp_lt(a,b) (CMP((a),(b)) < 0) +#define cmp_le(a,b) (CMP((a),(b)) <= 0) +#define cmp_eq(a,b) (CMP((a),(b)) == 0) +#define cmp_ne(a,b) (CMP((a),(b)) != 0) +#define cmp_ge(a,b) (CMP((a),(b)) >= 0) +#define cmp_gt(a,b) (CMP((a),(b)) > 0) + +#define cmp_lt_term(a,b) (CMP_TERM((a),(b)) < 0) +#define cmp_le_term(a,b) (CMP_TERM((a),(b)) <= 0) +#define cmp_ge_term(a,b) (CMP_TERM((a),(b)) >= 0) +#define cmp_gt_term(a,b) (CMP_TERM((a),(b)) > 0) + +#define CMP_LT(a,b) ((a) != (b) && cmp_lt((a),(b))) +#define CMP_GE(a,b) ((a) == (b) || cmp_ge((a),(b))) +#define CMP_EQ(a,b) ((a) == (b) || cmp_eq((a),(b))) +#define CMP_NE(a,b) ((a) != (b) && cmp_ne((a),(b))) + +#define CMP_LT_TERM(a,b) ((a) != (b) && cmp_lt_term((a),(b))) +#define CMP_GE_TERM(a,b) ((a) == (b) || cmp_ge_term((a),(b))) #endif diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c index 5e7a5cab6e..a4cc3435c3 100644 --- a/erts/emulator/beam/external.c +++ b/erts/emulator/beam/external.c @@ -42,6 +42,7 @@ #include "erl_binary.h" #include "erl_bits.h" #include "erl_zlib.h" +#include "erl_map.h" #ifdef HIPE #include "hipe_mode_switch.h" @@ -2555,6 +2556,38 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, } break; + case MAP_DEF: + { + map_t *mp = (map_t*)map_val(obj); + Uint size = map_get_size(mp); + Eterm *mptr; + + *ep++ = MAP_EXT; + put_int32(size, ep); ep += 4; + + /* Push values first */ + if (size > 0) { + mptr = map_get_values(mp); + for (i = size-1; i >= 1; i--) { + WSTACK_PUSH(s, ENC_TERM); + WSTACK_PUSH(s, (UWord) mptr[i]); + } + + WSTACK_PUSH(s, ENC_TERM); + WSTACK_PUSH(s, (UWord) mptr[0]); + + mptr = map_get_keys(mp); + for (i = size-1; i >= 1; i--) { + WSTACK_PUSH(s, ENC_TERM); + WSTACK_PUSH(s, (UWord) mptr[i]); + } + + obj = mptr[0]; + goto L_jump_start; + } + } + break; + case FLOAT_DEF: GET_DOUBLE(obj, f); if (dflags & DFLAG_NEW_FLOATS) { @@ -2845,6 +2878,7 @@ dec_term(ErtsDistExternal *edep, Eterm** hpp, byte* ep, ErlOffHeap* off_heap, int n; ErtsAtomEncoding char_enc; register Eterm* hp; /* Please don't take the address of hp */ + Eterm *maps_head = NULL; /* for validation of maps */ Eterm* next; SWord reds; @@ -3469,6 +3503,65 @@ dec_term_atom_common: break; } break; + case MAP_EXT: + { + map_t *mp; + Uint32 size,n; + Eterm *kptr,*vptr; + Eterm keys; + + size = get_int32(ep); ep += 4; + + keys = make_tuple(hp); + *hp++ = make_arityval(size); + kptr = hp; + hp += size; + + mp = (map_t*)hp; + hp += MAP_HEADER_SIZE; + vptr = hp; + hp += size; + + /* kptr, first word for keys + * vptr, first word for values + */ + + /* + * Use thing_word to link through decoded maps. + * The list of maps is for later validation. + */ + + mp->thing_word = (Eterm) COMPRESS_POINTER(maps_head); + maps_head = (Eterm *) mp; + + mp->size = size; + mp->keys = keys; + *objp = make_map(mp); + + /* We assume the map is wellformed, meaning: + * - ascending key order + * - unique keys + */ + + objp = vptr + size - 1; + n = size; + + while (n-- > 0) { + *objp = (Eterm) COMPRESS_POINTER(next); + next = objp; + objp--; + } + + objp = kptr + size - 1; + n = size; + + while (n-- > 0) { + *objp = (Eterm) COMPRESS_POINTER(next); + next = objp; + objp--; + } + } + break; case NEW_FUN_EXT: { ErlFunThing* funp = (ErlFunThing *) hp; @@ -3678,21 +3771,7 @@ dec_term_atom_common: } default: - error: - /* UNDO: - * Must unlink all off-heap objects that may have been - * linked into the process. - */ - if (hp < *hpp) { /* Sometimes we used hp and sometimes *hpp */ - hp = *hpp; /* the largest must be the freshest */ - } - undo_offheap_in_area(off_heap, hp_saved, hp); - *hpp = hp_saved; - if (ctx) { - ctx->state = B2TDecodeFail; - ctx->reds = reds; - } - return NULL; + goto error; } if (--reds <= 0) { @@ -3710,12 +3789,43 @@ dec_term_atom_common: } } } + + /* Iterate through all the maps and check for validity and sort keys + * - done here for when we know it is complete. + */ + + while (maps_head) { + next = (Eterm *)(EXPAND_POINTER(*maps_head)); + *maps_head = MAP_HEADER; + if (!erts_validate_and_sort_map((map_t*)maps_head)) + goto error; + maps_head = next; + } + if (ctx) { ctx->state = B2TDone; ctx->reds = reds; } + *hpp = hp; return ep; + +error: + /* UNDO: + * Must unlink all off-heap objects that may have been + * linked into the process. + */ + if (hp < *hpp) { /* Sometimes we used hp and sometimes *hpp */ + hp = *hpp; /* the largest must be the freshest */ + } + undo_offheap_in_area(off_heap, hp_saved, hp); + *hpp = hp_saved; + if (ctx) { + ctx->state = B2TDecodeFail; + ctx->reds = reds; + } + + return NULL; } /* returns the number of bytes needed to encode an object @@ -3885,6 +3995,46 @@ encode_size_struct_int(TTBSizeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, goto outer_loop; } break; + case MAP_DEF: + { + map_t *mp = (map_t*)map_val(obj); + Uint size = map_get_size(mp); + Uint i; + Eterm *ptr; + + result += 1 + 4; /* tag + 4 bytes size */ + + /* push values first */ + ptr = map_get_values(mp); + i = size; + while(i--) { + if (is_list(*ptr)) { + if ((m = is_string(*ptr)) && (m < MAX_STRING_LEN)) { + result += m + 2 + 1; + } else { + result += 5; + } + } + ESTACK_PUSH(s,*ptr); + ++ptr; + } + + ptr = map_get_keys(mp); + i = size; + while(i--) { + if (is_list(*ptr)) { + if ((m = is_string(*ptr)) && (m < MAX_STRING_LEN)) { + result += m + 2 + 1; + } else { + result += 5; + } + } + ESTACK_PUSH(s,*ptr); + ++ptr; + } + goto outer_loop; + } + break; case FLOAT_DEF: if (dflags & DFLAG_NEW_FLOATS) { result += 9; @@ -4175,6 +4325,13 @@ init_done: ADDTERMS(n); heap_size += n + 1; break; + case MAP_EXT: + CHKSIZE(4); + n = get_int32(ep); + ep += 4; + ADDTERMS(2*n); + heap_size += 3 + n + 1 + n; + break; case STRING_EXT: CHKSIZE(2); n = get_int16(ep); diff --git a/erts/emulator/beam/external.h b/erts/emulator/beam/external.h index 83001b2c7e..bf00958eb1 100644 --- a/erts/emulator/beam/external.h +++ b/erts/emulator/beam/external.h @@ -50,6 +50,7 @@ #define LARGE_BIG_EXT 'o' #define NEW_FUN_EXT 'p' #define EXPORT_EXT 'q' +#define MAP_EXT 't' #define FUN_EXT 'u' #define ATOM_UTF8_EXT 'v' #define SMALL_ATOM_UTF8_EXT 'w' diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index 83a8911a36..8fcb95d0e2 100755 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -998,6 +998,7 @@ Eterm erts_gc_length_1(Process* p, Eterm* reg, Uint live); Eterm erts_gc_size_1(Process* p, Eterm* reg, Uint live); Eterm erts_gc_bit_size_1(Process* p, Eterm* reg, Uint live); Eterm erts_gc_byte_size_1(Process* p, Eterm* reg, Uint live); +Eterm erts_gc_map_size_1(Process* p, Eterm* reg, Uint live); Eterm erts_gc_abs_1(Process* p, Eterm* reg, Uint live); Eterm erts_gc_float_1(Process* p, Eterm* reg, Uint live); Eterm erts_gc_round_1(Process* p, Eterm* reg, Uint live); diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c index 49af86b36a..3b16cdeb4a 100644 --- a/erts/emulator/beam/io.c +++ b/erts/emulator/beam/io.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2013. All Rights Reserved. + * Copyright Ericsson AB 1996-2014. 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 @@ -46,6 +46,7 @@ #define ERTS_WANT_EXTERNAL_TAGS #include "external.h" #include "dtrace-wrapper.h" +#include "erl_map.h" extern ErlDrvEntry fd_driver_entry; extern ErlDrvEntry vanilla_driver_entry; @@ -5293,6 +5294,17 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len) depth++; break; } + case ERL_DRV_MAP: { /* int */ + ERTS_DDT_CHK_ENOUGH_ARGS(1); + if ((int) ptr[0] < 0) ERTS_DDT_FAIL; + need += MAP_HEADER_SIZE + 1 + 2*ptr[0]; + depth -= 2*ptr[0]; + if (depth < 0) ERTS_DDT_FAIL; + ptr++; + depth++; + break; + } + default: ERTS_DDT_FAIL; } @@ -5529,6 +5541,36 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len) ptr += 2; break; + case ERL_DRV_MAP: { /* int */ + int size = (int)ptr[0]; + Eterm* tp = hp; + Eterm* vp; + map_t *mp; + + *tp = make_arityval(size); + + hp += 1 + size; + mp = (map_t*)hp; + mp->thing_word = MAP_HEADER; + mp->size = size; + mp->keys = make_tuple(tp); + mess = make_map(mp); + + hp += MAP_HEADER_SIZE + size; /* advance "heap" pointer */ + + tp += size; /* point at last key */ + vp = hp - 1; /* point at last value */ + + while(size--) { + *vp-- = ESTACK_POP(stack); + *tp-- = ESTACK_POP(stack); + } + if (!erts_validate_and_sort_map(mp)) + ERTS_DDT_FAIL; + ptr++; + break; + } + } ESTACK_PUSH(stack, mess); } diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab index c29f3f9b1b..f35997efee 100644 --- a/erts/emulator/beam/ops.tab +++ b/erts/emulator/beam/ops.tab @@ -1466,6 +1466,75 @@ apply I apply_last I P # +# Map instructions in R17. +# + +# put_map Fail Src Dst Live Size Rest=* => jump Fail +# is_map Fail Src => jump Fail +# has_map_field Fail Src Key => jump Fail +# get_map_element Fail Src Key Dst => jump Fail + +put_map_assoc F n Dst Live Size Rest=* => new_map F Dst Live Size Rest +put_map_exact F n Dst Live Size Rest=* => new_map F Dst Live Size Rest +put_map_assoc F Src Dst Live Size Rest=* => \ + update_map_assoc F Src Dst Live Size Rest +put_map_exact F Src Dst Live Size Rest=* => \ + update_map_exact F Src Dst Live Size Rest + +new_map j d I I +update_map_assoc j d d I I +update_map_exact j d d I I + +is_map Fail cq => jump Fail + +%macro: is_map IsMap -fail_action +is_map f r +is_map f x +is_map f y + +has_map_field Fail Src=rxy Key=arxy => i_has_map_field Fail Src Key +has_map_field Fail Src Key => move Key x | i_has_map_field Fail Src x + +%macro: i_has_map_field HasMapField -fail_action +i_has_map_field f r a +i_has_map_field f x a +i_has_map_field f y a +i_has_map_field f r r +i_has_map_field f x r +i_has_map_field f y r +i_has_map_field f r x +i_has_map_field f x x +i_has_map_field f y x +i_has_map_field f r y +i_has_map_field f x y +i_has_map_field f y y + +get_map_element Fail Src=rxy Key=ax Dst => i_get_map_element Fail Src Key Dst +get_map_element Fail Src=rxy Key=rycq Dst => \ + move Key x | i_get_map_element Fail Src x Dst +get_map_element Fail Src Key Dst => jump Fail + +%macro: i_get_map_element GetMapElement -fail_action +i_get_map_element f r a r +i_get_map_element f x a r +i_get_map_element f y a r +i_get_map_element f r a x +i_get_map_element f x a x +i_get_map_element f y a x +i_get_map_element f r a y +i_get_map_element f x a y +i_get_map_element f y a y +i_get_map_element f r x r +i_get_map_element f x x r +i_get_map_element f y x r +i_get_map_element f r x x +i_get_map_element f x x x +i_get_map_element f y x x +i_get_map_element f r x y +i_get_map_element f x x y +i_get_map_element f y x y + +# # Optimize addition and subtraction of small literals using # the i_increment/4 instruction (in bodies, not in guards). # diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c index e0776cf67d..bc4a05d385 100644 --- a/erts/emulator/beam/utils.c +++ b/erts/emulator/beam/utils.c @@ -31,6 +31,7 @@ #include "bif.h" #include "erl_binary.h" #include "erl_bits.h" +#include "erl_map.h" #include "packet_parser.h" #include "erl_gc.h" #define ERTS_WANT_DB_INTERNAL__ @@ -734,6 +735,8 @@ erts_bld_atom_2uint_3tup_list(Uint **hpp, Uint *szp, Sint length, #define FUNNY_NUMBER10 268440479 #define FUNNY_NUMBER11 268440577 #define FUNNY_NUMBER12 268440581 +#define FUNNY_NUMBER13 268440593 +#define FUNNY_NUMBER14 268440611 static Uint32 hash_binary_bytes(Eterm bin, Uint sz, Uint32 hash) @@ -785,10 +788,10 @@ Uint32 make_hash(Eterm term_arg) unsigned op; /* Must not collide with the real tag_val_def's: */ -#define MAKE_HASH_TUPLE_OP 0x10 -#define MAKE_HASH_FUN_OP 0x11 -#define MAKE_HASH_CDR_PRE_OP 0x12 -#define MAKE_HASH_CDR_POST_OP 0x13 +#define MAKE_HASH_TUPLE_OP 0x11 +#define MAKE_HASH_TERM_ARRAY_OP 0x12 +#define MAKE_HASH_CDR_PRE_OP 0x13 +#define MAKE_HASH_CDR_POST_OP 0x14 /* ** Convenience macro for calculating a bytewise hash on an unsigned 32 bit @@ -877,7 +880,7 @@ tail_recur: hash = hash*FUNNY_NUMBER2 + funp->fe->old_uniq; if (num_free > 0) { if (num_free > 1) { - WSTACK_PUSH3(stack, (UWord) &funp->env[1], (num_free-1), MAKE_HASH_FUN_OP); + WSTACK_PUSH3(stack, (UWord) &funp->env[1], (num_free-1), MAKE_HASH_TERM_ARRAY_OP); } term = funp->env[0]; goto tail_recur; @@ -967,6 +970,24 @@ tail_recur: hash *= is_neg ? FUNNY_NUMBER4 : FUNNY_NUMBER3; break; } + case MAP_DEF: + { + map_t *mp = (map_t *)map_val(term); + int size = map_get_size(mp); + Eterm *ks = map_get_keys(mp); + Eterm *vs = map_get_values(mp); + + /* Use a prime with size to remedy some of + * the {} and <<>> hash problems */ + hash = hash*FUNNY_NUMBER13 + FUNNY_NUMBER14 + size; + if (size == 0) + break; + + /* push values first */ + WSTACK_PUSH3(stack, (UWord)vs, (UWord) size, MAKE_HASH_TERM_ARRAY_OP); + WSTACK_PUSH3(stack, (UWord)ks, (UWord) size, MAKE_HASH_TERM_ARRAY_OP); + break; + } case TUPLE_DEF: { Eterm* ptr = tuple_val(term); @@ -976,7 +997,7 @@ tail_recur: op = MAKE_HASH_TUPLE_OP; }/*fall through*/ case MAKE_HASH_TUPLE_OP: - case MAKE_HASH_FUN_OP: + case MAKE_HASH_TERM_ARRAY_OP: { Uint i = (Uint) WSTACK_POP(stack); Eterm* ptr = (Eterm*) WSTACK_POP(stack); @@ -1070,9 +1091,11 @@ Uint32 make_hash2(Eterm term) { Uint32 hash; + Uint32 hash_xor_keys = 0; + Uint32 hash_xor_values = 0; DeclareTmpHeapNoproc(tmp_big,2); -/* (HCONST * {2, ..., 14}) mod 2^32 */ +/* (HCONST * {2, ..., 16}) mod 2^32 */ #define HCONST_2 0x3c6ef372UL #define HCONST_3 0xdaa66d2bUL #define HCONST_4 0x78dde6e4UL @@ -1087,6 +1110,11 @@ make_hash2(Eterm term) #define HCONST_13 0x08d12e65UL #define HCONST_14 0xa708a81eUL #define HCONST_15 0x454021d7UL +#define HCONST_16 0xe3779b90UL + +#define HASH_MAP_TAIL (_make_header(1,_TAG_HEADER_REF)) +#define HASH_MAP_KEY (_make_header(2,_TAG_HEADER_REF)) +#define HASH_MAP_VAL (_make_header(3,_TAG_HEADER_REF)) #define UINT32_HASH_2(Expr1, Expr2, AConst) \ do { \ @@ -1182,11 +1210,45 @@ make_hash2(Eterm term) UINT32_HASH(arity, HCONST_9); if (arity == 0) /* Empty tuple */ goto hash2_common; - for (i = arity; i >= 2; i--) { + for (i = arity; i >= 1; i--) { tmp = elem[i]; ESTACK_PUSH(s, tmp); } - term = elem[1]; + goto hash2_common; + } + break; + case MAP_SUBTAG: + { + map_t *mp = (map_t *)map_val(term); + int i; + int size = map_get_size(mp); + Eterm *ks = map_get_keys(mp); + Eterm *vs = map_get_values(mp); + UINT32_HASH(size, HCONST_16); + if (size == 0) { + goto hash2_common; + } + ESTACK_PUSH(s, hash_xor_values); + ESTACK_PUSH(s, hash_xor_keys); + ESTACK_PUSH(s, hash); + ESTACK_PUSH(s, HASH_MAP_TAIL); + hash = 0; + hash_xor_keys = 0; + hash_xor_values = 0; + for (i = size - 1; i >= 0; i--) { + tmp = vs[i]; + ESTACK_PUSH(s, HASH_MAP_VAL); + ESTACK_PUSH(s, tmp); + } + /* We do not want to expose the tuple representation. + * Do not push the keys as a tuple. + */ + for (i = size - 1; i >= 0; i--) { + tmp = ks[i]; + ESTACK_PUSH(s, HASH_MAP_KEY); + ESTACK_PUSH(s, tmp); + } + goto hash2_common; } break; case EXPORT_SUBTAG: @@ -1380,15 +1442,47 @@ make_hash2(Eterm term) default: erl_exit(1, "Invalid tag in make_hash2(0x%X)\n", term); hash2_common: + + /* Uint32 hash always has the hash value of the previous term, + * compounded or otherwise. + */ + if (ESTACK_ISEMPTY(s)) { DESTROY_ESTACK(s); UnUseTmpHeapNoproc(2); return hash; } + term = ESTACK_POP(s); + + switch (term) { + case HASH_MAP_TAIL: { + hash = (Uint32) ESTACK_POP(s); + UINT32_HASH(hash_xor_keys, HCONST_16); + UINT32_HASH(hash_xor_values, HCONST_16); + hash_xor_keys = (Uint32) ESTACK_POP(s); + hash_xor_values = (Uint32) ESTACK_POP(s); + goto hash2_common; + } + case HASH_MAP_KEY: + hash_xor_keys ^= hash; + hash = 0; + goto hash2_common; + case HASH_MAP_VAL: + hash_xor_values ^= hash; + hash = 0; + goto hash2_common; + default: + break; + } } } } + +#undef HASH_MAP_TAIL +#undef HASH_MAP_KEY +#undef HASH_MAP_VAL + #undef UINT32_HASH_2 #undef UINT32_HASH #undef SINT32_HASH @@ -1490,7 +1584,7 @@ tail_recur: hash = hash*FUNNY_NUMBER2 + funp->fe->old_uniq; if (num_free > 0) { if (num_free > 1) { - WSTACK_PUSH3(stack, (UWord) &funp->env[1], (num_free-1), MAKE_HASH_FUN_OP); + WSTACK_PUSH3(stack, (UWord) &funp->env[1], (num_free-1), MAKE_HASH_TERM_ARRAY_OP); } term = funp->env[0]; goto tail_recur; @@ -1603,6 +1697,24 @@ tail_recur: } break; + case MAP_DEF: + { + map_t *mp = (map_t *)map_val(term); + int size = map_get_size(mp); + Eterm *ks = map_get_keys(mp); + Eterm *vs = map_get_values(mp); + + /* Use a prime with size to remedy some of + * the {} and <<>> hash problems */ + hash = hash*FUNNY_NUMBER13 + FUNNY_NUMBER14 + size; + if (size == 0) + break; + + /* push values first */ + WSTACK_PUSH3(stack, (UWord)vs, (UWord) size, MAKE_HASH_TERM_ARRAY_OP); + WSTACK_PUSH3(stack, (UWord)ks, (UWord) size, MAKE_HASH_TERM_ARRAY_OP); + break; + } case TUPLE_DEF: { Eterm* ptr = tuple_val(term); @@ -1612,7 +1724,7 @@ tail_recur: op = MAKE_HASH_TUPLE_OP; }/*fall through*/ case MAKE_HASH_TUPLE_OP: - case MAKE_HASH_FUN_OP: + case MAKE_HASH_TERM_ARRAY_OP: { Uint i = (Uint) WSTACK_POP(stack); Eterm* ptr = (Eterm*) WSTACK_POP(stack); @@ -1640,7 +1752,7 @@ tail_recur: return hash; #undef MAKE_HASH_TUPLE_OP -#undef MAKE_HASH_FUN_OP +#undef MAKE_HASH_TERM_ARRAY_OP #undef MAKE_HASH_CDR_PRE_OP #undef MAKE_HASH_CDR_POST_OP } @@ -2007,6 +2119,18 @@ tailrecur_ne: ++bb; goto term_array; } + case MAP_SUBTAG: + { + aa = map_val_rel(a, a_base); + if (!is_boxed(b) || *boxed_val_rel(b,b_base) != *aa) + goto not_equal; + bb = map_val_rel(b,b_base); + if ((sz = map_get_size((map_t*)aa)) == 0) goto pop_next; + aa += 2; + bb += 2; + sz += 1; /* increment for tuple-keys */ + goto term_array; + } case REFC_BINARY_SUBTAG: case HEAP_BINARY_SUBTAG: case SUB_BINARY_SUBTAG: @@ -2281,7 +2405,7 @@ static int cmpbytes(byte *s1, int l1, byte *s2, int l2) * * According to the Erlang Standard, types are orderered as follows: * numbers < (characters) < atoms < refs < funs < ports < pids < - * tuples < [] < conses < binaries. + * tuples < maps < [] < conses < binaries. * * Note that characters are currently not implemented. * @@ -2301,10 +2425,14 @@ static int cmp_atoms(Eterm a, Eterm b) bb->name+3, bb->len-3); } +/* cmp(Eterm a, Eterm b, int exact) + * exact = 1 -> term-based compare + * exact = 0 -> arith-based compare + */ #if HALFWORD_HEAP -Sint cmp_rel(Eterm a, Eterm* a_base, Eterm b, Eterm* b_base) +Sint cmp_rel_opt(Eterm a, Eterm* a_base, Eterm b, Eterm* b_base, int exact) #else -Sint cmp(Eterm a, Eterm b) +Sint cmp(Eterm a, Eterm b, int exact) #endif { DECLARE_WSTACK(stack); @@ -2464,7 +2592,25 @@ tailrecur_ne: ++aa; ++bb; goto term_array; + case (_TAG_HEADER_MAP >> _TAG_PRIMARY_SIZE) : + if (!is_map_rel(b,b_base)) { + a_tag = MAP_DEF; + goto mixed_types; + } + aa = (Eterm *)map_val_rel(a,a_base); + bb = (Eterm *)map_val_rel(b,b_base); + i = map_get_size((map_t*)aa); + if (i != map_get_size((map_t*)bb)) { + RETURN_NEQ((int)(i - map_get_size((map_t*)bb))); + } + if (i == 0) { + goto pop_next; + } + aa += 2; + bb += 2; + i += 1; /* increment for tuple-keys */ + goto term_array; case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE): if (!is_float_rel(b,b_base)) { a_tag = FLOAT_DEF; @@ -2710,6 +2856,7 @@ tailrecur_ne: j = big_sign(aw) ? -1 : 1; break; case SMALL_FLOAT: + if (exact) goto exact_fall_through; GET_DOUBLE(bw, f2); if (f2.fd < MAX_LOSSLESS_FLOAT && f2.fd > MIN_LOSSLESS_FLOAT) { /* Float is within the no loss limit */ @@ -2735,12 +2882,14 @@ tailrecur_ne: #endif /* ERTS_SIZEOF_ETERM == 8 */ break; case FLOAT_BIG: + if (exact) goto exact_fall_through; { Wterm tmp = aw; aw = bw; bw = tmp; }/* fall through */ case BIG_FLOAT: + if (exact) goto exact_fall_through; GET_DOUBLE(bw, f2); if ((f2.fd < (double) (MAX_SMALL + 1)) && (f2.fd > (double) (MIN_SMALL - 1))) { @@ -2770,6 +2919,7 @@ tailrecur_ne: } break; case FLOAT_SMALL: + if (exact) goto exact_fall_through; GET_DOUBLE(aw, f1); if (f1.fd < MAX_LOSSLESS_FLOAT && f1.fd > MIN_LOSSLESS_FLOAT) { /* Float is within the no loss limit */ @@ -2794,6 +2944,7 @@ tailrecur_ne: } #endif /* ERTS_SIZEOF_ETERM == 8 */ break; +exact_fall_through: default: j = b_tag - a_tag; } diff --git a/erts/emulator/drivers/common/efile_drv.c b/erts/emulator/drivers/common/efile_drv.c index dca979c13a..e040864d24 100644 --- a/erts/emulator/drivers/common/efile_drv.c +++ b/erts/emulator/drivers/common/efile_drv.c @@ -167,7 +167,7 @@ dt_private *get_dt_private(int); #ifdef USE_THREADS -#define IF_THRDS if (sys_info.async_threads > 0) +#define THRDS_AVAILABLE (sys_info.async_threads > 0) #ifdef HARDDEBUG /* HARDDEBUG in io.c is expected too */ #define TRACE_DRIVER fprintf(stderr, "Efile: ") #else @@ -177,24 +177,26 @@ dt_private *get_dt_private(int); #define MUTEX_LOCK(m) do { IF_THRDS { TRACE_DRIVER; driver_pdl_lock(m); } } while (0) #define MUTEX_UNLOCK(m) do { IF_THRDS { TRACE_DRIVER; driver_pdl_unlock(m); } } while (0) #else -#define IF_THRDS if (0) +#define THRDS_AVAILABLE (0) #define MUTEX_INIT(m, p) #define MUTEX_LOCK(m) #define MUTEX_UNLOCK(m) #endif +#define IF_THRDS if (THRDS_AVAILABLE) +#define SENDFILE_FLGS_USE_THREADS (1 << 0) /** * On DARWIN sendfile can deadlock with close if called in * different threads. So until Apple fixes so that sendfile * is not buggy we disable usage of the async pool for * DARWIN. The testcase t_sendfile_crashduring reproduces - * this error when using +A 10. + * this error when using +A 10 and enabling SENDFILE_FLGS_USE_THREADS. */ #if defined(__APPLE__) && defined(__MACH__) -#define USE_THRDS_FOR_SENDFILE 0 +#define USE_THRDS_FOR_SENDFILE(DATA) 0 #else -#define USE_THRDS_FOR_SENDFILE (sys_info.async_threads > 0) +#define USE_THRDS_FOR_SENDFILE(DATA) (DATA->flags & SENDFILE_FLGS_USE_THREADS) #endif /* defined(__APPLE__) && defined(__MACH__) */ @@ -300,7 +302,7 @@ static void file_stop_select(ErlDrvEvent event, void* _); enum e_timer {timer_idle, timer_again, timer_write}; #ifdef HAVE_SENDFILE enum e_sendfile {sending, not_sending}; -static void free_sendfile(void *data); +#define SENDFILE_USE_THREADS (1 << 0) #endif /* HAVE_SENDFILE */ struct t_data; @@ -1932,7 +1934,7 @@ static void invoke_sendfile(void *data) d->c.sendfile.written += nbytes; - if (result == 1 || (result == 0 && USE_THRDS_FOR_SENDFILE)) { + if (result == 1 || (result == 0 && USE_THRDS_FOR_SENDFILE(d))) { d->result_ok = 0; } else if (result == 0 && (d->errInfo.posix_errno == EAGAIN || d->errInfo.posix_errno == EINTR)) { @@ -1949,7 +1951,7 @@ static void invoke_sendfile(void *data) static void free_sendfile(void *data) { struct t_data *d = (struct t_data *)data; - if (USE_THRDS_FOR_SENDFILE) { + if (USE_THRDS_FOR_SENDFILE(d)) { SET_NONBLOCKING(d->c.sendfile.out_fd); } else { MUTEX_LOCK(d->c.sendfile.q_mtx); @@ -4122,8 +4124,16 @@ file_outputv(ErlDrvData e, ErlIOVec *ev) { goto done; } - if (hd_len != 0 || tl_len != 0 || flags != 0) { - /* We do not allow header, trailers and/or flags right now */ + if (hd_len != 0 || tl_len != 0) { + /* We do not allow header, trailers */ + reply_posix_error(desc, EINVAL); + goto done; + } + + + if (flags & SENDFILE_FLGS_USE_THREADS && !THRDS_AVAILABLE) { + /* We do not allow use_threads flag on a system where + no threads are available. */ reply_posix_error(desc, EINVAL); goto done; } @@ -4133,6 +4143,7 @@ file_outputv(ErlDrvData e, ErlIOVec *ev) { d->command = command; d->invoke = invoke_sendfile; d->free = free_sendfile; + d->flags = flags; d->level = 2; d->c.sendfile.out_fd = (int) out_fd; @@ -4152,7 +4163,7 @@ file_outputv(ErlDrvData e, ErlIOVec *ev) { d->c.sendfile.nbytes = nbytes; - if (USE_THRDS_FOR_SENDFILE) { + if (USE_THRDS_FOR_SENDFILE(d)) { SET_BLOCKING(d->c.sendfile.out_fd); } else { /** diff --git a/erts/emulator/hipe/hipe_bif2.c b/erts/emulator/hipe/hipe_bif2.c index e09988e2c5..c3687681cf 100644 --- a/erts/emulator/hipe/hipe_bif2.c +++ b/erts/emulator/hipe/hipe_bif2.c @@ -31,6 +31,7 @@ #include "erl_process.h" #include "bif.h" #include "big.h" +#include "erl_map.h" #include "hipe_debug.h" #include "hipe_mode_switch.h" #include "hipe_arch.h" diff --git a/erts/emulator/hipe/hipe_debug.c b/erts/emulator/hipe/hipe_debug.c index bf25ba82af..32694a8f97 100644 --- a/erts/emulator/hipe/hipe_debug.c +++ b/erts/emulator/hipe/hipe_debug.c @@ -36,6 +36,7 @@ #include "beam_load.h" #include "hipe_mode_switch.h" #include "hipe_debug.h" +#include "erl_map.h" static const char dashes[2*sizeof(long)+5] = { [0 ... 2*sizeof(long)+3] = '-' diff --git a/erts/emulator/sys/common/erl_sys_common_misc.c b/erts/emulator/sys/common/erl_sys_common_misc.c index 31ad3b82d5..e3ba741058 100644 --- a/erts/emulator/sys/common/erl_sys_common_misc.c +++ b/erts/emulator/sys/common/erl_sys_common_misc.c @@ -52,7 +52,7 @@ static int filename_warning = ERL_FILENAME_WARNING_WARNING; /* Default unicode on windows and MacOS X */ static int user_filename_encoding = ERL_FILENAME_UTF8; #else -static int user_filename_encoding = ERL_FILENAME_LATIN1; +static int user_filename_encoding = ERL_FILENAME_UNKNOWN; #endif /* This controls the heuristic in printing characters in shell and w/ io:format("~tp", ...) etc. */ diff --git a/erts/emulator/test/Makefile b/erts/emulator/test/Makefile index f02ca3cb98..0b0568c31a 100644 --- a/erts/emulator/test/Makefile +++ b/erts/emulator/test/Makefile @@ -68,6 +68,7 @@ MODULES= \ hash_SUITE \ hibernate_SUITE \ list_bif_SUITE \ + map_SUITE \ match_spec_SUITE \ module_info_SUITE \ monitor_SUITE \ diff --git a/erts/emulator/test/map_SUITE.erl b/erts/emulator/test/map_SUITE.erl new file mode 100644 index 0000000000..31c1486f1c --- /dev/null +++ b/erts/emulator/test/map_SUITE.erl @@ -0,0 +1,1056 @@ +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2013. 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(map_SUITE). +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2 + ]). + +-export([ + t_build_and_match_literals/1, + t_update_literals/1,t_match_and_update_literals/1, + t_update_map_expressions/1, + t_update_assoc/1,t_update_exact/1, + t_guard_bifs/1, t_guard_sequence/1, t_guard_update/1, + t_guard_receive/1, t_guard_fun/1, + t_list_comprehension/1, + t_map_sort_literals/1, + %t_size/1, + t_map_size/1, + + %% Specific Map BIFs + t_bif_map_get/1, + t_bif_map_find/1, + t_bif_map_is_key/1, + t_bif_map_keys/1, + t_bif_map_merge/1, + t_bif_map_new/1, + t_bif_map_put/1, + t_bif_map_remove/1, + t_bif_map_update/1, + t_bif_map_values/1, + t_bif_map_to_list/1, + t_bif_map_from_list/1, + + %% erlang + t_erlang_hash/1, + t_map_encode_decode/1, + + %% maps module not bifs + t_maps_fold/1, + t_maps_map/1, + t_maps_size/1, + t_maps_without/1, + + %% misc + t_pdict/1, + t_ets/1, + t_dets/1, + t_tracing/1 + ]). + +-include_lib("stdlib/include/ms_transform.hrl"). + +suite() -> []. + +all() -> [ + t_build_and_match_literals, + t_update_literals, t_match_and_update_literals, + t_update_map_expressions, + t_update_assoc,t_update_exact, + t_guard_bifs, t_guard_sequence, t_guard_update, + t_guard_receive,t_guard_fun, t_list_comprehension, + t_map_sort_literals, + + %% Specific Map BIFs + t_bif_map_get,t_bif_map_find,t_bif_map_is_key, + t_bif_map_keys, t_bif_map_merge, t_bif_map_new, + t_bif_map_put, + t_bif_map_remove, t_bif_map_update, + t_bif_map_values, + t_bif_map_to_list, t_bif_map_from_list, + + %% erlang + t_erlang_hash, t_map_encode_decode, + t_map_size, + + %% maps module + t_maps_fold, t_maps_map, + t_maps_size, t_maps_without, + + + %% Other functions + t_pdict, + t_ets, + t_tracing + ]. + +groups() -> []. + +init_per_suite(Config) -> Config. +end_per_suite(_Config) -> ok. + +init_per_group(_GroupName, Config) -> Config. +end_per_group(_GroupName, Config) -> Config. + +%% tests + +t_build_and_match_literals(Config) when is_list(Config) -> + #{} = id(#{}), + #{1:=a} = id(#{1=>a}), + #{1:=a,2:=b} = id(#{1=>a,2=>b}), + #{1:=a,2:=b,3:="c"} = id(#{1=>a,2=>b,3=>"c"}), + #{1:=a,2:=b,3:="c","4":="d"} = id(#{1=>a,2=>b,3=>"c","4"=>"d"}), + #{1:=a,2:=b,3:="c","4":="d",<<"5">>:=<<"e">>} = + id(#{1=>a,2=>b,3=>"c","4"=>"d",<<"5">>=><<"e">>}), + #{1:=a,2:=b,3:="c","4":="d",<<"5">>:=<<"e">>,{"6",7}:="f"} = + id(#{1=>a,2=>b,3=>"c","4"=>"d",<<"5">>=><<"e">>,{"6",7}=>"f"}), + #{1:=a,2:=b,3:="c","4":="d",<<"5">>:=<<"e">>,{"6",7}:="f",8:=g} = + id(#{1=>a,2=>b,3=>"c","4"=>"d",<<"5">>=><<"e">>,{"6",7}=>"f",8=>g}), + + #{<<"hi all">> := 1} = id(#{<<"hi",32,"all">> => 1}), + + #{a:=X,a:=X=3,b:=4} = id(#{a=>3,b=>4}), % weird but ok =) + + #{ a:=#{ b:=#{c := third, b:=second}}, b:=first} = + id(#{ b=>first, a=>#{ b=>#{c => third, b=> second}}}), + + M = #{ map_1=>#{ map_2=>#{value_3 => third}, value_2=> second}, value_1=>first}, + M = #{ map_1:=#{ map_2:=#{value_3 := third}, value_2:= second}, value_1:=first} = + id(#{ map_1=>#{ map_2=>#{value_3 => third}, value_2=> second}, value_1=>first}), + + %% error case + %V = 32, + %{'EXIT',{{badmatch,_},_}} = (catch (#{<<"hi all">> => 1} = id(#{<<"hi",V,"all">> => 1}))), + {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3,x:=2} = id(#{x=>3}))), + {'EXIT',{{badmatch,_},_}} = (catch (#{x:=2} = id(#{x=>3}))), + {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3} = id({a,b,c}))), + {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3} = id(#{y=>3}))), + {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3} = id(#{x=>"three"}))), + ok. + + +%% Tests size(Map). +%% not implemented, perhaps it shouldn't be either + +%t_size(Config) when is_list(Config) -> +% 0 = size(#{}), +% 1 = size(#{a=>1}), +% 1 = size(#{a=>#{a=>1}}), +% 2 = size(#{a=>1, b=>2}), +% 3 = size(#{a=>1, b=>2, b=>"3"}), +% ok. + +t_map_size(Config) when is_list(Config) -> + 0 = map_size(id(#{})), + 1 = map_size(id(#{a=>1})), + 1 = map_size(id(#{a=>"wat"})), + 2 = map_size(id(#{a=>1, b=>2})), + 3 = map_size(id(#{a=>1, b=>2, b=>"3","33"=><<"n">>})), + + true = map_is_size(#{a=>1}, 1), + true = map_is_size(#{a=>1, a=>2}, 1), + M = #{ "a" => 1, "b" => 2}, + true = map_is_size(M, 2), + false = map_is_size(M, 3), + true = map_is_size(M#{ "a" => 2}, 2), + false = map_is_size(M#{ "c" => 2}, 2), + + %% Error cases. + {'EXIT',{badarg,_}} = (catch map_size([])), + {'EXIT',{badarg,_}} = (catch map_size(<<1,2,3>>)), + {'EXIT',{badarg,_}} = (catch map_size(1)), + ok. + +map_is_size(M,N) when map_size(M) =:= N -> true; +map_is_size(_,_) -> false. + +% test map updates without matching +t_update_literals(Config) when is_list(Config) -> + Map = #{x=>1,y=>2,z=>3,q=>4}, + #{x:="d",q:="4"} = loop_update_literals_x_q(Map, [ + {"a","1"},{"b","2"},{"c","3"},{"d","4"} + ]), + ok. + +loop_update_literals_x_q(Map, []) -> Map; +loop_update_literals_x_q(Map, [{X,Q}|Vs]) -> + loop_update_literals_x_q(Map#{q=>Q,x=>X},Vs). + +% test map updates with matching +t_match_and_update_literals(Config) when is_list(Config) -> + Map = #{x=>0,y=>"untouched",z=>"also untouched",q=>1}, + #{x:=16,q:=21,y:="untouched",z:="also untouched"} = loop_match_and_update_literals_x_q(Map, [ + {1,2},{3,4},{5,6},{7,8} + ]), + M0 = id(#{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, + 4 => number, 18446744073709551629 => wat}), + M1 = id(#{}), + M2 = M1#{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, + 4 => number, 18446744073709551629 => wat}, + M0 = M2, + + #{ 4 := another_number, int := 3 } = M2#{ 4 => another_number }, + ok. + +loop_match_and_update_literals_x_q(Map, []) -> Map; +loop_match_and_update_literals_x_q(#{q:=Q0,x:=X0} = Map, [{X,Q}|Vs]) -> + loop_match_and_update_literals_x_q(Map#{q=>Q0+Q,x=>X0+X},Vs). + + +t_update_map_expressions(Config) when is_list(Config) -> + M = maps:new(), + #{ a := 1 } = M#{a => 1}, + + #{ b := 2 } = (maps:new())#{ b => 2 }, + + #{ a :=42, b:=42, c:=42 } = (maps:from_list([{a,1},{b,2},{c,3}]))#{ a := 42, b := 42, c := 42 }, + #{ "a" :=1, "b":=42, "c":=42 } = (maps:from_list([{"a",1},{"b",2}]))#{ "b" := 42, "c" => 42 }, + + %% Error cases, FIXME: should be 'badmap'? + {'EXIT',{badarg,_}} = (catch (id(<<>>))#{ a := 42, b => 2 }), + {'EXIT',{badarg,_}} = (catch (id([]))#{ a := 42, b => 2 }), + ok. + + +t_update_assoc(Config) when is_list(Config) -> + M0 = id(#{1=>a,2=>b,3.0=>c,4=>d,5=>e}), + + M1 = M0#{1=>42,2=>100,4=>[a,b,c]}, + #{1:=42,2:=100,3.0:=c,4:=[a,b,c],5:=e} = M1, + #{1:=42,2:=b,4:=d,5:=e,2.0:=100,3.0:=c,4.0:=[a,b,c]} = M0#{1.0=>float,1:=42,2.0=>wrong,2.0=>100,4.0=>[a,b,c]}, + + M2 = M0#{3.0=>new}, + #{1:=a,2:=b,3.0:=new,4:=d,5:=e} = M2, + M2 = M0#{3.0:=wrong,3.0=>new}, + + %% Errors cases. + BadMap = id(badmap), + {'EXIT',{badarg,_}} = (catch BadMap#{nonexisting=>val}), + + ok. + +t_update_exact(Config) when is_list(Config) -> + M0 = id(#{1=>a,2=>b,3.0=>c,4=>d,5=>e}), + + M1 = M0#{1:=42,2:=100,4:=[a,b,c]}, + #{1:=42,2:=100,3.0:=c,4:=[a,b,c],5:=e} = M1, + M1 = M0#{1:=wrong,1=>42,2=>wrong,2:=100,4:=[a,b,c]}, + + M2 = M0#{3.0:=new}, + #{1:=a,2:=b,3.0:=new,4:=d,5:=e} = M2, + M2 = M0#{3.0=>wrong,3.0:=new}, + M2 = M0#{3=>wrong,3.0:=new}, + + %% Errors cases. + {'EXIT',{badarg,_}} = (catch M0#{nonexisting:=val}), + {'EXIT',{badarg,_}} = (catch M0#{1.0:=v,1.0=>v2}), + {'EXIT',{badarg,_}} = (catch M0#{42.0:=v,42:=v2}), + {'EXIT',{badarg,_}} = (catch M0#{42=>v1,42.0:=v2,42:=v3}), + + ok. + +t_guard_bifs(Config) when is_list(Config) -> + true = map_guard_head(#{a=>1}), + false = map_guard_head([]), + true = map_guard_body(#{a=>1}), + false = map_guard_body({}), + true = map_guard_pattern(#{a=>1, <<"hi">> => "hi" }), + false = map_guard_pattern("list"), + ok. + +map_guard_head(M) when is_map(M) -> true; +map_guard_head(_) -> false. + +map_guard_body(M) -> is_map(M). + +map_guard_pattern(#{}) -> true; +map_guard_pattern(_) -> false. + +t_guard_sequence(Config) when is_list(Config) -> + {1, "a"} = map_guard_sequence_1(#{seq=>1,val=>id("a")}), + {2, "b"} = map_guard_sequence_1(#{seq=>2,val=>id("b")}), + {3, "c"} = map_guard_sequence_1(#{seq=>3,val=>id("c")}), + {4, "d"} = map_guard_sequence_1(#{seq=>4,val=>id("d")}), + {5, "e"} = map_guard_sequence_1(#{seq=>5,val=>id("e")}), + + {1,M1} = map_guard_sequence_2(M1 = id(#{a=>3})), + {2,M2} = map_guard_sequence_2(M2 = id(#{a=>4, b=>4})), + {3,gg,M3} = map_guard_sequence_2(M3 = id(#{a=>gg, b=>4})), + {4,sc,sc,M4} = map_guard_sequence_2(M4 = id(#{a=>sc, b=>3, c=>sc2})), + {5,kk,kk,M5} = map_guard_sequence_2(M5 = id(#{a=>kk, b=>other, c=>sc2})), + + %% error case + {'EXIT',{function_clause,_}} = (catch map_guard_sequence_1(#{seq=>6,val=>id("e")})), + {'EXIT',{function_clause,_}} = (catch map_guard_sequence_2(#{b=>5})), + ok. + +map_guard_sequence_1(#{seq:=1=Seq, val:=Val}) -> {Seq,Val}; +map_guard_sequence_1(#{seq:=2=Seq, val:=Val}) -> {Seq,Val}; +map_guard_sequence_1(#{seq:=3=Seq, val:=Val}) -> {Seq,Val}; +map_guard_sequence_1(#{seq:=4=Seq, val:=Val}) -> {Seq,Val}; +map_guard_sequence_1(#{seq:=5=Seq, val:=Val}) -> {Seq,Val}. + +map_guard_sequence_2(#{ a:=3 }=M) -> {1, M}; +map_guard_sequence_2(#{ a:=4 }=M) -> {2, M}; +map_guard_sequence_2(#{ a:=X, a:=X, b:=4 }=M) -> {3,X,M}; +map_guard_sequence_2(#{ a:=X, a:=Y, b:=3 }=M) when X =:= Y -> {4,X,Y,M}; +map_guard_sequence_2(#{ a:=X, a:=Y }=M) when X =:= Y -> {5,X,Y,M}. + + +t_guard_update(Config) when is_list(Config) -> + error = map_guard_update(#{},#{}), + first = map_guard_update(#{}, #{x=>first}), + second = map_guard_update(#{y=>old}, #{x=>second,y=>old}), + ok. + +map_guard_update(M1, M2) when M1#{x=>first} =:= M2 -> first; +map_guard_update(M1, M2) when M1#{x=>second} =:= M2 -> second; +map_guard_update(_, _) -> error. + +t_guard_receive(Config) when is_list(Config) -> + M0 = #{ id => 0 }, + Pid = spawn_link(fun() -> guard_receive_loop() end), + Big = 36893488147419103229, + B1 = <<"some text">>, + B2 = <<"was appended">>, + B3 = <<B1/binary, B2/binary>>, + + #{id:=1, res:=Big} = M1 = call(Pid, M0#{op=>sub,in=>{1 bsl 65, 3}}), + #{id:=2, res:=26} = M2 = call(Pid, M1#{op=>idiv,in=>{53,2}}), + #{id:=3, res:=832} = M3 = call(Pid, M2#{op=>imul,in=>{26,32}}), + #{id:=4, res:=4} = M4 = call(Pid, M3#{op=>add,in=>{1,3}}), + #{id:=5, res:=Big} = M5 = call(Pid, M4#{op=>sub,in=>{1 bsl 65, 3}}), + #{id:=6, res:=B3} = M6 = call(Pid, M5#{op=>"append",in=>{B1,B2}}), + #{id:=7, res:=4} = _ = call(Pid, M6#{op=>add,in=>{1,3}}), + + + %% update old maps and check id update + #{id:=2, res:=B3} = call(Pid, M1#{op=>"append",in=>{B1,B2}}), + #{id:=5, res:=99} = call(Pid, M4#{op=>add,in=>{33, 66}}), + + %% cleanup + done = call(Pid, done), + ok. + +call(Pid, M) -> + Pid ! {self(), M}, receive {Pid, Res} -> Res end. + +guard_receive_loop() -> + receive + {Pid, #{ id:=Id, op:="append", in:={X,Y}}=M} when is_binary(X), is_binary(Y) -> + Pid ! {self(), M#{ id=>Id+1, res=><<X/binary,Y/binary>>}}, + guard_receive_loop(); + {Pid, #{ id:=Id, op:=add, in:={X,Y}}} -> + Pid ! {self(), #{ id=>Id+1, res=>X+Y}}, + guard_receive_loop(); + {Pid, #{ id:=Id, op:=sub, in:={X,Y}}=M} -> + Pid ! {self(), M#{ id=>Id+1, res=>X-Y}}, + guard_receive_loop(); + {Pid, #{ id:=Id, op:=idiv, in:={X,Y}}=M} -> + Pid ! {self(), M#{ id=>Id+1, res=>X div Y}}, + guard_receive_loop(); + {Pid, #{ id:=Id, op:=imul, in:={X,Y}}=M} -> + Pid ! {self(), M#{ id=>Id+1, res=>X * Y}}, + guard_receive_loop(); + {Pid, done} -> + Pid ! {self(), done}; + {Pid, Other} -> + Pid ! {error, Other}, + guard_receive_loop() + end. + + +t_list_comprehension(Config) when is_list(Config) -> + [#{k:=1},#{k:=2},#{k:=3}] = [#{k=>I} || I <- [1,2,3]], + ok. + +t_guard_fun(Config) when is_list(Config) -> + F1 = fun + (#{s:=v,v:=V}) -> {v,V}; + (#{s:=t,v:={V,V}}) -> {t,V}; + (#{s:=l,v:=[V,V]}) -> {l,V} + end, + + F2 = fun + (#{s:=T,v:={V,V}}) -> {T,V}; + (#{s:=T,v:=[V,V]}) -> {T,V}; + (#{s:=T,v:=V}) -> {T,V} + end, + V = <<"hi">>, + + {v,V} = F1(#{s=>v,v=>V}), + {t,V} = F1(#{s=>t,v=>{V,V}}), + {l,V} = F1(#{s=>l,v=>[V,V]}), + + {v,V} = F2(#{s=>v,v=>V}), + {t,V} = F2(#{s=>t,v=>{V,V}}), + {l,V} = F2(#{s=>l,v=>[V,V]}), + + %% error case + {'EXIT', {function_clause,[{?MODULE,_,[#{s:=none,v:=none}],_}|_]}} = (catch F1(#{s=>none,v=>none})), + ok. + + +t_map_sort_literals(Config) when is_list(Config) -> + % test relation + + %% size order + true = #{ a => 1, b => 2} < id(#{ a => 1, b => 1, c => 1}), + true = #{ b => 1, a => 1} < id(#{ c => 1, a => 1, b => 1}), + false = #{ c => 1, b => 1, a => 1} < id(#{ c => 1, a => 1}), + + %% key order + true = #{ a => 1 } < id(#{ b => 1}), + false = #{ b => 1 } < id(#{ a => 1}), + true = #{ a => 1, b => 1, c => 1 } < id(#{ b => 1, c => 1, d => 1}), + true = #{ b => 1, c => 1, d => 1 } > id(#{ a => 1, b => 1, c => 1}), + true = #{ c => 1, b => 1, a => 1 } < id(#{ b => 1, c => 1, d => 1}), + true = #{ "a" => 1 } < id(#{ <<"a">> => 1}), + false = #{ <<"a">> => 1 } < id(#{ "a" => 1}), + false = #{ 1 => 1 } < id(#{ 1.0 => 1}), + false = #{ 1.0 => 1 } < id(#{ 1 => 1}), + + %% value order + true = #{ a => 1 } < id(#{ a => 2}), + false = #{ a => 2 } < id(#{ a => 1}), + false = #{ a => 2, b => 1 } < id(#{ a => 1, b => 3}), + true = #{ a => 1, b => 1 } < id(#{ a => 1, b => 3}), + + true = #{ "a" => "hi", b => 134 } == id(#{ b => 134,"a" => "hi"}), + + %% lists:sort + + SortVs = [#{"a"=>1},#{a=>2},#{1=>3},#{<<"a">>=>4}], + [#{1:=ok},#{a:=ok},#{"a":=ok},#{<<"a">>:=ok}] = lists:sort([#{"a"=>ok},#{a=>ok},#{1=>ok},#{<<"a">>=>ok}]), + [#{1:=3},#{a:=2},#{"a":=1},#{<<"a">>:=4}] = lists:sort(SortVs), + [#{1:=3},#{a:=2},#{"a":=1},#{<<"a">>:=4}] = lists:sort(lists:reverse(SortVs)), + + ok. + +%% BIFs +t_bif_map_get(Config) when is_list(Config) -> + + 1 = maps:get(a, #{ a=> 1}), + 2 = maps:get(b, #{ a=> 1, b => 2}), + "hi" = maps:get("hello", #{ a=>1, "hello" => "hi"}), + "tuple hi" = maps:get({1,1.0}, #{ a=>a, {1,1.0} => "tuple hi"}), + + M = id(#{ k1=>"v1", <<"k2">> => <<"v3">> }), + "v4" = maps:get(<<"k2">>, M#{ <<"k2">> => "v4" }), + + %% error case + {'EXIT',{badarg, [{maps,get,_,_}|_]}} = (catch maps:get(a,[])), + {'EXIT',{badarg, [{maps,get,_,_}|_]}} = (catch maps:get(a,<<>>)), + {'EXIT',{bad_key,[{maps,get,_,_}|_]}} = (catch maps:get({1,1}, #{{1,1.0} => "tuple"})), + {'EXIT',{bad_key,[{maps,get,_,_}|_]}} = (catch maps:get(a,#{})), + {'EXIT',{bad_key,[{maps,get,_,_}|_]}} = (catch maps:get(a,#{ b=>1, c=>2})), + ok. + +t_bif_map_find(Config) when is_list(Config) -> + + {ok, 1} = maps:find(a, #{ a=> 1}), + {ok, 2} = maps:find(b, #{ a=> 1, b => 2}), + {ok, "int"} = maps:find(1, #{ 1 => "int"}), + {ok, "float"} = maps:find(1.0, #{ 1.0=> "float"}), + + {ok, "hi"} = maps:find("hello", #{ a=>1, "hello" => "hi"}), + {ok, "tuple hi"} = maps:find({1,1.0}, #{ a=>a, {1,1.0} => "tuple hi"}), + + M = id(#{ k1=>"v1", <<"k2">> => <<"v3">> }), + {ok, "v4"} = maps:find(<<"k2">>, M#{ <<"k2">> => "v4" }), + + %% error case + error = maps:find(a,#{}), + error = maps:find(a,#{b=>1, c=>2}), + error = maps:find(1.0, #{ 1 => "int"}), + error = maps:find(1, #{ 1.0 => "float"}), + error = maps:find({1.0,1}, #{ a=>a, {1,1.0} => "tuple hi"}), % reverse types in tuple key + + + {'EXIT',{badarg,[{maps,find,_,_}|_]}} = (catch maps:find(a,id([]))), + {'EXIT',{badarg,[{maps,find,_,_}|_]}} = (catch maps:find(a,id(<<>>))), + ok. + + +t_bif_map_is_key(Config) when is_list(Config) -> + M1 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, 4 => number}, + + true = maps:is_key("hi", M1), + true = maps:is_key(int, M1), + true = maps:is_key(<<"key">>, M1), + true = maps:is_key(4, M1), + + false = maps:is_key(5, M1), + false = maps:is_key(<<"key2">>, M1), + false = maps:is_key("h", M1), + false = maps:is_key("hello", M1), + false = maps:is_key(atom, M1), + false = maps:is_key(any, id(#{})), + + false = maps:is_key("hi", maps:remove("hi", M1)), + true = maps:is_key("hi", M1), + true = maps:is_key(1, maps:put(1, "number", M1)), + false = maps:is_key(1.0, maps:put(1, "number", M1)), + + %% error case + {'EXIT',{badarg,[{maps,is_key,_,_}|_]}} = (catch maps:is_key(a,id([]))), + {'EXIT',{badarg,[{maps,is_key,_,_}|_]}} = (catch maps:is_key(a,id(<<>>))), + ok. + +t_bif_map_keys(Config) when is_list(Config) -> + [] = maps:keys(#{}), + + [1,2,3,4,5] = maps:keys(#{ 1 => a, 2 => b, 3 => c, 4 => d, 5 => e}), + [1,2,3,4,5] = maps:keys(#{ 4 => d, 5 => e, 1 => a, 2 => b, 3 => c}), + + % values in key order: [4,int,"hi",<<"key">>] + M1 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, 4 => number}, + [4,int,"hi",<<"key">>] = maps:keys(M1), + + %% error case + {'EXIT',{badarg,[{maps,keys,_,_}|_]}} = (catch maps:keys(1 bsl 65 + 3)), + {'EXIT',{badarg,[{maps,keys,_,_}|_]}} = (catch maps:keys(154)), + {'EXIT',{badarg,[{maps,keys,_,_}|_]}} = (catch maps:keys(atom)), + {'EXIT',{badarg,[{maps,keys,_,_}|_]}} = (catch maps:keys([])), + {'EXIT',{badarg,[{maps,keys,_,_}|_]}} = (catch maps:keys(<<>>)), + ok. + +t_bif_map_new(Config) when is_list(Config) -> + #{} = maps:new(), + 0 = erlang:map_size(maps:new()), + ok. + +t_bif_map_merge(Config) when is_list(Config) -> + 0 = erlang:map_size(maps:merge(#{},#{})), + + M0 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, + 4 => number, 18446744073709551629 => wat}, + + #{ "hi" := "hello", int := 3, <<"key">> := <<"value">>, + 4 := number, 18446744073709551629 := wat} = maps:merge(#{}, M0), + + #{ "hi" := "hello", int := 3, <<"key">> := <<"value">>, + 4 := number, 18446744073709551629 := wat} = maps:merge(M0, #{}), + + M1 = #{ "hi" => "hello again", float => 3.3, {1,2} => "tuple", 4 => integer }, + + #{4 := number, 18446744073709551629 := wat, float := 3.3, int := 3, + {1,2} := "tuple", "hi" := "hello", <<"key">> := <<"value">>} = maps:merge(M1,M0), + + #{4 := integer, 18446744073709551629 := wat, float := 3.3, int := 3, + {1,2} := "tuple", "hi" := "hello again", <<"key">> := <<"value">>} = maps:merge(M0,M1), + + %% error case + {'EXIT',{badarg,[{maps,merge,_,_}|_]}} = (catch maps:merge((1 bsl 65 + 3), <<>>)), + {'EXIT',{badarg,[{maps,merge,_,_}|_]}} = (catch maps:merge(<<>>, id(#{ a => 1}))), + {'EXIT',{badarg,[{maps,merge,_,_}|_]}} = (catch maps:merge(id(#{ a => 2}), <<>> )), + + ok. + + +t_bif_map_put(Config) when is_list(Config) -> + M0 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, + 4 => number, 18446744073709551629 => wat}, + + M1 = #{ "hi" := "hello"} = maps:put("hi", "hello", #{}), + + ["hi"] = maps:keys(M1), + ["hello"] = maps:values(M1), + + M2 = #{ int := 3 } = maps:put(int, 3, M1), + + [int,"hi"] = maps:keys(M2), + [3,"hello"] = maps:values(M2), + + M3 = #{ <<"key">> := <<"value">> } = maps:put(<<"key">>, <<"value">>, M2), + + [int,"hi",<<"key">>] = maps:keys(M3), + [3,"hello",<<"value">>] = maps:values(M3), + + M4 = #{ 18446744073709551629 := wat } = maps:put(18446744073709551629, wat, M3), + + [18446744073709551629,int,"hi",<<"key">>] = maps:keys(M4), + [wat,3,"hello",<<"value">>] = maps:values(M4), + + M0 = #{ 4 := number } = M5 = maps:put(4, number, M4), + + [4,18446744073709551629,int,"hi",<<"key">>] = maps:keys(M5), + [number,wat,3,"hello",<<"value">>] = maps:values(M5), + + M6 = #{ <<"key">> := <<"other value">> } = maps:put(<<"key">>, <<"other value">>, M5), + + [4,18446744073709551629,int,"hi",<<"key">>] = maps:keys(M6), + [number,wat,3,"hello",<<"other value">>] = maps:values(M6), + + %% error case + {'EXIT',{badarg,[{maps,put,_,_}|_]}} = (catch maps:put(1,a,1 bsl 65 + 3)), + {'EXIT',{badarg,[{maps,put,_,_}|_]}} = (catch maps:put(1,a,154)), + {'EXIT',{badarg,[{maps,put,_,_}|_]}} = (catch maps:put(1,a,atom)), + {'EXIT',{badarg,[{maps,put,_,_}|_]}} = (catch maps:put(1,a,[])), + {'EXIT',{badarg,[{maps,put,_,_}|_]}} = (catch maps:put(1,a,<<>>)), + ok. + +t_bif_map_remove(Config) when is_list(Config) -> + 0 = erlang:map_size(maps:remove(some_key, #{})), + + M0 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, + 4 => number, 18446744073709551629 => wat}, + + M1 = maps:remove("hi", M0), + [4,18446744073709551629,int,<<"key">>] = maps:keys(M1), + [number,wat,3,<<"value">>] = maps:values(M1), + + M2 = maps:remove(int, M1), + [4,18446744073709551629,<<"key">>] = maps:keys(M2), + [number,wat,<<"value">>] = maps:values(M2), + + M3 = maps:remove(<<"key">>, M2), + [4,18446744073709551629] = maps:keys(M3), + [number,wat] = maps:values(M3), + + M4 = maps:remove(18446744073709551629, M3), + [4] = maps:keys(M4), + [number] = maps:values(M4), + + M5 = maps:remove(4, M4), + [] = maps:keys(M5), + [] = maps:values(M5), + + M0 = maps:remove(5,M0), + M0 = maps:remove("hi there",M0), + + #{ "hi" := "hello", int := 3, 4 := number} = maps:remove(18446744073709551629,maps:remove(<<"key">>,M0)), + + %% error case + {'EXIT',{badarg,[{maps,remove,_,_}|_]}} = (catch maps:remove(a,1 bsl 65 + 3)), + {'EXIT',{badarg,[{maps,remove,_,_}|_]}} = (catch maps:remove(1,154)), + {'EXIT',{badarg,[{maps,remove,_,_}|_]}} = (catch maps:remove(a,atom)), + {'EXIT',{badarg,[{maps,remove,_,_}|_]}} = (catch maps:remove(1,[])), + {'EXIT',{badarg,[{maps,remove,_,_}|_]}} = (catch maps:remove(a,<<>>)), + ok. + +t_bif_map_update(Config) when is_list(Config) -> + M0 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, + 4 => number, 18446744073709551629 => wat}, + + #{ "hi" := "hello again", int := 3, <<"key">> := <<"value">>, + 4 := number, 18446744073709551629 := wat} = maps:update("hi", "hello again", M0), + + #{ "hi" := "hello", int := 1337, <<"key">> := <<"value">>, + 4 := number, 18446744073709551629 := wat} = maps:update(int, 1337, M0), + + #{ "hi" := "hello", int := 3, <<"key">> := <<"new value">>, + 4 := number, 18446744073709551629 := wat} = maps:update(<<"key">>, <<"new value">>, M0), + + #{ "hi" := "hello", int := 3, <<"key">> := <<"value">>, + 4 := integer, 18446744073709551629 := wat} = maps:update(4, integer, M0), + + #{ "hi" := "hello", int := 3, <<"key">> := <<"value">>, + 4 := number, 18446744073709551629 := wazzup} = maps:update(18446744073709551629, wazzup, M0), + + %% error case + {'EXIT',{badarg,[{maps,update,_,_}|_]}} = (catch maps:update(1,none,{})), + {'EXIT',{badarg,[{maps,update,_,_}|_]}} = (catch maps:update(1,none,<<"value">>)), + {'EXIT',{badarg,[{maps,update,_,_}|_]}} = (catch maps:update(5,none,M0)), + + ok. + + + +t_bif_map_values(Config) when is_list(Config) -> + + [] = maps:values(#{}), + + [a,b,c,d,e] = maps:values(#{ 1 => a, 2 => b, 3 => c, 4 => d, 5 => e}), + [a,b,c,d,e] = maps:values(#{ 4 => d, 5 => e, 1 => a, 2 => b, 3 => c}), + + % values in key order: [4,int,"hi",<<"key">>] + M1 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, 4 => number}, + M2 = M1#{ "hi" => "hello2", <<"key">> => <<"value2">> }, + [number,3,"hello2",<<"value2">>] = maps:values(M2), + [number,3,"hello",<<"value">>] = maps:values(M1), + + %% error case + {'EXIT',{badarg,[{maps,values,_,_}|_]}} = (catch maps:values(1 bsl 65 + 3)), + {'EXIT',{badarg,[{maps,values,_,_}|_]}} = (catch maps:values(atom)), + {'EXIT',{badarg,[{maps,values,_,_}|_]}} = (catch maps:values([])), + {'EXIT',{badarg,[{maps,values,_,_}|_]}} = (catch maps:values(<<>>)), + ok. + +t_erlang_hash(Config) when is_list(Config) -> + + ok = t_bif_erlang_phash2(), + ok = t_bif_erlang_phash(), + ok = t_bif_erlang_hash(), + + ok. + +t_bif_erlang_phash2() -> + + 39679005 = erlang:phash2(#{}), + 78942764 = erlang:phash2(#{ a => 1, "a" => 2, <<"a">> => 3, {a,b} => 4 }), + 37338230 = erlang:phash2(#{ 1 => a, 2 => "a", 3 => <<"a">>, 4 => {a,b} }), + 14363616 = erlang:phash2(#{ 1 => a }), + 51612236 = erlang:phash2(#{ a => 1 }), + + 37468437 = erlang:phash2(#{{} => <<>>}), + 44049159 = erlang:phash2(#{<<>> => {}}), + + M0 = #{ a => 1, "key" => <<"value">> }, + M1 = maps:remove("key",M0), + M2 = M1#{ "key" => <<"value">> }, + + 118679416 = erlang:phash2(M0), + 51612236 = erlang:phash2(M1), + 118679416 = erlang:phash2(M2), + ok. + +t_bif_erlang_phash() -> + Sz = 1 bsl 32, + 268440612 = erlang:phash(#{},Sz), + 1196461908 = erlang:phash(#{ a => 1, "a" => 2, <<"a">> => 3, {a,b} => 4 },Sz), + 3944426064 = erlang:phash(#{ 1 => a, 2 => "a", 3 => <<"a">>, 4 => {a,b} },Sz), + 1394238263 = erlang:phash(#{ 1 => a },Sz), + 4066388227 = erlang:phash(#{ a => 1 },Sz), + + 1578050717 = erlang:phash(#{{} => <<>>},Sz), + 1578050717 = erlang:phash(#{<<>> => {}},Sz), % yep, broken + + M0 = #{ a => 1, "key" => <<"value">> }, + M1 = maps:remove("key",M0), + M2 = M1#{ "key" => <<"value">> }, + + 3590546636 = erlang:phash(M0,Sz), + 4066388227 = erlang:phash(M1,Sz), + 3590546636 = erlang:phash(M2,Sz), + ok. + +t_bif_erlang_hash() -> + Sz = 1 bsl 27 - 1, + 5158 = erlang:hash(#{},Sz), + 71555838 = erlang:hash(#{ a => 1, "a" => 2, <<"a">> => 3, {a,b} => 4 },Sz), + 5497225 = erlang:hash(#{ 1 => a, 2 => "a", 3 => <<"a">>, 4 => {a,b} },Sz), + 126071654 = erlang:hash(#{ 1 => a },Sz), + 126426236 = erlang:hash(#{ a => 1 },Sz), + + 101655720 = erlang:hash(#{{} => <<>>},Sz), + 101655720 = erlang:hash(#{<<>> => {}},Sz), % yep, broken + + M0 = #{ a => 1, "key" => <<"value">> }, + M1 = maps:remove("key",M0), + M2 = M1#{ "key" => <<"value">> }, + + 38260486 = erlang:hash(M0,Sz), + 126426236 = erlang:hash(M1,Sz), + 38260486 = erlang:hash(M2,Sz), + ok. + + +t_map_encode_decode(Config) when is_list(Config) -> + <<131,116,0,0,0,0>> = erlang:term_to_binary(#{}), + Pairs = [ + {a,b},{"key","values"},{<<"key">>,<<"value">>}, + {1,b},{[atom,1],{<<"wat">>,1,2,3}}, + {aa,"values"}, + {1 bsl 64 + (1 bsl 50 - 1), sc1}, + {99, sc2}, + {1 bsl 65 + (1 bsl 51 - 1), sc3}, + {88, sc4}, + {1 bsl 66 + (1 bsl 52 - 1), sc5}, + {77, sc6}, + {1 bsl 67 + (1 bsl 53 - 1), sc3}, + {75, sc6}, {-10,sc8}, + {<<>>, sc9}, {3.14158, sc10}, + {[3.14158], sc11}, {more_atoms, sc12}, + {{more_tuples}, sc13}, {self(), sc14}, + {{},{}},{[],[]} + ], + ok = map_encode_decode_and_match(Pairs,[],#{}), + + %% check sorting + + %% literally #{ b=>2, a=>1 } in the internal order + #{ a:=1, b:=2 } = + erlang:binary_to_term(<<131,116,0,0,0,2,100,0,1,98,100,0,1,97,97,2,97,1>>), + + + %% literally #{ "hi" => "value", a=>33, b=>55 } in the internal order + #{ a:=33, b:=55, "hi" := "value"} = erlang:binary_to_term(<<131,116,0,0,0,3, + 107,0,2,104,105, % "hi" :: list() + 100,0,1,97, % a :: atom() + 100,0,1,98, % b :: atom() + 107,0,5,118,97,108,117,101, % "value" :: list() + 97,33, % 33 :: integer() + 97,55 % 55 :: integer() + >>), + + + %% error cases + %% template: <<131,116,0,0,0,2,100,0,1,97,100,0,1,98,97,1,97,1>> + %% which is: #{ a=>1, b=>1 } + + %% uniqueness violation + %% literally #{ a=>1, "hi"=>"value", a=>2 } + {'EXIT',{badarg,[{_,_,_,_}|_]}} = (catch + erlang:binary_to_term(<<131,116,0,0,0,3,100,0,1,97,107,0,2,104,105,100,0,1,97,97,1,107,0,5,118,97,108,117,101,97,2>>)), + + %% bad size (too large) + {'EXIT',{badarg,[{_,_,_,_}|_]}} = (catch + erlang:binary_to_term(<<131,116,0,0,0,12,100,0,1,97,100,0,1,98,97,1,97,1>>)), + + %% bad size (too small) .. should fail just truncate it .. weird. + %% possibly change external format so truncated will be #{a:=1} + #{ a:=b } = + erlang:binary_to_term(<<131,116,0,0,0,1,100,0,1,97,100,0,1,98,97,1,97,1>>), + + ok. + +map_encode_decode_and_match([{K,V}|Pairs], EncodedPairs, M0) -> + M1 = maps:put(K,V,M0), + B0 = erlang:term_to_binary(M1), + Ls = lists:sort(fun(A,B) -> erts_internal:cmp_term(A,B) < 0 end, [{K, erlang:term_to_binary(K), erlang:term_to_binary(V)}|EncodedPairs]), + %% sort Ks and Vs according to term spec, then match it + ok = match_encoded_map(B0, length(Ls), [Kbin||{_,Kbin,_}<-Ls] ++ [Vbin||{_,_,Vbin}<-Ls]), + %% decode and match it + M1 = erlang:binary_to_term(B0), + map_encode_decode_and_match(Pairs,Ls,M1); +map_encode_decode_and_match([],_,_) -> ok. + +match_encoded_map(<<131,116,Size:32,Encoded/binary>>,Size,Items) -> + match_encoded_map(Encoded,Items); +match_encoded_map(_,_,_) -> no_match_size. + +match_encoded_map(<<>>,[]) -> ok; +match_encoded_map(Bin,[<<131,Item/binary>>|Items]) -> + Size = erlang:byte_size(Item), + <<EncodedTerm:Size/binary, Bin1/binary>> = Bin, + EncodedTerm = Item, %% Asssert + match_encoded_map(Bin1,Items). + + +t_bif_map_to_list(Config) when is_list(Config) -> + [] = maps:to_list(#{}), + [{a,1},{b,2}] = maps:to_list(#{a=>1,b=>2}), + [{a,1},{b,2},{c,3}] = maps:to_list(#{c=>3,a=>1,b=>2}), + [{a,1},{b,2},{g,3}] = maps:to_list(#{g=>3,a=>1,b=>2}), + [{a,1},{b,2},{g,3},{"c",4}] = maps:to_list(#{g=>3,a=>1,b=>2,"c"=>4}), + [{3,v2},{hi,v4},{{hi,3},v5},{"hi",v3},{<<"hi">>,v1}] = maps:to_list(#{ + <<"hi">>=>v1,3=>v2,"hi"=>v3,hi=>v4,{hi,3}=>v5}), + + [{3,v7},{hi,v9},{{hi,3},v10},{"hi",v8},{<<"hi">>,v6}] = maps:to_list(#{ + <<"hi">>=>v1,3=>v2,"hi"=>v3,hi=>v4,{hi,3}=>v5, + <<"hi">>=>v6,3=>v7,"hi"=>v8,hi=>v9,{hi,3}=>v10}), + + %% error cases + {'EXIT', {badarg,_}} = (catch maps:to_list(id(a))), + {'EXIT', {badarg,_}} = (catch maps:to_list(id(42))), + ok. + + +t_bif_map_from_list(Config) when is_list(Config) -> + #{} = maps:from_list([]), + A = maps:from_list([]), + 0 = erlang:map_size(A), + + #{a:=1,b:=2} = maps:from_list([{a,1},{b,2}]), + #{c:=3,a:=1,b:=2} = maps:from_list([{a,1},{b,2},{c,3}]), + #{g:=3,a:=1,b:=2} = maps:from_list([{a,1},{b,2},{g,3}]), + + #{a:=2} = maps:from_list([{a,1},{a,3},{a,2}]), + + #{ <<"hi">>:=v1,3:=v3,"hi":=v6,hi:=v4,{hi,3}:=v5} = + maps:from_list([{3,v3},{"hi",v6},{hi,v4},{{hi,3},v5},{<<"hi">>,v1}]), + + #{<<"hi">>:=v6,3:=v8,"hi":=v11,hi:=v9,{hi,3}:=v10} = + maps:from_list([ {{hi,3},v3}, {"hi",v0},{3,v1}, {<<"hi">>,v4}, {hi,v2}, + {<<"hi">>,v6}, {{hi,3},v10},{"hi",v11}, {hi,v9}, {3,v8}]), + + %% error cases + {'EXIT', {badarg,_}} = (catch maps:from_list(id([{a,b},b]))), + {'EXIT', {badarg,_}} = (catch maps:from_list(id([{a,b},{b,b,3}]))), + {'EXIT', {badarg,_}} = (catch maps:from_list(id([{a,b},<<>>]))), + {'EXIT', {badarg,_}} = (catch maps:from_list(id([{a,b}|{b,a}]))), + {'EXIT', {badarg,_}} = (catch maps:from_list(id(a))), + {'EXIT', {badarg,_}} = (catch maps:from_list(id(42))), + ok. + +%% Maps module, not BIFs +t_maps_fold(_Config) -> + Vs = lists:seq(1,100), + M = maps:from_list([{{k,I},{v,I}}||I<-Vs]), + + %% fold + 5050 = maps:fold(fun({k,_},{v,V},A) -> V + A end, 0, M), + + ok. + +t_maps_map(_Config) -> + Vs = lists:seq(1,100), + M1 = maps:from_list([{I,I}||I<-Vs]), + M2 = maps:from_list([{I,{token,I}}||I<-Vs]), + + M2 = maps:map(fun(_K,V) -> {token,V} end, M1), + ok. + +t_maps_size(_Config) -> + Vs = lists:seq(1,100), + lists:foldl(fun(I,M) -> + M1 = maps:put(I,I,M), + I = maps:size(M1), + M1 + end, #{}, Vs), + ok. + + +t_maps_without(_Config) -> + Ki = [11,22,33,44,55,66,77,88,99], + M0 = maps:from_list([{{k,I},{v,I}}||I<-lists:seq(1,100)]), + M1 = maps:from_list([{{k,I},{v,I}}||I<-lists:seq(1,100) -- Ki]), + M1 = maps:without([{k,I}||I <- Ki],M0), + ok. + + +%% MISC +t_pdict(_Config) -> + + put(#{ a => b, b => a},#{ c => d}), + put(get(#{ a => b, b => a}),1), + 1 = get(#{ c => d}), + #{ c := d } = get(#{ a => b, b => a}). + +t_ets(_Config) -> + + Tid = ets:new(map_table,[]), + + [ets:insert(Tid,{maps:from_list([{I,-I}]),I}) || I <- lists:seq(1,100)], + + + [{#{ 2 := -2},2}] = ets:lookup(Tid,#{ 2 => -2 }), + + %% Test equal + [3,4] = lists:sort( + ets:select(Tid,[{{'$1','$2'}, + [{'or',{'==','$1',#{ 3 => -3 }}, + {'==','$1',#{ 4 => -4 }}}], + ['$2']}])), + %% Test match + [30,50] = lists:sort( + ets:select(Tid, + [{{#{ 30 => -30}, '$1'},[],['$1']}, + {{#{ 50 => -50}, '$1'},[],['$1']}] + )), + + ets:insert(Tid,{#{ a => b, b => c, c => a},transitivity}), + + %% Test equal with map of different size + [] = ets:select(Tid,[{{'$1','_'},[{'==','$1',#{ b => c }}],['$_']}]), + + %% Test match with map of different size + %[{#{ a := b },_}] = ets:select(Tid,[{{#{ b => c },'_'},[],['$_']}]), + + %%% Test match with don't care value + %[{#{ a := b },_}] = ets:select(Tid,[{{#{ b => '_' },'_'},[],['$_']}]), + + %% Test is_map bif + 101 = length(ets:select(Tid,[{'$1',[{is_map,{element,1,'$1'}}],['$1']}])), + ets:insert(Tid,{not_a_map,2}), + 101 = length(ets:select(Tid,[{'$1',[{is_map,{element,1,'$1'}}],['$1']}])), + ets:insert(Tid,{{nope,a,tuple},2}), + 101 = length(ets:select(Tid,[{'$1',[{is_map,{element,1,'$1'}}],['$1']}])), + + %% Test map_size bif + [3] = ets:select(Tid,[{{'$1','_'},[{'==',{map_size,'$1'},3}], + [{map_size,'$1'}]}]), + + true = ets:delete(Tid,#{50 => -50}), + [] = ets:lookup(Tid,#{50 => -50}), + + ets:delete(Tid), + ok. + +t_dets(_Config) -> + ok. + +t_tracing(_Config) -> + + dbg:stop_clear(), + {ok,Tracer} = dbg:tracer(process,{fun trace_collector/2, self()}), + dbg:p(self(),c), + + %% Test basic map call + {ok,_} = dbg:tpl(?MODULE,id,x), + id(#{ a => b }), + {trace,_,call,{?MODULE,id,[#{ a := b }]}} = getmsg(Tracer), + {trace,_,return_from,{?MODULE,id,1},#{ a := b }} = getmsg(Tracer), + dbg:ctpl(), + + %% Test equals in argument list + {ok,_} = dbg:tpl(?MODULE,id,[{['$1'],[{'==','$1',#{ b => c}}], + [{return_trace}]}]), + id(#{ a => b }), + id(#{ b => c }), + {trace,_,call,{?MODULE,id,[#{ b := c }]}} = getmsg(Tracer), + {trace,_,return_from,{?MODULE,id,1},#{ b := c }} = getmsg(Tracer), + dbg:ctpl(), + + %% Test match in head + {ok,_} = dbg:tpl(?MODULE,id,[{[#{b => c}],[],[]}]), + id(#{ a => b }), + id(#{ b => c }), + {trace,_,call,{?MODULE,id,[#{ b := c }]}} = getmsg(Tracer), + dbg:ctpl(), + + % Test map guard bifs + {ok,_} = dbg:tpl(?MODULE,id,[{['$1'],[{is_map,{element,1,'$1'}}],[]}]), + id(#{ a => b }), + id({1,2}), + id({#{ a => b},2}), + {trace,_,call,{?MODULE,id,[{#{ a := b },2}]}} = getmsg(Tracer), + dbg:ctpl(), + + {ok,_} = dbg:tpl(?MODULE,id,[{['$1'],[{'==',{map_size,{element,1,'$1'}},2}],[]}]), + id(#{ a => b }), + id({1,2}), + id({#{ a => b},2}), + id({#{ a => b, b => c},atom}), + {trace,_,call,{?MODULE,id,[{#{ a := b, b := c },atom}]}} = getmsg(Tracer), + dbg:ctpl(), + + %MS = dbg:fun2ms(fun([A]) when A == #{ a => b} -> ok end), + %dbg:tpl(?MODULE,id,MS), + %id(#{ a => b }), + %id(#{ b => c }), + %{trace,_,call,{?MODULE,id,[#{ a := b }]}} = getmsg(Tracer), + %dbg:ctpl(), + + %% Check to extra messages + timeout = getmsg(Tracer), + + dbg:stop_clear(), + ok. + +getmsg(_Tracer) -> + receive V -> V after 100 -> timeout end. + +trace_collector(Msg,Parent) -> + io:format("~p~n",[Msg]), + Parent ! Msg, + Parent. + +%% Use this function to avoid compile-time evaluation of an expression. +id(I) -> I. diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl index affb66289b..bcc1f9e5af 100644 --- a/erts/emulator/test/nif_SUITE.erl +++ b/erts/emulator/test/nif_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2013. All Rights Reserved. +%% Copyright Ericsson AB 2010-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -29,7 +29,8 @@ init_per_group/2,end_per_group/2, init_per_testcase/2, end_per_testcase/2, basic/1, reload/1, upgrade/1, heap_frag/1, - types/1, many_args/1, binaries/1, get_string/1, get_atom/1, + types/1, many_args/1, binaries/1, get_string/1, get_atom/1, + maps/1, api_macros/1, from_array/1, iolist_as_binary/1, resource/1, resource_binary/1, resource_takeover/1, @@ -58,7 +59,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [basic, reload, upgrade, heap_frag, types, many_args, - binaries, get_string, get_atom, api_macros, from_array, + binaries, get_string, get_atom, maps, api_macros, from_array, iolist_as_binary, resource, resource_binary, resource_takeover, threading, send, send2, send3, send_threaded, neg, is_checks, get_length, make_atom, @@ -435,6 +436,54 @@ get_atom(Config) when is_list(Config) -> ?line {0, <<>>} = atom_to_bin('',0), ok. +maps(doc) -> ["Test NIF maps handling."]; +maps(suite) -> []; +maps(Config) when is_list(Config) -> + TmpMem = tmpmem(), + Pairs = [{adam, "bert"}] ++ + [{I,I}||I <- lists:seq(1,10)] ++ + [{a,value},{"a","value"},{<<"a">>,<<"value">>}], + ok = ensure_lib_loaded(Config, 1), + M = maps_from_list_nif(Pairs), + R = {RIs,Is} = sorted_list_from_maps_nif(M), + io:format("Pairs: ~p~nMap: ~p~nReturned: ~p~n", [lists:sort(Pairs),M,R]), + Is = lists:sort(Pairs), + Is = lists:reverse(RIs), + + #{} = maps_from_list_nif([]), + {[],[]} = sorted_list_from_maps_nif(#{}), + + 1 = is_map_nif(M), + 0 = is_map_nif("no map"), + + Msz = map_size(M), + {1,Msz} = get_map_size_nif(M), + {1,0} = get_map_size_nif(#{}), + {0,-123} = get_map_size_nif({#{}}), + + #{} = M0 = make_new_map_nif(), + + {1, #{key := value}=M1} = make_map_put_nif(M0, key, value), + {1, #{key := value, "key2" := "value2"}=M2} = make_map_put_nif(M1, "key2", "value2"), + {1, #{key := "value", "key2" := "value2"}=M3} = make_map_put_nif(M2, key, "value"), + {0, undefined} = make_map_put_nif(666, key, value), + + {1, "value2"} = get_map_value_nif(M3,"key2"), + {0, undefined} = get_map_value_nif(M3,"key3"), + {0, undefined} = get_map_value_nif(false,key), + + {0, undefined} = make_map_update_nif(M0, key, value), + {0, undefined} = make_map_update_nif(M1, "key2", "value2"), + {1, #{key := "value", "key2" := "value2"}} = make_map_update_nif(M2, key, "value"), + {0, undefined} = make_map_update_nif(666, key, value), + + {1, #{}} = make_map_remove_nif(M1, key), + {1, M1} = make_map_remove_nif(M2, "key2"), + {1, M2} = make_map_remove_nif(M2, "key3"), + {0, undefined} = make_map_remove_nif(self(), key), + + ok. + api_macros(doc) -> ["Test macros enif_make_list<N> and enif_make_tuple<N>"]; api_macros(suite) -> []; api_macros(Config) when is_list(Config) -> @@ -1488,5 +1537,17 @@ otp_9668_nif(_) -> ?nif_stub. consume_timeslice_nif(_,_) -> ?nif_stub. call_dirty_nif(_,_,_) -> ?nif_stub. +%% maps +is_map_nif(_) -> ?nif_stub. +get_map_size_nif(_) -> ?nif_stub. +make_new_map_nif() -> ?nif_stub. +make_map_put_nif(_,_,_) -> ?nif_stub. +get_map_value_nif(_,_) -> ?nif_stub. +make_map_update_nif(_,_,_) -> ?nif_stub. +make_map_remove_nif(_,_) -> ?nif_stub. +maps_from_list_nif(_) -> ?nif_stub. +sorted_list_from_maps_nif(_) -> ?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 6f902e186d..b550d1f16d 100644 --- a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c +++ b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2009-2013. All Rights Reserved. + * Copyright Ericsson AB 2009-2014. 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 @@ -1536,6 +1536,132 @@ static ERL_NIF_TERM call_dirty_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM } #endif +static ERL_NIF_TERM is_map_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + return enif_make_int(env, enif_is_map(env,argv[0])); +} +static ERL_NIF_TERM get_map_size_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + size_t size = (size_t)-123; + int ret = enif_get_map_size(env, argv[0], &size); + return enif_make_tuple2(env, enif_make_int(env, ret), enif_make_int(env, (int)size)); +} +static ERL_NIF_TERM make_new_map_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + return enif_make_new_map(env); +} +static ERL_NIF_TERM make_map_put_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ERL_NIF_TERM map_out = enif_make_atom(env, "undefined"); + int ret = enif_make_map_put(env, argv[0], argv[1], argv[2], &map_out); + return enif_make_tuple2(env, enif_make_int(env,ret), map_out); +} +static ERL_NIF_TERM get_map_value_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ERL_NIF_TERM value = enif_make_atom(env, "undefined"); + int ret = enif_get_map_value(env, argv[0], argv[1], &value); + return enif_make_tuple2(env, enif_make_int(env,ret), value); + +} +static ERL_NIF_TERM make_map_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ERL_NIF_TERM map_out = enif_make_atom(env, "undefined"); + int ret = enif_make_map_update(env, argv[0], argv[1], argv[2], &map_out); + return enif_make_tuple2(env, enif_make_int(env,ret), map_out); +} +static ERL_NIF_TERM make_map_remove_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ERL_NIF_TERM map_out = enif_make_atom(env, "undefined"); + int ret = enif_make_map_remove(env, argv[0], argv[1], &map_out); + return enif_make_tuple2(env, enif_make_int(env,ret), map_out); +} + +/* maps */ +static ERL_NIF_TERM maps_from_list_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ERL_NIF_TERM cell = argv[0]; + ERL_NIF_TERM map = enif_make_new_map(env); + ERL_NIF_TERM tuple; + const ERL_NIF_TERM *pair; + int arity = -1; + + if (argc != 1 && !enif_is_list(env, cell)) return enif_make_badarg(env); + + /* assume sorted keys */ + + while (!enif_is_empty_list(env,cell)) { + if (!enif_get_list_cell(env, cell, &tuple, &cell)) return enif_make_badarg(env); + if (enif_get_tuple(env,tuple,&arity,&pair)) { + enif_make_map_put(env, map, pair[0], pair[1], &map); + } + } + + return map; +} + +static ERL_NIF_TERM sorted_list_from_maps_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { + + ERL_NIF_TERM map = argv[0]; + ERL_NIF_TERM list_f = enif_make_list(env, 0); /* NIL */ + ERL_NIF_TERM list_b = enif_make_list(env, 0); /* NIL */ + ERL_NIF_TERM key, value, k2, v2; + ErlNifMapIterator iter_f; + ErlNifMapIterator iter_b; + int cnt, next_ret, prev_ret; + + if (argc != 1 && !enif_is_map(env, map)) + return enif_make_int(env, __LINE__); + + if(!enif_map_iterator_create(env, map, &iter_f, ERL_NIF_MAP_ITERATOR_HEAD)) + return enif_make_int(env, __LINE__); + + cnt = 0; + while(enif_map_iterator_get_pair(env,&iter_f,&key,&value)) { + if (cnt && !next_ret) + return enif_make_int(env, __LINE__); + list_f = enif_make_list_cell(env, enif_make_tuple2(env, key, value), list_f); + next_ret = enif_map_iterator_next(env,&iter_f); + cnt++; + } + if (cnt && next_ret) + return enif_make_int(env, __LINE__); + + if(!enif_map_iterator_create(env, map, &iter_b, ERL_NIF_MAP_ITERATOR_TAIL)) + return enif_make_int(env, __LINE__); + + cnt = 0; + while(enif_map_iterator_get_pair(env,&iter_b,&key,&value)) { + if (cnt && !prev_ret) + return enif_make_int(env, __LINE__); + + /* Test that iter_f can step "backwards" */ + if (!enif_map_iterator_prev(env,&iter_f) + || !enif_map_iterator_get_pair(env,&iter_f,&k2,&v2) + || k2 != key || v2 != value) { + return enif_make_int(env, __LINE__); + } + + list_b = enif_make_list_cell(env, enif_make_tuple2(env, key, value), list_b); + prev_ret = enif_map_iterator_prev(env,&iter_b); + } + + if (cnt) { + if (prev_ret || enif_map_iterator_prev(env,&iter_f)) + return enif_make_int(env, __LINE__); + + /* Test that iter_b can step "backwards" one step */ + if (!enif_map_iterator_next(env, &iter_b) + || !enif_map_iterator_get_pair(env,&iter_b,&k2,&v2) + || k2 != key || v2 != value) + return enif_make_int(env, __LINE__); + } + + enif_map_iterator_destroy(env, &iter_f); + enif_map_iterator_destroy(env, &iter_b); + + return enif_make_tuple2(env, list_f, list_b); +} + static ErlNifFunc nif_funcs[] = { {"lib_version", 0, lib_version}, @@ -1589,6 +1715,15 @@ static ErlNifFunc nif_funcs[] = #ifdef ERL_NIF_DIRTY_SCHEDULER_SUPPORT {"call_dirty_nif", 3, call_dirty_nif}, #endif + {"is_map_nif", 1, is_map_nif}, + {"get_map_size_nif", 1, get_map_size_nif}, + {"make_new_map_nif", 0, make_new_map_nif}, + {"make_map_put_nif", 3, make_map_put_nif}, + {"get_map_value_nif", 2, get_map_value_nif}, + {"make_map_update_nif", 3, make_map_update_nif}, + {"make_map_remove_nif", 2, make_map_remove_nif}, + {"maps_from_list_nif", 1, maps_from_list_nif}, + {"sorted_list_from_maps_nif", 1, sorted_list_from_maps_nif} }; 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 b631f55a03..8e1f8df43a 100644 --- a/erts/emulator/test/send_term_SUITE.erl +++ b/erts/emulator/test/send_term_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2013. All Rights Reserved. +%% Copyright Ericsson AB 2005-2014. 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,7 +62,19 @@ basic(Config) when is_list(Config) -> ?line [] = term(P, 0), ?line Self = self(), - ?line {blurf,42,[],[-42,{}|"abc"++P],"kalle",3.1416,Self} = term(P, 1), + {blurf,42,[],[-42,{}|"abc"++P],"kalle",3.1416,Self,#{}} = term(P, 1), + + Map41 = maps:from_list([{blurf, 42}, + {[], [-42,{}|"abc"++P]}, + {"kalle", 3.1416}, + {Self, #{}}]), + Map41 = term(P, 41), + + Map42 = maps:from_list([{42, []}, + {[-42,{}|"abc"++P], "kalle"}, + {3.1416, Self}, + {#{}, blurf}]), + Map42 = term(P, 42), ?line Deep = lists:seq(0, 199), ?line Deep = term(P, 2), ?line {B1,B2} = term(P, 3), @@ -125,7 +137,8 @@ basic(Config) when is_list(Config) -> {-1, 36}, % ERL_DRV_INT64 {-4711, 37}, % ERL_DRV_INT64 {-20233590931456, 38}, % ERL_DRV_INT64 - {-9223372036854775808, 39}], % ERL_DRV_INT64 + {-9223372036854775808, 39}, + {#{}, 40}], % ERL_DRV_MAP ?line {Terms, Ops} = lists:unzip(Singles), ?line Terms = term(P,Ops), diff --git a/erts/emulator/test/send_term_SUITE_data/send_term_drv.c b/erts/emulator/test/send_term_SUITE_data/send_term_drv.c index f8613487b0..381a4f20d5 100644 --- a/erts/emulator/test/send_term_SUITE_data/send_term_drv.c +++ b/erts/emulator/test/send_term_SUITE_data/send_term_drv.c @@ -104,7 +104,7 @@ static void send_term_drv_run(ErlDrvData port, char *buf, ErlDrvSizeT count) double f = 3.1416; msg[0] = ERL_DRV_ATOM; - msg[1] = driver_mk_atom("blurf"), + msg[1] = driver_mk_atom("blurf"); msg[2] = ERL_DRV_INT; msg[3] = (ErlDrvTermData) 42; msg[4] = ERL_DRV_NIL; @@ -126,9 +126,11 @@ static void send_term_drv_run(ErlDrvData port, char *buf, ErlDrvSizeT count) msg[20] = (ErlDrvTermData) &f; msg[21] = ERL_DRV_PID; msg[22] = driver_connected(erlang_port); - msg[23] = ERL_DRV_TUPLE; - msg[24] = (ErlDrvTermData) 7; - msg += 25; + msg[23] = ERL_DRV_MAP; + msg[24] = (ErlDrvTermData) 0; + msg[25] = ERL_DRV_TUPLE; + msg[26] = (ErlDrvTermData) 8; + msg += 27; } break; @@ -481,6 +483,52 @@ static void send_term_drv_run(ErlDrvData port, char *buf, ErlDrvSizeT count) break; } + case 40: { + msg[0] = ERL_DRV_MAP; + msg[1] = (ErlDrvTermData) 0; + msg += 2; + break; + } + + case 41: /* Most term types inside a map */ + case 42: { + double f = 3.1416; + + if (buf[i] == 41) { + *msg++ = ERL_DRV_ATOM; + *msg++ = driver_mk_atom("blurf"); + } + *msg++ = ERL_DRV_INT; + *msg++ = (ErlDrvTermData)42; + *msg++ = ERL_DRV_NIL; + *msg++ = ERL_DRV_INT; + *msg++ = (ErlDrvTermData)-42; + *msg++ = ERL_DRV_TUPLE; + *msg++ = (ErlDrvTermData)0; + *msg++ = ERL_DRV_PORT; + *msg++ = driver_mk_port(erlang_port); + *msg++ = ERL_DRV_STRING_CONS; + *msg++ = (ErlDrvTermData)"abc"; + *msg++ = (ErlDrvTermData)3; + *msg++ = ERL_DRV_LIST; + *msg++ = (ErlDrvTermData)3; + *msg++ = ERL_DRV_STRING; + *msg++ = (ErlDrvTermData)"kalle"; + *msg++ = (ErlDrvTermData)5; + *msg++ = ERL_DRV_FLOAT; + *msg++ = (ErlDrvTermData)&f; + *msg++ = ERL_DRV_PID; + *msg++ = driver_connected(erlang_port); + *msg++ = ERL_DRV_MAP; + *msg++ = (ErlDrvTermData)0; + if (buf[i] == 42) { + *msg++ = ERL_DRV_ATOM; + *msg++ = driver_mk_atom("blurf"); + } + *msg++ = ERL_DRV_MAP; + *msg++ = (ErlDrvTermData)4; + break; + } case 127: /* Error cases */ { @@ -662,6 +710,22 @@ static void send_term_drv_run(ErlDrvData port, char *buf, ErlDrvSizeT count) FAIL_TERM(msg, 2); } + msg[0] = ERL_DRV_MAP; + msg[1] = (ErlDrvTermData) 0; + FAIL_TERM(msg, 1); + + /* map with duplicate key */ + msg[0] = ERL_DRV_ATOM; + msg[1] = driver_mk_atom("key"); + msg[2] = ERL_DRV_NIL; + msg[3] = ERL_DRV_ATOM; + msg[4] = driver_mk_atom("key"); + msg[5] = ERL_DRV_INT; + msg[6] = (ErlDrvTermData) -4711; + msg[7] = ERL_DRV_MAP; + msg[8] = 2; + FAIL_TERM(msg, 9); + /* Signal end of test case */ msg[0] = ERL_DRV_NIL; erl_drv_output_term(driver_mk_port(erlang_port), msg, 1); diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops index 16a949c2a6..0b7c16f606 100755 --- a/erts/emulator/utils/beam_makeops +++ b/erts/emulator/utils/beam_makeops @@ -1202,6 +1202,7 @@ sub parse_transformation { my($from, $to) = split(/\s*=>\s*/); my(@op); + my $rest_var; # The source instructions. @@ -1212,7 +1213,7 @@ sub parse_transformation { $_ = (&compile_transform_function($name, split(/\s*,\s*/, $arglist))); } else { (@op) = split; - $_ = &compile_transform(1, @op); + ($rest_var,$_) = compile_transform(1, $rest_var, @op); } } @@ -1230,7 +1231,7 @@ sub parse_transformation { @to = split(/\s*\|\s*/, $to); foreach (@to) { (@op) = split; - $_ = &compile_transform(0, @op); + (undef,$_) = compile_transform(0, $rest_var, @op); } } push(@transformations, [$., $orig, [@from], [reverse @to]]); @@ -1243,12 +1244,18 @@ sub compile_transform_function { } sub compile_transform { - my($src, $name, @ops) = @_; + my($src, $rest_var, $name, @ops) = @_; my $arity = 0; - + foreach (@ops) { my(@list) = &tr_parse_op($src, $_); - $arity++ unless $list[1] eq '*'; + if ($list[1] eq '*') { + $rest_var = $list[0]; + } elsif (defined $rest_var and $list[0] eq $rest_var) { + $list[1] = '*'; + } else { + $arity++; + } $_ = [ @list ]; } @@ -1260,7 +1267,7 @@ sub compile_transform { $is_transformed{$name,$arity} = 1; } - [$name,$arity,@ops]; + ($rest_var,[$name,$arity,@ops]); } sub tr_parse_op { @@ -1681,7 +1688,9 @@ sub tr_gen_to { foreach $op (@ops) { my($var, $type, $type_val) = @$op; - if ($var ne '') { + if ($type eq '*') { + push(@code, make_op($var, 'store_rest_args', $var{$var})); + } elsif ($var ne '') { &error($where, "variable '$var' unbound") unless defined $var{$var}; push(@code, &make_op($var, 'store_var_next_arg', $var{$var})); diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam Binary files differindex f38377647c..eb696bb32f 100644 --- a/erts/preloaded/ebin/erlang.beam +++ b/erts/preloaded/ebin/erlang.beam diff --git a/erts/preloaded/ebin/erts_internal.beam b/erts/preloaded/ebin/erts_internal.beam Binary files differindex 12b36913a9..4a84b3945a 100644 --- a/erts/preloaded/ebin/erts_internal.beam +++ b/erts/preloaded/ebin/erts_internal.beam diff --git a/erts/preloaded/ebin/prim_file.beam b/erts/preloaded/ebin/prim_file.beam Binary files differindex d5a1ec766d..e40e33b332 100644 --- a/erts/preloaded/ebin/prim_file.beam +++ b/erts/preloaded/ebin/prim_file.beam diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl index ee5bd3e515..fbc37bd955 100644 --- a/erts/preloaded/src/erlang.erl +++ b/erts/preloaded/src/erlang.erl @@ -104,10 +104,9 @@ -export([list_to_bitstring/1, list_to_existing_atom/1, list_to_float/1]). -export([list_to_integer/1, list_to_integer/2]). -export([list_to_pid/1, list_to_tuple/1, loaded/0]). --export([localtime/0, make_ref/0, match_spec_test/3, md5/1, md5_final/1]). +-export([localtime/0, make_ref/0, map_size/1, match_spec_test/3, md5/1, md5_final/1]). -export([md5_init/0, md5_update/2, module_loaded/1, monitor/2]). --export([monitor_node/2, monitor_node/3, nif_error/1, nif_error/2 -]). +-export([monitor_node/2, monitor_node/3, nif_error/1, nif_error/2]). -export([node/0, node/1, now/0, phash/2, phash2/1, phash2/2]). -export([pid_to_list/1, port_close/1, port_command/2, port_command/3]). -export([port_connect/2, port_control/3, port_get_data/1]). @@ -128,7 +127,7 @@ -export([abs/1, append/2, element/2, get_module_info/2, hd/1, is_atom/1, is_binary/1, is_bitstring/1, is_boolean/1, is_float/1, is_function/1, is_function/2, is_integer/1, - is_list/1, is_number/1, is_pid/1, is_port/1, is_record/2, + is_list/1, is_map/1, is_number/1, is_pid/1, is_port/1, is_record/2, is_record/3, is_reference/1, is_tuple/1, load_module/2, load_nif/2, localtime_to_universaltime/2, make_fun/3, make_tuple/2, make_tuple/3, nodes/1, open_port/2, @@ -1149,6 +1148,12 @@ localtime() -> make_ref() -> erlang:nif_error(undefined). +%% Shadowed by erl_bif_types: erlang:map_size/1 +-spec map_size(Map) -> non_neg_integer() when + Map :: map(). +map_size(_Map) -> + erlang:nif_error(undefined). + %% match_spec_test/3 -spec erlang:match_spec_test(P1, P2, P3) -> TestResult when P1 :: [term()] | tuple(), @@ -1739,6 +1744,12 @@ is_number(_Term) -> is_pid(_Term) -> erlang:nif_error(undefined). +%% Shadowed by erl_bif_types: erlang:is_map/1 +-spec is_map(Map) -> boolean() when + Map :: map(). +is_map(_Map) -> + erlang:nif_error(undefined). + %% Shadowed by erl_bif_types: erlang:is_port/1 -spec is_port(Term) -> boolean() when Term :: term(). diff --git a/erts/preloaded/src/erts_internal.erl b/erts/preloaded/src/erts_internal.erl index d6a185482e..edcd50c77e 100644 --- a/erts/preloaded/src/erts_internal.erl +++ b/erts/preloaded/src/erts_internal.erl @@ -30,6 +30,7 @@ -export([await_port_send_result/3]). -export([binary_to_term/1, binary_to_term/2]). +-export([cmp_term/2]). -export([port_command/3, port_connect/2, port_close/1, port_control/3, port_call/3, port_info/1, port_info/2]). @@ -170,3 +171,13 @@ binary_to_term(_Binary) -> Opts :: [safe]. binary_to_term(_Binary, _Opts) -> erlang:nif_error(undefined). + +%% term compare where integer() < float() = true + +-spec cmp_term(A,B) -> Result when + A :: term(), + B :: term(), + Result :: -1 | 0 | 1. + +cmp_term(_A,_B) -> + erlang:nif_error(undefined). diff --git a/erts/preloaded/src/prim_file.erl b/erts/preloaded/src/prim_file.erl index 5999e98340..34679404a2 100644 --- a/erts/preloaded/src/prim_file.erl +++ b/erts/preloaded/src/prim_file.erl @@ -27,7 +27,7 @@ %% Generic file contents operations -export([open/2, close/1, datasync/1, sync/1, advise/4, position/2, truncate/1, write/2, pwrite/2, pwrite/3, read/2, read_line/1, pread/2, pread/3, - copy/3, sendfile/10, allocate/3]). + copy/3, sendfile/8, allocate/3]). %% Specialized file operations -export([open/1, open/3]). @@ -149,6 +149,9 @@ -define(POSIX_FADV_DONTNEED, 4). -define(POSIX_FADV_NOREUSE, 5). +%% Sendfile flags +-define(EFILE_SENDFILE_USE_THREADS, 1). + %%% BIFs @@ -582,13 +585,14 @@ write_file(_, _) -> % {error, enotsup}; sendfile(#file_descriptor{module = ?MODULE, data = {Port, _}}, Dest, Offset, Bytes, _ChunkSize, Headers, Trailers, - _Nodiskio, _MNowait, _Sync) -> + Flags) -> case erlang:port_get_data(Dest) of Data when Data == inet_tcp; Data == inet6_tcp -> ok = inet:lock_socket(Dest,true), {ok, DestFD} = prim_inet:getfd(Dest), + IntFlags = translate_sendfile_flags(Flags), try drv_command(Port, [<<?FILE_SENDFILE, DestFD:32, - 0:8, + IntFlags:8, Offset:64/unsigned, Bytes:64/unsigned, (iolist_size(Headers)):32/unsigned, @@ -601,6 +605,13 @@ sendfile(#file_descriptor{module = ?MODULE, data = {Port, _}}, {error,badarg} end. +translate_sendfile_flags([{use_threads,true}|T]) -> + ?EFILE_SENDFILE_USE_THREADS bor translate_sendfile_flags(T); +translate_sendfile_flags([_|T]) -> + translate_sendfile_flags(T); +translate_sendfile_flags([]) -> + 0. + %%%----------------------------------------------------------------- %%% Functions operating on files without handle to the file. ?DRV. diff --git a/erts/vsn.mk b/erts/vsn.mk index 8e77a9a26e..88a393f3d5 100644 --- a/erts/vsn.mk +++ b/erts/vsn.mk @@ -22,7 +22,7 @@ VSN = 6.0 # OTP major version SYSTEM_VSN = 17 # OTP correction package version -SYSTEM_CP_VSN = 17.0-rc0 +SYSTEM_CP_VSN = 17.0-rc1 # Port number 4365 in 4.2 # Port number 4366 in 4.3 diff --git a/lib/asn1/doc/src/asn1_ug.xml b/lib/asn1/doc/src/asn1_ug.xml index 74c4aa9948..eb9f000e75 100644 --- a/lib/asn1/doc/src/asn1_ug.xml +++ b/lib/asn1/doc/src/asn1_ug.xml @@ -653,7 +653,7 @@ Day1 = saturday, Bits1 ::= BIT STRING Bits2 ::= BIT STRING {foo(0),bar(1),gnu(2),gnome(3),punk(14)} </pre> - <p>There are five different notations available for representation of + <p>There are two notations available for representation of BIT STRING values in Erlang and as input to the encode functions.</p> <list type="ordered"> <item>A bitstring. By default, a BIT STRING with no @@ -661,43 +661,10 @@ Bits2 ::= BIT STRING {foo(0),bar(1),gnu(2),gnome(3),punk(14)} <item>A list of atoms corresponding to atoms in the <c>NamedBitList</c> in the BIT STRING definition. A BIT STRING with symbolic names will always be decoded to this format.</item> - <item>A list of binary digits (0 or 1). This format is always - accepted as input to the encode functions. A BIT STRING will - be decoded to this format if <em>legacy_bit_string</em> option - has been given. <em>This format may be withdrawn in a future - release.</em> - </item> - <item>As <c>{Unused,Binary}</c> where <c>Unused</c> denotes how - many trailing zero-bits 0 to 7 that are unused in the least - significant byte in <c>Binary</c>. This format is always - accepted as input to the encode functions. A BIT STRING will - be decoded to this format if <em>compact_bit_string</em> has - been given. <em>This format may be withdrawn in a future - release.</em> - </item> - <item>A hexadecimal number (or an integer). This format should be - avoided, since it is easy to misinterpret a <c>BIT STRING</c> - value in this format. <em>This format may be withdrawn in a future - release.</em> - </item> </list> - <note> - <p>It is recommended to either use the bitstring format (for - BIT STRINGs with no symbolic names) or a list of symbolic - names (for BIT STRINGs with symbolic names). The other formats - should be avoided since they may be withdrawn in a future - release. - </p> - </note> + <p>Example:</p> <pre> Bits1Val1 = <<0:1,1:1,0:1,1:1,1:1>>, -Bits1Val2 = 16#1A, -Bits1Val3 = {3,<<0:1,1:1,0:1,1:1,1:1,0:3>>}, -Bits1Val4 = [0,1,0,1,1] - </pre> - <p>Note that <c>Bits1Val1</c>, <c>Bits1Val2</c>, <c>Bits1Val3</c>, - and <c>Bits1Val1</c> denote the same value.</p> - <pre> Bits2Val1 = [gnu,punk], Bits2Val2 = <<2#1110:4>>, Bits2Val3 = [bar,gnu,gnome], @@ -708,37 +675,60 @@ Bits2Val3 = [bar,gnu,gnome], 2 and 14 are set to 1 and the rest set to 0. The symbolic values appear as a list of values. If a named value appears, which is not specified in the type definition, a run-time error will occur.</p> - <p>The compact notation equivalent to the empty BIT STRING is - <c><![CDATA[{0,<<>>}]]></c>, which in the other notations is - <c><![CDATA[<<>>]]></c>, <c>[]</c>, or - <c>0</c>.</p> <p>BIT STRINGS may also be sub-typed with, for example, a SIZE specification:</p> <pre> Bits3 ::= BIT STRING (SIZE(0..31)) </pre> <p>This means that no bit higher than 31 can ever be set.</p> + + <section> + <title>Deprecated representations for BIT STRING</title> + <p>In addition to the representations described above, the + following deprecated representations are available if the + specification has been compiled with the + <c>legacy_erlang_types</c> option:</p> + <list type="ordered"> + <item>A list of binary digits (0 or 1). This format is + accepted as input to the encode functions, and a BIT STRING + will be decoded to this format if the + <em>legacy_bit_string</em> option has been given. + </item> + <item>As <c>{Unused,Binary}</c> where <c>Unused</c> denotes + how many trailing zero-bits 0 to 7 that are unused in the + least significant byte in <c>Binary</c>. This format is + accepted as input to the encode functions, and a <c>BIT + STRING</c> will be decoded to this format if + <em>compact_bit_string</em> has been given. + </item> + <item>A hexadecimal number (or an integer). This format + should be avoided, since it is easy to misinterpret a BIT + STRING value in this format. + </item> + </list> + </section> </section> <section> <marker id="OCTET STRING"></marker> <title>OCTET STRING</title> - <p>The OCTET STRING is the simplest of all ASN.1 types The OCTET STRING - only moves or transfers e.g. binary files or other unstructured - information complying to two rules. - Firstly, the bytes consist of octets and secondly, encoding is - not required.</p> + <p>The OCTET STRING is the simplest of all ASN.1 types. The + OCTET STRING only moves or transfers e.g. binary files or other + unstructured information complying to two rules. Firstly, the + bytes consist of octets and secondly, encoding is not + required.</p> <p>It is possible to have the following ASN.1 type definitions:</p> <pre> O1 ::= OCTET STRING O2 ::= OCTET STRING (SIZE(28)) </pre> <p>With the following example assignments in Erlang:</p> <pre> -O1Val = [17,13,19,20,0,0,255,254], -O2Val = "must be exactly 28 chars....", </pre> - <p>Observe that <c>O1Val</c> is assigned a series of numbers between 0 - and 255 i.e. octets. - <c>O2Val</c> is assigned using the string notation. - </p> +O1Val = <<17,13,19,20,0,0,255,254>>, +O2Val = <<"must be exactly 28 chars....">>,</pre> + <p>By default, an OCTET STRING is always represented as + an Erlang binary. If the specification has been compiled with + the <c>legacy_erlang_types</c> option, the encode functions + will accept both lists and binaries, and the decode functions + will decode an OCTET STRING to a list.</p> </section> <section> diff --git a/lib/asn1/doc/src/asn1ct.xml b/lib/asn1/doc/src/asn1ct.xml index ada2aace87..5871c8ad68 100644 --- a/lib/asn1/doc/src/asn1ct.xml +++ b/lib/asn1/doc/src/asn1ct.xml @@ -42,6 +42,17 @@ can be used in during development of applications which handles ASN.1 data (encoded as BER or PER).</p> <note> + <p>By default in OTP 17, the representation of the BIT STRING + and OCTET STRING types as Erlang terms have changed. BIT + STRING values are now Erlang bitstrings and OCTET STRING values + are binaries. For details see <seealso + marker="asn1_ug#BIT STRING">BIT STRING</seealso> and <seealso + marker="asn1_ug#OCTET STRING">OCTET STRING</seealso> in User's + Guide.</p> + <p>To revert to the old representation of the types, use the + <c>legacy_erlang_types</c> option.</p> + </note> + <note> <p>In R16, the options have been simplified. The back-end is chosen using one of the options <c>ber</c>, <c>per</c>, or <c>uper</c>. The options <c>optimize</c>, <c>nif</c>, and <c>driver</c> options @@ -64,7 +75,7 @@ <v>Asn1module = atom() | string()</v> <v>Options = [Option| OldOption]</v> <v>Option = ber | per | uper | der | compact_bit_string | - legacy_bit_string | + legacy_bit_string | legacy_erlang_types | noobj | {n2n, EnumTypeName} |{outdir, Dir} | {i, IncludeDir} | asn1config | undec_rest | no_ok_wrapper | {macro_name_prefix, Prefix} | {record_name_prefix, Prefix} | verbose | warnings_as_errors</v> @@ -163,6 +174,7 @@ File3.asn </pre> BIT STRING type section in the Users Guide </seealso>. </p> + <p>This option implies the <c>legacy_erlang_types</c> option.</p> </item> <tag><c>legacy_bit_string</c></tag> <item> @@ -175,8 +187,19 @@ File3.asn </pre> <seealso marker="asn1_ug#BIT STRING"> BIT STRING type section in the Users Guide </seealso>. + <p>This option implies the <c>legacy_erlang_types</c> option.</p> </p> </item> + <tag><c>legacy_erlang_types</c></tag> + <item> + <p>Use the same Erlang types to represent BIT STRING and + OCTET STRING as in R16. For details see <seealso + marker="asn1_ug#BIT STRING">BIT STRING</seealso> and + <seealso marker="asn1_ug#OCTET STRING">OCTET + STRING</seealso> in User's Guide.</p> + <p><em>This option is not recommended for + new code.</em></p> + </item> <tag><c>{n2n, EnumTypeName}</c></tag> <item> <p> diff --git a/lib/asn1/src/asn1ct.erl b/lib/asn1/src/asn1ct.erl index f2e9606ccb..531a4935fe 100644 --- a/lib/asn1/src/asn1ct.erl +++ b/lib/asn1/src/asn1ct.erl @@ -40,7 +40,7 @@ maybe_rename_function/3,current_sindex/0, set_current_sindex/1,maybe_saved_sindex/2, parse_and_save/2,verbose/3,warning/3,warning/4,error/3]). --export([get_bit_string_format/0]). +-export([get_bit_string_format/0,use_legacy_types/0]). -include("asn1_records.hrl"). -include_lib("stdlib/include/erl_compile.hrl"). @@ -841,6 +841,7 @@ delete_double_of_symbol1([],Acc) -> generate({M,GenTOrV}, OutFile, EncodingRule, Options) -> debug_on(Options), setup_bit_string_format(Options), + setup_legacy_erlang_types(Options), put(encoding_options,Options), asn1ct_table:new(check_functions), @@ -869,6 +870,31 @@ generate({M,GenTOrV}, OutFile, EncodingRule, Options) -> asn1ct_table:delete(check_functions), Result. +setup_legacy_erlang_types(Opts) -> + F = case lists:member(legacy_erlang_types, Opts) of + false -> + case get_bit_string_format() of + bitstring -> + false; + compact -> + legacy_forced_info(compact_bit_string), + true; + legacy -> + legacy_forced_info(legacy_bit_string), + true + end; + true -> + true + end, + put(use_legacy_erlang_types, F). + +legacy_forced_info(Opt) -> + io:format("Info: The option 'legacy_erlang_types' " + "is implied by the '~s' option.\n", [Opt]). + +use_legacy_types() -> + get(use_legacy_erlang_types). + setup_bit_string_format(Opts) -> Format = case {lists:member(compact_bit_string, Opts), lists:member(legacy_bit_string, Opts)} of @@ -1075,6 +1101,7 @@ remove_asn_flags(Options) -> X /= optimize, X /= compact_bit_string, X /= legacy_bit_string, + X /= legacy_erlang_types, X /= debug, X /= asn1config, X /= record_name_prefix]. diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index 0a13801e08..f94f3b56bc 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -2574,6 +2574,18 @@ normalize_bitstring(S, Value, Type)-> Bs end. +hstring_to_binary(L) -> + byte_align(hstring_to_bitstring(L)). + +bstring_to_binary(L) -> + byte_align(bstring_to_bitstring(L)). + +byte_align(Bs) -> + case bit_size(Bs) rem 8 of + 0 -> Bs; + N -> <<Bs/bitstring,0:(8-N)>> + end. + hstring_to_bitstring(L) -> << <<(hex_to_int(D)):4>> || D <- L >>. @@ -2592,9 +2604,9 @@ hex_to_int(D) when $A =< D, D =< $F -> D - ($A - 10). normalize_octetstring(S,Value,CType) -> case Value of {bstring,String} -> - bstring_to_octetlist(String); + bstring_to_binary(String); {hstring,String} -> - hstring_to_octetlist(String); + hstring_to_binary(String); Rec when is_record(Rec,'Externalvaluereference') -> get_normalized_value(S,Value,CType, fun normalize_octetstring/3,[]); @@ -2616,35 +2628,6 @@ normalize_octetstring(S,Value,CType) -> Value end. - -bstring_to_octetlist([]) -> - []; -bstring_to_octetlist([H|T]) when H == $0 ; H == $1 -> - bstring_to_octetlist(T,6,[(H - $0) bsl 7]). -bstring_to_octetlist([H|T],0,[Hacc|Tacc]) when H == $0; H == $1 -> - bstring_to_octetlist(T, 7, [0,Hacc + (H -$0)| Tacc]); -bstring_to_octetlist([H|T],BSL,[Hacc|Tacc]) when H == $0; H == $1 -> - bstring_to_octetlist(T, BSL-1, [Hacc + ((H - $0) bsl BSL)| Tacc]); -bstring_to_octetlist([],7,[0|Acc]) -> - lists:reverse(Acc); -bstring_to_octetlist([],_,Acc) -> - lists:reverse(Acc). - -hstring_to_octetlist([]) -> - []; -hstring_to_octetlist(L) -> - hstring_to_octetlist(L,4,[]). -hstring_to_octetlist([H|T],0,[Hacc|Tacc]) when H >= $A, H =< $F -> - hstring_to_octetlist(T,4,[Hacc + (H - $A + 10)|Tacc]); -hstring_to_octetlist([H|T],BSL,Acc) when H >= $A, H =< $F -> - hstring_to_octetlist(T,0,[(H - $A + 10) bsl BSL|Acc]); -hstring_to_octetlist([H|T],0,[Hacc|Tacc]) when H >= $0; H =< $9 -> - hstring_to_octetlist(T,4,[Hacc + (H - $0)|Tacc]); -hstring_to_octetlist([H|T],BSL,Acc) when H >= $0; H =< $9 -> - hstring_to_octetlist(T,0,[(H - $0) bsl BSL|Acc]); -hstring_to_octetlist([],_,Acc) -> - lists:reverse(Acc). - normalize_objectidentifier(S, Value) -> {ok,Val} = validate_objectidentifier(S, o_id, Value, []), Val. diff --git a/lib/asn1/src/asn1ct_constructed_per.erl b/lib/asn1/src/asn1ct_constructed_per.erl index c224f4c9fa..ed3f6f886e 100644 --- a/lib/asn1/src/asn1ct_constructed_per.erl +++ b/lib/asn1/src/asn1ct_constructed_per.erl @@ -450,8 +450,13 @@ dec_objset_default(N, C, LeadingAttr, false) -> "{value,Bytes}," "{unique_name_and_value,",{asis,LeadingAttr},",Id}}}).",nl,nl]); dec_objset_default(N, _, _, true) -> - emit([{asis,N},"(Bytes, Id) ->",nl, - "Bytes.",nl,nl]). + emit([{asis,N},"(Bytes, Id) ->",nl| + case asn1ct:use_legacy_types() of + false -> + ["{asn1_OPENTYPE,Bytes}.",nl,nl]; + true -> + ["Bytes.",nl,nl] + end]). dec_objset_1(Erule, N, {Id,Obj}, RestFields, Typename) -> emit([{asis,N},"(Bytes, ",{asis,Id},") ->",nl]), @@ -906,26 +911,36 @@ def_values(#type{def=#'Externaltypereference'{module=Mod,type=Type}}, Def) -> #typedef{typespec=T} = asn1_db:dbget(Mod, Type), def_values(T, Def); def_values(#type{def={'BIT STRING',[]}}, Bs) when is_bitstring(Bs) -> - ListBs = [B || <<B:1>> <= Bs], - IntBs = lists:foldl(fun(B, A) -> - (A bsl 1) bor B - end, 0, lists:reverse(ListBs)), - Sz = bit_size(Bs), - Compact = case 8 - Sz rem 8 of - 8 -> - {0,Bs}; - Unused -> - {Unused,<<Bs:Sz/bits,0:Unused>>} - end, - [asn1_DEFAULT,Bs,Compact,ListBs,IntBs]; + case asn1ct:use_legacy_types() of + false -> + [asn1_DEFAULT,Bs]; + true -> + ListBs = [B || <<B:1>> <= Bs], + IntBs = lists:foldl(fun(B, A) -> + (A bsl 1) bor B + end, 0, lists:reverse(ListBs)), + Sz = bit_size(Bs), + Compact = case 8 - Sz rem 8 of + 8 -> + {0,Bs}; + Unused -> + {Unused,<<Bs:Sz/bits,0:Unused>>} + end, + [asn1_DEFAULT,Bs,Compact,ListBs,IntBs] + end; def_values(#type{def={'BIT STRING',[_|_]=Ns}}, List) when is_list(List) -> Bs = asn1ct_gen:named_bitstring_value(List, Ns), - ListBs = [B || <<B:1>> <= Bs], - IntBs = lists:foldl(fun(B, A) -> - (A bsl 1) bor B - end, 0, lists:reverse(ListBs)), - Args = [List,Bs,ListBs,IntBs], - {call,per_common,is_default_bitstring,Args}; + As = case asn1ct:use_legacy_types() of + false -> + [List,Bs]; + true -> + ListBs = [B || <<B:1>> <= Bs], + IntBs = lists:foldl(fun(B, A) -> + (A bsl 1) bor B + end, 0, lists:reverse(ListBs)), + [List,Bs,ListBs,IntBs] + end, + {call,per_common,is_default_bitstring,As}; def_values(#type{def={'INTEGER',Ns}}, Def) -> [asn1_DEFAULT,Def|case lists:keyfind(Def, 2, Ns) of false -> []; @@ -1059,8 +1074,17 @@ enc_objset_imm(Erule, Component, ObjSet, RestFieldNames, Extensible) -> enc_obj(Erule, Obj, RestFieldNames, Aligned)] || {Key,Obj} <- ObjSet] ++ [['_',case Extensible of - false -> E; - true -> {put_bits,{var,"Val"},binary,[1]} + false -> + E; + true -> + case asn1ct:use_legacy_types() of + false -> + {call,per_common,open_type_to_binary, + [{var,"Val"}]}; + true -> + {call,per_common,legacy_open_type_to_binary, + [{var,"Val"}]} + end end]]}]. enc_obj(Erule, Obj, RestFieldNames0, Aligned) -> diff --git a/lib/asn1/src/asn1ct_gen.erl b/lib/asn1/src/asn1ct_gen.erl index 37b33194d0..71d870b4ce 100644 --- a/lib/asn1/src/asn1ct_gen.erl +++ b/lib/asn1/src/asn1ct_gen.erl @@ -790,7 +790,8 @@ gen_decode_constructed(Erules,Typename,InnerType,D) when is_record(D,typedef) -> pgen_exports(Erules,_Module,{Types,Values,_,_,Objects,ObjectSets}) -> - emit(["-export([encoding_rule/0,bit_string_format/0]).",nl]), + emit(["-export([encoding_rule/0,bit_string_format/0," + " legacy_erlang_types/0]).",nl]), case Types of [] -> ok; _ -> @@ -1022,7 +1023,9 @@ gen_info_functions(Erules) -> emit(["encoding_rule() -> ", {asis,Erules},".",nl,nl, "bit_string_format() -> ", - {asis,asn1ct:get_bit_string_format()},".",nl,nl]). + {asis,asn1ct:get_bit_string_format()},".",nl,nl, + "legacy_erlang_types() -> ", + {asis,asn1ct:use_legacy_types()},".",nl,nl]). gen_decode_partial_incomplete(ber) -> case {asn1ct:read_config_data(partial_incomplete_decode), diff --git a/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl b/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl index de81259fcb..bea0ec8968 100644 --- a/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl +++ b/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl @@ -206,10 +206,32 @@ gen_encode_prim(_Erules, #type{}=D, DoTag, Value) -> {call,ber,encode_tags, [DoTag,{curr,realval},{curr,realsize}]},nl, "end"]); + {'BIT STRING',[]} -> + case asn1ct:use_legacy_types() of + false when BitStringConstraint =:= [] -> + call(encode_unnamed_bit_string, [Value,DoTag]); + false -> + call(encode_unnamed_bit_string, + [{asis,BitStringConstraint},Value,DoTag]); + true -> + call(encode_bit_string, + [{asis,BitStringConstraint},Value, + {asis,[]},DoTag]) + end; {'BIT STRING',NamedNumberList} -> - call(encode_bit_string, - [{asis,BitStringConstraint},Value, - {asis,NamedNumberList},DoTag]); + case asn1ct:use_legacy_types() of + false when BitStringConstraint =:= [] -> + call(encode_named_bit_string, + [Value,{asis,NamedNumberList},DoTag]); + false -> + call(encode_named_bit_string, + [{asis,BitStringConstraint},Value, + {asis,NamedNumberList},DoTag]); + true -> + call(encode_bit_string, + [{asis,BitStringConstraint},Value, + {asis,NamedNumberList},DoTag]) + end; 'NULL' -> call(encode_null, [Value,DoTag]); 'OBJECT IDENTIFIER' -> @@ -471,7 +493,6 @@ gen_dec_prim(_Erules, Att, BytesVar, DoTag, _TagIn, _Form, _OptOrMand) -> _ -> "" end, NewTypeName = case Typename of - 'OCTET STRING' -> restricted_string; 'NumericString' -> restricted_string; 'TeletexString' -> restricted_string; 'T61String' -> restricted_string; @@ -529,6 +550,19 @@ gen_dec_prim(_Erules, Att, BytesVar, DoTag, _TagIn, _Form, _OptOrMand) -> 'RELATIVE-OID' -> emit(["decode_relative_oid(",BytesVar,","]), need(decode_relative_oid, 2); + 'OCTET STRING' -> + F = case asn1ct:use_legacy_types() of + false -> decode_octet_string; + true -> decode_restricted_string + end, + emit([{asis,F},"(",BytesVar,","]), + case Constraint of + [] -> + need(F, 2); + _ -> + emit([{asis,Constraint},","]), + need(F, 3) + end; restricted_string -> emit(["decode_restricted_string",AsBin,"(",BytesVar,","]), case Constraint of @@ -1090,13 +1124,11 @@ gen_objset_enc(Erules, ObjSetName, UniqueName, %% See X.681 Annex E for the following case gen_objset_enc(_,ObjSetName,_UniqueName,['EXTENSIONMARK'],_ClName, _ClFields,_NthObj,Acc) -> - emit(["'getenc_",ObjSetName,"'(_) ->",nl]), - emit({indent(3),"fun(_, Val, _RestPrimFieldName) ->",nl}), - emit({indent(6),"Len = case Val of",nl,indent(9), - "Bin when is_binary(Bin) -> byte_size(Bin);",nl,indent(9), - "_ -> length(Val)",nl,indent(6),"end,"}), - emit({indent(6),"{Val,Len}",nl}), - emit({indent(3),"end.",nl,nl}), + emit(["'getenc_",ObjSetName,"'(_) ->",nl, + indent(2),"fun(_, Val, _RestPrimFieldName) ->",nl]), + emit_enc_open_type(4), + emit([nl, + indent(2),"end.",nl,nl]), Acc; gen_objset_enc(_, ObjSetName, UniqueName, [], _, _, _, Acc) -> emit_default_getenc(ObjSetName, UniqueName), @@ -1158,13 +1190,8 @@ gen_inlined_enc_funs1(Fields, [{typefield,Name,_}|Rest], ObjSetName, %% were no type in the table and we therefore generate %% code that returns the input for application %% treatment. - emit([indent(9),{asis,Name}," ->",nl, - indent(12),"Len = case Val of",nl, - indent(15),"Bin when is_binary(Bin) -> " - "byte_size(Bin);",nl, - indent(15),"_ -> length(Val)",nl, - indent(12),"end,",nl, - indent(12),"{Val,Len}"]), + emit([indent(9),{asis,Name}," ->",nl]), + emit_enc_open_type(11), {Acc0,0} end, gen_inlined_enc_funs1(Fields, Rest, ObjSetName, Sep, NthObj+NAdd, Acc); @@ -1175,6 +1202,25 @@ gen_inlined_enc_funs1(_, [], _, _, NthObj, Acc) -> indent(3),"end"]), {Acc,NthObj}. +emit_enc_open_type(I) -> + Indent = indent(I), + S = [Indent, "case Val of",nl, + Indent,indent(2),"{asn1_OPENTYPE,Bin} when is_binary(Bin) ->",nl, + Indent,indent(4),"{Bin,byte_size(Bin)}"| + case asn1ct:use_legacy_types() of + false -> + [nl, + Indent,"end"]; + true -> + [";",nl, + Indent,indent(2),"Bin when is_binary(Bin) ->",nl, + Indent,indent(4),"{Bin,byte_size(Bin)};",nl, + Indent,indent(2),"_ ->",nl, + Indent,indent(4),"{Val,length(Val)}",nl, + Indent, "end"] + end], + emit(S). + emit_inner_of_fun(TDef=#typedef{name={ExtMod,Name},typespec=Type}, InternalDefFunName) -> OTag = Type#type.tag, @@ -1258,14 +1304,9 @@ gen_objset_dec(_,ObjSetName,_UniqueName,['EXTENSIONMARK'],_ClName, _ClFields,_NthObj) -> emit(["'getdec_",ObjSetName,"'(_) ->",nl]), emit([indent(2),"fun(_,Bytes, _RestPrimFieldName) ->",nl]), - - emit([indent(4),"case Bytes of",nl, - indent(6),"Bin when is_binary(Bin) -> ",nl, - indent(8),"Bin;",nl, - indent(6),"_ ->",nl, - indent(8),{call,ber,ber_encode,["Bytes"]},nl, - indent(4),"end",nl]), - emit([indent(2),"end.",nl,nl]), + emit_dec_open_type(4), + emit([nl, + indent(2),"end.",nl,nl]), ok; gen_objset_dec(_, ObjSetName, UniqueName, [], _, _, _) -> emit_default_getdec(ObjSetName, UniqueName), @@ -1312,12 +1353,8 @@ gen_inlined_dec_funs1(Fields, [{typefield,Name,Prop}|Rest], end, 0; false -> - emit([indent(9),{asis,Name}," ->",nl, - indent(12),"Len = case Bytes of",nl, - indent(15),"B when is_binary(B) -> byte_size(B);",nl, - indent(15),"_ -> length(Bytes)",nl, - indent(12),"end,",nl, - indent(12),"{Bytes,[],Len}"]), + emit([indent(9),{asis,Name}," ->",nl]), + emit_dec_open_type(11), 0 end, gen_inlined_dec_funs1(Fields, Rest, ObjSetName, Sep, NthObj+N); @@ -1328,6 +1365,27 @@ gen_inlined_dec_funs1(_, [], _, _, NthObj) -> indent(3),"end"]), NthObj. +emit_dec_open_type(I) -> + Indent = indent(I), + S = case asn1ct:use_legacy_types() of + false -> + [Indent, "case Bytes of",nl, + Indent,indent(2),"Bin when is_binary(Bin) -> ",nl, + Indent,indent(4),"{asn1_OPENTYPE,Bin};",nl, + Indent,indent(2),"_ ->",nl, + Indent,indent(4),"{asn1_OPENTYPE,", + {call,ber,ber_encode,["Bytes"]},"}",nl, + Indent, "end"]; + true -> + [Indent, "case Bytes of",nl, + Indent,indent(2),"Bin when is_binary(Bin) -> ",nl, + Indent,indent(4),"Bin;",nl, + Indent,indent(2),"_ ->",nl, + Indent,indent(4),{call,ber,ber_encode,["Bytes"]},nl, + Indent, "end"] + end, + emit(S). + emit_inner_of_decfun(#typedef{name={ExtName,Name},typespec=Type},Prop, InternalDefFunName) -> OTag = Type#type.tag, diff --git a/lib/asn1/src/asn1ct_gen_per.erl b/lib/asn1/src/asn1ct_gen_per.erl index 7ba649c874..519ce9f054 100644 --- a/lib/asn1/src/asn1ct_gen_per.erl +++ b/lib/asn1/src/asn1ct_gen_per.erl @@ -132,7 +132,14 @@ gen_encode_prim_imm(Val, #type{def=Type0,constraint=Constraint}, Aligned) -> ToBinary = {real_common,encode_real}, asn1ct_imm:per_enc_restricted_string(Val, ToBinary, Aligned); {'BIT STRING',NNL} -> - asn1ct_imm:per_enc_bit_string(Val, NNL, Constraint, Aligned); + case asn1ct:use_legacy_types() of + false -> + asn1ct_imm:per_enc_bit_string(Val, NNL, + Constraint, Aligned); + true -> + asn1ct_imm:per_enc_legacy_bit_string(Val, NNL, + Constraint, Aligned) + end; 'NULL' -> asn1ct_imm:per_enc_null(Val, Aligned); 'OBJECT IDENTIFIER' -> @@ -144,7 +151,13 @@ gen_encode_prim_imm(Val, #type{def=Type0,constraint=Constraint}, Aligned) -> 'BOOLEAN' -> asn1ct_imm:per_enc_boolean(Val, Aligned); 'OCTET STRING' -> - asn1ct_imm:per_enc_octet_string(Val, Constraint, Aligned); + case asn1ct:use_legacy_types() of + false -> + asn1ct_imm:per_enc_octet_string(Val, Constraint, Aligned); + true -> + asn1ct_imm:per_enc_legacy_octet_string(Val, Constraint, + Aligned) + end; 'ASN1_OPEN_TYPE' -> case Constraint of [#'Externaltypereference'{type=Tname}] -> @@ -325,7 +338,10 @@ gen_dec_imm_1('GeneralizedTime', Constraint, Aligned) -> gen_dec_imm_1('OCTET STRING', Constraint, Aligned) -> SzConstr = asn1ct_imm:effective_constraint(bitstring, Constraint), Imm = asn1ct_imm:per_dec_octet_string(SzConstr, Aligned), - {convert,binary_to_list,Imm}; + case asn1ct:use_legacy_types() of + false -> {convert,{binary,copy},Imm}; + true -> {convert,binary_to_list,Imm} + end; gen_dec_imm_1('TeletexString', _Constraint, Aligned) -> gen_dec_restricted_string(Aligned); gen_dec_imm_1('T61String', _Constraint, Aligned) -> diff --git a/lib/asn1/src/asn1ct_imm.erl b/lib/asn1/src/asn1ct_imm.erl index c14f0b889f..fde39c674e 100644 --- a/lib/asn1/src/asn1ct_imm.erl +++ b/lib/asn1/src/asn1ct_imm.erl @@ -26,11 +26,13 @@ per_dec_octet_string/2,per_dec_open_type/1,per_dec_real/1, per_dec_restricted_string/1]). -export([per_dec_constrained/3,per_dec_normally_small_number/1]). --export([per_enc_bit_string/4,per_enc_boolean/2, +-export([per_enc_bit_string/4,per_enc_legacy_bit_string/4, + per_enc_boolean/2, per_enc_choice/3,per_enc_enumerated/3, per_enc_integer/3,per_enc_integer/4, per_enc_null/2, per_enc_k_m_string/4,per_enc_octet_string/3, + per_enc_legacy_octet_string/3, per_enc_open_type/2, per_enc_restricted_string/3, per_enc_small_number/2]). @@ -157,7 +159,35 @@ per_dec_restricted_string(Aligned) -> %%% Encoding. %%% -per_enc_bit_string(Val0, [], Constraint0, Aligned) -> +per_enc_bit_string(Val, [], Constraint0, Aligned) -> + {B,[[],Bits]} = mk_vars([], [bits]), + Constraint = effective_constraint(bitstring, Constraint0), + B ++ [{call,erlang,bit_size,[Val],Bits}| + per_enc_length(Val, 1, Bits, Constraint, Aligned, 'BIT STRING')]; +per_enc_bit_string(Val0, NNL0, Constraint0, Aligned) -> + {B,[Val,Bs,Bits,Positions]} = mk_vars(Val0, [bs,bits,positions]), + NNL = lists:keysort(2, NNL0), + Constraint = effective_constraint(bitstring, Constraint0), + ExtraArgs = case constr_min_size(Constraint) of + no -> []; + Lb -> [Lb] + end, + ToBs = case ExtraArgs of + [] -> + {call,per_common,bs_drop_trailing_zeroes,[Val]}; + [Lower] -> + {call,per_common,adjust_trailing_zeroes,[Val,Lower]} + end, + B ++ [{'try', + [bit_string_name2pos_fun(NNL, Val)], + {Positions, + [{call,per_common,bitstring_from_positions, + [Positions|ExtraArgs]}]}, + [ToBs],Bs}, + {call,erlang,bit_size,[Bs],Bits}| + per_enc_length(Bs, 1, Bits, Constraint, Aligned, 'BIT STRING')]. + +per_enc_legacy_bit_string(Val0, [], Constraint0, Aligned) -> {B,[Val,Bs,Bits]} = mk_vars(Val0, [bs,bits]), Constraint = effective_constraint(bitstring, Constraint0), ExtraArgs = case constr_min_size(Constraint) of @@ -167,7 +197,7 @@ per_enc_bit_string(Val0, [], Constraint0, Aligned) -> B ++ [{call,per_common,to_bitstring,[Val|ExtraArgs],Bs}, {call,erlang,bit_size,[Bs],Bits}| per_enc_length(Bs, 1, Bits, Constraint, Aligned, 'BIT STRING')]; -per_enc_bit_string(Val0, NNL0, Constraint0, Aligned) -> +per_enc_legacy_bit_string(Val0, NNL0, Constraint0, Aligned) -> {B,[Val,Bs,Bits,Positions]} = mk_vars(Val0, [bs,bits,positions]), NNL = lists:keysort(2, NNL0), Constraint = effective_constraint(bitstring, Constraint0), @@ -276,7 +306,13 @@ per_enc_open_type(Imm0, Aligned) -> {call,erlang,byte_size,[Bin],Len}| per_enc_length(Bin, 8, Len, Aligned)]. -per_enc_octet_string(Val0, Constraint0, Aligned) -> +per_enc_octet_string(Bin, Constraint0, Aligned) -> + {B,[[],Len]} = mk_vars([], [len]), + Constraint = effective_constraint(bitstring, Constraint0), + B ++ [{call,erlang,byte_size,[Bin],Len}| + per_enc_length(Bin, 8, Len, Constraint, Aligned, 'OCTET STRING')]. + +per_enc_legacy_octet_string(Val0, Constraint0, Aligned) -> {B,[Val,Bin,Len]} = mk_vars(Val0, [bin,len]), Constraint = effective_constraint(bitstring, Constraint0), B ++ [{call,erlang,iolist_to_binary,[Val],Bin}, @@ -874,6 +910,9 @@ dcg_list_outside([{call,Fun,{V,Buf},{Dst,DstBuf}}|T]) -> emit(["{",Dst,",",DstBuf,"} = "]), Fun(V, Buf), iter_dcg_list_outside(T); +dcg_list_outside([{convert,{M,F},V,Dst}|T]) -> + emit([Dst," = ",{asis,M},":",{asis,F},"(",V,")"]), + iter_dcg_list_outside(T); dcg_list_outside([{convert,Op,V,Dst}|T]) -> emit([Dst," = ",Op,"(",V,")"]), iter_dcg_list_outside(T); diff --git a/lib/asn1/src/asn1ct_value.erl b/lib/asn1/src/asn1ct_value.erl index 862b3c4ea5..a86c963b9d 100644 --- a/lib/asn1/src/asn1ct_value.erl +++ b/lib/asn1/src/asn1ct_value.erl @@ -260,7 +260,11 @@ from_type_prim(M, D) -> 'BOOLEAN' -> true; 'OCTET STRING' -> - adjust_list(size_random(C),c_string(C,"OCTET STRING")); + S0 = adjust_list(size_random(C), c_string(C, "OCTET STRING")), + case M:legacy_erlang_types() of + false -> list_to_binary(S0); + true -> S0 + end; 'NumericString' -> adjust_list(size_random(C),c_string(C,"0123456789")); 'TeletexString' -> diff --git a/lib/asn1/src/asn1rtt_ber.erl b/lib/asn1/src/asn1rtt_ber.erl index 583ff790b7..4bd814769f 100644 --- a/lib/asn1/src/asn1rtt_ber.erl +++ b/lib/asn1/src/asn1rtt_ber.erl @@ -29,6 +29,8 @@ decode_integer/2,decode_integer/3, decode_named_integer/3,decode_named_integer/4, encode_enumerated/2,decode_enumerated/3, + encode_unnamed_bit_string/2,encode_unnamed_bit_string/3, + encode_named_bit_string/3,encode_named_bit_string/4, encode_bit_string/4, decode_named_bit_string/3, decode_compact_bit_string/3, @@ -38,6 +40,7 @@ encode_relative_oid/2,decode_relative_oid/2, encode_object_identifier/2,decode_object_identifier/2, encode_restricted_string/2, + decode_octet_string/2,decode_octet_string/3, decode_restricted_string/2,decode_restricted_string/3, encode_universal_string/2,decode_universal_string/3, encode_UTF8_string/2,decode_UTF8_string/2, @@ -780,6 +783,55 @@ decode_enumerated1(Val, NamedNumberList) -> {asn1_enum,Val} end. +%%============================================================================ +%% Bitstring value, ITU_T X.690 Chapter 8.6 +%% +%% encode bitstring value +%%============================================================================ + +encode_unnamed_bit_string(Bits, TagIn) -> + Unused = (8 - (bit_size(Bits) band 7)) band 7, + Bin = <<Unused,Bits/bitstring,0:Unused>>, + encode_tags(TagIn, Bin, byte_size(Bin)). + +encode_unnamed_bit_string(C, Bits, TagIn) -> + NumBits = bit_size(Bits), + Unused = (8 - (NumBits band 7)) band 7, + Bin = <<Unused,Bits/bitstring,0:Unused>>, + case C of + {_Min,Max} -> + if + NumBits > Max -> + exit({error,{asn1, + {bitstring_length, + {{was,NumBits},{maximum,Max}}}}}); + true -> + ok + end; + Size -> + if NumBits =< Size -> + ok; + true -> + exit({error,{asn1, + {bitstring_length, + {{was,NumBits},{should_be,Size}}}}}) + end + end, + encode_tags(TagIn, Bin, byte_size(Bin)). + +encode_named_bit_string([H|_]=Bits, NamedBitList, TagIn) when is_atom(H) -> + encode_bit_string_named([], Bits, NamedBitList, TagIn); +encode_named_bit_string([{bit,_}|_]=Bits, NamedBitList, TagIn) -> + encode_bit_string_named([], Bits, NamedBitList, TagIn); +encode_named_bit_string(Bits, _NamedBitList, TagIn) when is_bitstring(Bits) -> + encode_unnamed_bit_string(Bits, TagIn). + +encode_named_bit_string(C, [H|_]=Bits, NamedBitList, TagIn) when is_atom(H) -> + encode_bit_string_named(C, Bits, NamedBitList, TagIn); +encode_named_bit_string(C, [{bit,_}|_]=Bits, NamedBitList, TagIn) -> + encode_bit_string_named(C, Bits, NamedBitList, TagIn); +encode_named_bit_string(C, Bits, _NamedBitList, TagIn) when is_bitstring(Bits) -> + encode_unnamed_bit_string(C, Bits, TagIn). %%============================================================================ %% Bitstring value, ITU_T X.690 Chapter 8.6 @@ -1251,6 +1303,19 @@ encode_restricted_string(OctetList, TagIn) when is_list(OctetList) -> encode_tags(TagIn, OctetList, length(OctetList)). %%============================================================================ +%% decode OCTET STRING to binary +%%============================================================================ + +decode_octet_string(Tlv, TagsIn) -> + Bin = match_and_collect(Tlv, TagsIn), + binary:copy(Bin). + +decode_octet_string(Tlv, Range, TagsIn) -> + Bin0 = match_and_collect(Tlv, TagsIn), + Bin = binary:copy(Bin0), + check_restricted_string(Bin, byte_size(Bin), Range). + +%%============================================================================ %% decode Numeric Printable Teletex Videotex Visible IA5 Graphic General strings %%============================================================================ diff --git a/lib/asn1/src/asn1rtt_ext.erl b/lib/asn1/src/asn1rtt_ext.erl index 46adb2007d..f3eee1cdd5 100644 --- a/lib/asn1/src/asn1rtt_ext.erl +++ b/lib/asn1/src/asn1rtt_ext.erl @@ -38,7 +38,7 @@ transform_to_EXTERNAL1990([{'context-negotiation',Context_negot}|Rest], Acc) -> transform_to_EXTERNAL1990([asn1_NOVALUE|Rest], Acc) -> transform_to_EXTERNAL1990(Rest, [asn1_NOVALUE|Acc]); transform_to_EXTERNAL1990([Data_val_desc,Data_value], Acc) - when is_list(Data_value)-> + when is_list(Data_value); is_binary(Data_value) -> list_to_tuple(lists:reverse([{'octet-aligned',Data_value}, Data_val_desc|Acc])); transform_to_EXTERNAL1990([Data_val_desc,Data_value], Acc) diff --git a/lib/asn1/src/asn1rtt_per_common.erl b/lib/asn1/src/asn1rtt_per_common.erl index 3309e6a4ca..71fec411a0 100644 --- a/lib/asn1/src/asn1rtt_per_common.erl +++ b/lib/asn1/src/asn1rtt_per_common.erl @@ -37,8 +37,10 @@ bitstring_from_positions/1,bitstring_from_positions/2, to_bitstring/1,to_bitstring/2, to_named_bitstring/1,to_named_bitstring/2, - is_default_bitstring/5, - extension_bitmap/3]). + bs_drop_trailing_zeroes/1,adjust_trailing_zeroes/2, + is_default_bitstring/3,is_default_bitstring/5, + extension_bitmap/3, + open_type_to_binary/1,legacy_open_type_to_binary/1]). -define('16K',16384). @@ -272,6 +274,25 @@ to_named_bitstring(Val, Lb) -> %% for correctness, not speed. adjust_trailing_zeroes(to_bitstring(Val), Lb). +is_default_bitstring(asn1_DEFAULT, _, _) -> + true; +is_default_bitstring(Named, Named, _) -> + true; +is_default_bitstring(Bs, _, Bs) -> + true; +is_default_bitstring(Val, _, Def) when is_bitstring(Val) -> + Sz = bit_size(Def), + case Val of + <<Def:Sz/bitstring,T/bitstring>> -> + NumZeroes = bit_size(T), + case T of + <<0:NumZeroes>> -> true; + _ -> false + end; + _ -> + false + end. + is_default_bitstring(asn1_DEFAULT, _, _, _, _) -> true; is_default_bitstring({Unused,Bin}, V0, V1, V2, V3) when is_integer(Unused) -> @@ -306,6 +327,16 @@ is_default_bitstring(_, _, _, _, _) -> false. extension_bitmap(Val, Pos, Limit) -> extension_bitmap(Val, Pos, Limit, 0). +open_type_to_binary({asn1_OPENTYPE,Bin}) when is_binary(Bin) -> + Bin. + +legacy_open_type_to_binary({asn1_OPENTYPE,Bin}) when is_binary(Bin) -> + Bin; +legacy_open_type_to_binary(Bin) when is_binary(Bin) -> + Bin; +legacy_open_type_to_binary(List) when is_list(List) -> + List. + %%% %%% Internal functions. %%% @@ -438,6 +469,8 @@ adjust_trailing_zeroes(Bs0, Lb) -> bs_drop_trailing_zeroes(Bs) -> bs_drop_trailing_zeroes(Bs, bit_size(Bs)). +bs_drop_trailing_zeroes(Bs, 0) -> + Bs; bs_drop_trailing_zeroes(Bs0, Sz0) when Sz0 < 8 -> <<Byte:Sz0>> = Bs0, Sz = Sz0 - ntz(Byte), diff --git a/lib/asn1/test/asn1_SUITE.erl b/lib/asn1/test/asn1_SUITE.erl index 83bd66a631..3b34feb5a3 100644 --- a/lib/asn1/test/asn1_SUITE.erl +++ b/lib/asn1/test/asn1_SUITE.erl @@ -328,6 +328,10 @@ testCompactBitString(Config, Rule, Opts) -> testPrimStrings(Config) -> test(Config, fun testPrimStrings/3, [ber,{ber,[der]},per,uper]). testPrimStrings(Config, Rule, Opts) -> + LegacyOpts = [legacy_erlang_types|Opts], + asn1_test_lib:compile_all(["PrimStrings", "BitStr"], Config, + [Rule|LegacyOpts]), + testPrimStrings_cases(Rule, LegacyOpts), asn1_test_lib:compile_all(["PrimStrings", "BitStr"], Config, [Rule|Opts]), testPrimStrings_cases(Rule, Opts), asn1_test_lib:compile_all(["PrimStrings", "BitStr"], Config, @@ -432,7 +436,8 @@ testDef(Config, Rule, Opts) -> testDEFAULT(Config) -> test(Config, fun testDEFAULT/3, [ber,{ber,[der]},per,uper]). testDEFAULT(Config, Rule, Opts) -> - asn1_test_lib:compile_all(["Def","Default"], Config, [Rule|Opts]), + asn1_test_lib:compile_all(["Def","Default"], Config, + [legacy_erlang_types,Rule|Opts]), testDef:main(Rule), testSeqSetDefaultVal:main(Rule, Opts). @@ -766,7 +771,10 @@ testParameterizedInfObj(Config) -> testParameterizedInfObj(Config, Rule, Opts) -> Files = ["Param","Param2"], asn1_test_lib:compile_all(Files, Config, [Rule|Opts]), - testParameterizedInfObj:main(Config, Rule). + testParameterizedInfObj:main(Config, Rule), + asn1_test_lib:compile("Param", Config, + [legacy_erlang_types,Rule|Opts]), + testParameterizedInfObj:param(Rule). testFragmented(Config) -> test(Config, fun testFragmented/3). @@ -784,7 +792,8 @@ testMergeCompile(Config, Rule, Opts) -> testobj(Config) -> test(Config, fun testobj/3). testobj(Config, Rule, Opts) -> - asn1_test_lib:compile("RANAP", Config, [Rule|Opts]), + asn1_test_lib:compile("RANAP", Config, [legacy_erlang_types, + Rule|Opts]), asn1_test_lib:compile_erlang("testobj", Config, []), ok = testobj:run(), ok = testParameterizedInfObj:ranap(Rule). @@ -811,7 +820,8 @@ testImport(Config, Rule, Opts) -> testMegaco(Config) -> test(Config, fun testMegaco/3). testMegaco(Config, Rule, Opts) -> - {ok, Module1, Module2} = testMegaco:compile(Config, Rule, Opts), + {ok, Module1, Module2} = testMegaco:compile(Config, Rule, + [legacy_erlang_types|Opts]), ok = testMegaco:main(Module1, Config), ok = testMegaco:main(Module2, Config). @@ -892,7 +902,8 @@ specialized_decodes(Config, Rule, Opts) -> "PartialDecMyHTTP.asn", "MEDIA-GATEWAY-CONTROL.asn", "P-Record"], - Config, [Rule, asn1config|Opts]), + Config, + [Rule,legacy_erlang_types,asn1config|Opts]), test_partial_incomplete_decode:test(Config), test_selective_decode:test(). @@ -1022,7 +1033,8 @@ test_x691(Config, Rule, Opts) -> test_x691:cases(Rule), %% OTP-7708. - asn1_test_lib:compile("EUTRA-extract-55", Config, [Rule|Opts]), + asn1_test_lib:compile("EUTRA-extract-55", Config, + [legacy_erlang_types,Rule|Opts]), %% OTP-7763. Val = {'Seq',15,lists:duplicate(8, 0),[0],lists:duplicate(28, 0),15,true}, @@ -1128,21 +1140,21 @@ END ok = asn1ct:compile(File, [{outdir, PrivDir}]). -timer_compile(Config, Rule, Opts) -> +timer_compile(Config, Rule) -> asn1_test_lib:compile_all(["H235-SECURITY-MESSAGES", "H323-MESSAGES"], - Config, [Rule|Opts]). + Config, [no_ok_wrapper,Rule]). testTimer_ber(Config) -> - timer_compile(Config,ber,[]), - testTimer:go(Config,ber). + timer_compile(Config, ber), + testTimer:go(). testTimer_per(Config) -> - timer_compile(Config,per,[]), - testTimer:go(Config,per). + timer_compile(Config, per), + testTimer:go(). testTimer_uper(Config) -> - timer_compile(Config,uper,[]), - {comment,_} = testTimer:go(Config,uper). + timer_compile(Config, uper), + testTimer:go(). %% Test of multiple-line comment, OTP-8043 testComment(suite) -> []; @@ -1200,8 +1212,8 @@ ticket_7407_code(FinalPadding) -> eutra1(msg) -> {'BCCH-BCH-Message', - {'MasterInformationBlock',[0,1,0,1],[1,0,1,0], - {'PHICH-Configuration',short,ffs},[1,0,1,0,0,0,0,0]}}. + {'MasterInformationBlock',<<2#0101:4>>,<<2#1010:4>>, + {'PHICH-Configuration',short,ffs},<<2#10100000>>}}. eutra1(result, true) -> <<90,80,0>>; diff --git a/lib/asn1/test/asn1_SUITE_data/TCAPPackage_msg.erl b/lib/asn1/test/asn1_SUITE_data/TCAPPackage_msg.erl index 06eba8b6eb..0bf4425263 100644 --- a/lib/asn1/test/asn1_SUITE_data/TCAPPackage_msg.erl +++ b/lib/asn1/test/asn1_SUITE_data/TCAPPackage_msg.erl @@ -47,7 +47,7 @@ val('TransactionPDU') -> dialoguePortion=val('DialoguePortion'), componentPortion=val('ComponentSequence')}; val('TransactionID') -> - "OCTET STRING"; + <<"OCTET STRING">>; val('DialoguePortion') -> #'DialoguePortion'{version=val('ProtocolVersion'), applicationContext={integerApplicationId,12}, @@ -57,23 +57,23 @@ val('DialoguePortion') -> val('Confidentiality') -> #'Confidentiality'{confidentialityId={integerConfidentialityId,14}}; val('ProtocolVersion') -> - "K"; + <<"K">>; val('UserInformation') -> [val('EXTERNAL'),val('EXTERNAL')]; val('EXTERNAL') -> #'EXTERNAL'{'direct-reference'={0,1,2}, - encoding={'single-ASN1-type',[1,2,3,4]}}; + encoding={'single-ASN1-type',<<1,2,3,4>>}}; val('ComponentSequence') -> [val('ComponentPDU',1),val('ComponentPDU',2),val('ComponentPDU',3)]; val('Invoke') -> - #'Invoke'{componentIDs="AB", + #'Invoke'{componentIDs = <<"AB">>, opcode={local,-2}, parameter=running}; val('ReturnResult') -> - #'ReturnResult'{componentID="C", + #'ReturnResult'{componentID = <<"C">>, parameter=[1,2,3,4]}; val('ReturnError') -> - #'ReturnError'{componentID="D", + #'ReturnError'{componentID = <<"D">>, errorCode={local,21}, parameter=true}; val('Abort') -> @@ -87,8 +87,8 @@ val(Type) -> check_result('PackageType',unidirectional,Res) -> {unidirectional, {'UniTransactionPDU', - "OCTET STRING", - {'DialoguePortion',"K", + <<"OCTET STRING">>, + {'DialoguePortion',<<"K">>, {integerApplicationId,12}, [_,%{'EXTERNAL',{syntax,{0,1,2}},asn1_NOVALUE,OTVal}, _],%{'EXTERNAL',{syntax,{0,1,2}},asn1_NOVALUE,OTVal}], @@ -96,14 +96,14 @@ check_result('PackageType',unidirectional,Res) -> {'Confidentiality', {integerConfidentialityId,14}}}, [{invokeLast, - {_,"AB",{local,-2},running}}, - {returnResultLast,{_,"C",_}}, - {returnError,{_,"D",{local,21},true}}]}} = Res, + {_,<<"AB">>,{local,-2},running}}, + {returnResultLast,{_,<<"C">>,_}}, + {returnError,{_,<<"D">>,{local,21},true}}]}} = Res, ok; %% check_OT_val(OTVal); check_result('PackageType',abort,Res)-> - {abort,{'Abort',"OCTET STRING", - {'DialoguePortion',"K", + {abort,{'Abort',<<"OCTET STRING">>, + {'DialoguePortion',<<"K">>, {integerApplicationId,12}, [_,%{'EXTERNAL',{syntax,{0,1,2}},asn1_NOVALUE,OTVal}, _],%{'EXTERNAL',{syntax,{0,1,2}},asn1_NOVALUE,OTVal}], @@ -114,9 +114,9 @@ check_result('PackageType',abort,Res)-> ok; %% check_OT_val(OTVal); check_result('PackageType',response,Res) -> - {response,{'TransactionPDU',"OCTET STRING", + {response,{'TransactionPDU',<<"OCTET STRING">>, {'DialoguePortion', - "K", + <<"K">>, {integerApplicationId,12}, [_,%{'EXTERNAL',{syntax,{0,1,2}},asn1_NOVALUE,OTVal}, _],%{'EXTERNAL',{syntax,{0,1,2}},asn1_NOVALUE,OTVal}], @@ -124,11 +124,11 @@ check_result('PackageType',response,Res) -> {'Confidentiality', {integerConfidentialityId,14}}}, [{invokeLast, - {_,"AB",{local,-2},running}}, + {_,<<"AB">>,{local,-2},running}}, {returnResultLast, - {_,"C",_}}, + {_,<<"C">>,_}}, {returnError, - {_,"D",{local,21},true}}]}} = Res, + {_,<<"D">>,{local,21},true}}]}} = Res, ok. %% check_OT_val(OTVal). diff --git a/lib/asn1/test/asn1_SUITE_data/extensionAdditionGroup.erl b/lib/asn1/test/asn1_SUITE_data/extensionAdditionGroup.erl index 8e21e6ca84..a1e563f6be 100644 --- a/lib/asn1/test/asn1_SUITE_data/extensionAdditionGroup.erl +++ b/lib/asn1/test/asn1_SUITE_data/extensionAdditionGroup.erl @@ -67,8 +67,8 @@ run3(Erule) -> asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE, asn1_NOVALUE,asn1_NOVALUE}, asn1_NOVALUE, - [[80,66,0,5,10,0,5,0,24,11,7,84,54,33,0,1,1,0,0,0,1,39,5,66,127,0,0,1], - []], + [<<80,66,0,5,10,0,5,0,24,11,7,84,54,33,0,1,1,0,0,0,1,39,5,66,127,0,0,1>>, + <<>>], {'RRC-RadioResourceConfigDedicated', [{'RRC-SRB-ToAddMod',1, {explicitValue, diff --git a/lib/asn1/test/h323test.erl b/lib/asn1/test/h323test.erl index 3baaa994ea..7577928493 100644 --- a/lib/asn1/test/h323test.erl +++ b/lib/asn1/test/h323test.erl @@ -42,7 +42,7 @@ alerting_val() -> {'TerminalInfo',asn1_NOVALUE}, false,false}, asn1_NOVALUE, - {'CallIdentifier',[0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]}, + {'CallIdentifier',<<0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0>>}, asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE}}, asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE}, asn1_NOVALUE}. @@ -57,18 +57,18 @@ connect_val() -> {'Connect-UUIE', {0,0,8,2250,0,2}, {ipAddress, - {'TransportAddress_ipAddress',[136,225,41,58],1187}}, + {'TransportAddress_ipAddress',<<136,225,41,58>>,1187}}, {'EndpointType',asn1_NOVALUE, {'VendorIdentifier', {'H221NonStandard',181,0,21324}, - [77,105,99,114,111,115,111,102,116,174,32,78,101,116, - 77,101,100,116,105,110,103,174,0], - [51,46,48,0]}, + <<77,105,99,114,111,115,111,102,116,174,32,78,101,116, + 77,101,100,116,105,110,103,174,0>>, + <<51,46,48,0>>}, asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE, {'TerminalInfo',asn1_NOVALUE}, false,false}, - [22,137,237,197,191,35,211,17,140,45,0,192,79,75,28,208], - {'CallIdentifier',[0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]}, + <<22,137,237,197,191,35,211,17,140,45,0,192,79,75,28,208>>, + {'CallIdentifier',<<0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0>>}, asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE}}, asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE}, asn1_NOVALUE}. diff --git a/lib/asn1/test/testChoExtension.erl b/lib/asn1/test/testChoExtension.erl index e54cbe825b..09e19ceebb 100644 --- a/lib/asn1/test/testChoExtension.erl +++ b/lib/asn1/test/testChoExtension.erl @@ -31,13 +31,13 @@ extension(_Rules) -> %% A trick to encode with another compatible CHOICE type to test reception %% extension alternative - roundtrip('ChoExt1x', {str,"abc"}), + roundtrip('ChoExt1x', {str,<<"abc">>}), roundtrip('ChoExt2', {bool,true}), roundtrip('ChoExt2', {int,33}), roundtrip('ChoExt3', {bool,true}), roundtrip('ChoExt3', {int,33}), - roundtrip('ChoExt4', {str,"abc"}), + roundtrip('ChoExt4', {str,<<"abc">>}), roundtrip('ChoEmptyRoot', {bool,false}), roundtrip('ChoEmptyRoot', {bool,true}), diff --git a/lib/asn1/test/testChoExternal.erl b/lib/asn1/test/testChoExternal.erl index 12abdbb2bc..0914d54f33 100644 --- a/lib/asn1/test/testChoExternal.erl +++ b/lib/asn1/test/testChoExternal.erl @@ -31,16 +31,16 @@ external(_Rules) -> roundtrip('ChoXBool', {xboolImp,true}), roundtrip('ChoXBool', {xboolExp,true}), - roundtrip('NT', {os,"kalle"}), - roundtrip('Exp', {os,"kalle"}), - roundtrip('NTNT', {os,"kalle"}), - roundtrip('NTExp', {os,"kalle"}), - roundtrip('ExpNT', {os,"kalle"}), - roundtrip('ExpExp', {os,"kalle"}), - roundtrip('XNTNT', {os,"kalle"}), - roundtrip('XNTExp', {os,"kalle"}), - roundtrip('XExpNT', {os,"kalle"}), - roundtrip('XExpExp', {os,"kalle"}), + roundtrip('NT', {os,<<"kalle">>}), + roundtrip('Exp', {os,<<"kalle">>}), + roundtrip('NTNT', {os,<<"kalle">>}), + roundtrip('NTExp', {os,<<"kalle">>}), + roundtrip('ExpNT', {os,<<"kalle">>}), + roundtrip('ExpExp', {os,<<"kalle">>}), + roundtrip('XNTNT', {os,<<"kalle">>}), + roundtrip('XNTExp', {os,<<"kalle">>}), + roundtrip('XExpNT', {os,<<"kalle">>}), + roundtrip('XExpExp', {os,<<"kalle">>}), ok. diff --git a/lib/asn1/test/testChoOptional.erl b/lib/asn1/test/testChoOptional.erl index f5e77cb721..71a7346e3f 100644 --- a/lib/asn1/test/testChoOptional.erl +++ b/lib/asn1/test/testChoOptional.erl @@ -27,16 +27,20 @@ run() -> roundtrip('Seq1', #'Seq1'{bool=true,int=asn1_NOVALUE,cho=asn1_NOVALUE}), roundtrip('Seq1', #'Seq1'{bool=true,int=233,cho=asn1_NOVALUE}), - roundtrip('Seq1', #'Seq1'{bool=true,int=asn1_NOVALUE,cho={vsCho,"Vs Str"}}), - roundtrip('Seq1', #'Seq1'{bool=true,int=asn1_NOVALUE,cho={ocStrCho,"Oct Str"}}), + roundtrip('Seq1', #'Seq1'{bool=true,int=asn1_NOVALUE, + cho={vsCho,"Vs Str"}}), + roundtrip('Seq1', #'Seq1'{bool=true,int=asn1_NOVALUE, + cho={ocStrCho,<<"Oct Str">>}}), roundtrip('Seq2', #'Seq2'{int=asn1_NOVALUE,cho=asn1_NOVALUE,bool=true}), roundtrip('Seq2', #'Seq2'{int=233,cho=asn1_NOVALUE,bool=true}), roundtrip('Seq2', #'Seq2'{int=asn1_NOVALUE,cho={vsCho,"Vs Str"},bool=true}), - roundtrip('Seq2', #'Seq2'{int=asn1_NOVALUE,cho={ocStrCho,"Oct Str"},bool=true}), + roundtrip('Seq2', #'Seq2'{int=asn1_NOVALUE,cho={ocStrCho,<<"Oct Str">>}, + bool=true}), roundtrip('Seq3', #'Seq3'{cho=asn1_NOVALUE,int=asn1_NOVALUE,bool=true}), roundtrip('Seq3', #'Seq3'{cho=asn1_NOVALUE,int=233,bool=true}), roundtrip('Seq3', #'Seq3'{cho={vsCho,"Vs Str"},int=asn1_NOVALUE,bool=true}), - roundtrip('Seq3', #'Seq3'{cho={ocStrCho,"Oct Str"},int=asn1_NOVALUE,bool=true}), + roundtrip('Seq3', #'Seq3'{cho={ocStrCho,<<"Oct Str">>}, + int=asn1_NOVALUE,bool=true}), ok. roundtrip(Type, Value) -> diff --git a/lib/asn1/test/testChoRecursive.erl b/lib/asn1/test/testChoRecursive.erl index 593b845949..ccd60c2897 100644 --- a/lib/asn1/test/testChoRecursive.erl +++ b/lib/asn1/test/testChoRecursive.erl @@ -31,13 +31,13 @@ recursive(_Rules) -> roundtrip('ChoRec', {something, #'ChoRec_something'{a = 77, - b = "some octets here", + b = <<"some octets here">>, c = {nothing,'NULL'}}}), roundtrip('ChoRec', {nothing,'NULL'}), roundtrip('ChoRec2', {something, #'ChoRec2_something'{a = 77, - b = "some octets here", + b = <<"some octets here">>, c = {nothing,'NULL'}}}), roundtrip('ChoRec2', {nothing,'NULL'}), ok. diff --git a/lib/asn1/test/testChoTypeRefCho.erl b/lib/asn1/test/testChoTypeRefCho.erl index cd2672add0..636c301403 100644 --- a/lib/asn1/test/testChoTypeRefCho.erl +++ b/lib/asn1/test/testChoTypeRefCho.erl @@ -30,7 +30,7 @@ choice(_Rules) -> roundtrip('ChoTRcho', {'choChoE-E',{choInt,88}}), roundtrip('ChoChoInline', {bool1,true}), roundtrip('ChoChoInline', {choCho,{bool,true}}), - roundtrip('ChoChoInline', {choCho,{octStr,"kk"}}), + roundtrip('ChoChoInline', {choCho,{octStr,<<"kk">>}}), roundtrip('ChoChoInline', {choCho,{int,55}}), ok. diff --git a/lib/asn1/test/testChoTypeRefPrim.erl b/lib/asn1/test/testChoTypeRefPrim.erl index 8a2bc7bd8e..747baeddd8 100644 --- a/lib/asn1/test/testChoTypeRefPrim.erl +++ b/lib/asn1/test/testChoTypeRefPrim.erl @@ -25,18 +25,18 @@ prim(_Rules) -> roundtrip('ChoTR', {bool,true}), - roundtrip('ChoTR', {octStr,[11,12,13,14,15,16,17]}), + roundtrip('ChoTR', {octStr,<<11,12,13,14,15,16,17>>}), roundtrip('ChoTR', {int,233}), - roundtrip('ChoTR', {octStr,"Stringing in the rain"}), - roundtrip('ChoTR2', {octStr,"A string"}), - roundtrip('ChoTR2', {octStrI,"A string"}), - roundtrip('ChoTR2', {octStrE,"A string"}), - roundtrip('ChoTR2', {'octStr-I',"A string"}), - roundtrip('ChoTR2', {'octStrI-I',"A string"}), - roundtrip('ChoTR2', {'octStrE-I',"A string"}), - roundtrip('ChoTR2', {'octStr-E',"A string"}), - roundtrip('ChoTR2', {'octStrI-E',"A string"}), - roundtrip('ChoTR2', {'octStrE-E',"A string"}), + roundtrip('ChoTR', {octStr,<<"Stringing in the rain">>}), + roundtrip('ChoTR2', {octStr,<<"A string">>}), + roundtrip('ChoTR2', {octStrI,<<"A string">>}), + roundtrip('ChoTR2', {octStrE,<<"A string">>}), + roundtrip('ChoTR2', {'octStr-I',<<"A string">>}), + roundtrip('ChoTR2', {'octStrI-I',<<"A string">>}), + roundtrip('ChoTR2', {'octStrE-I',<<"A string">>}), + roundtrip('ChoTR2', {'octStr-E',<<"A string">>}), + roundtrip('ChoTR2', {'octStrI-E',<<"A string">>}), + roundtrip('ChoTR2', {'octStrE-E',<<"A string">>}), ok. roundtrip(Type, Value) -> diff --git a/lib/asn1/test/testChoTypeRefSeq.erl b/lib/asn1/test/testChoTypeRefSeq.erl index 86c22619aa..91d0b45e89 100644 --- a/lib/asn1/test/testChoTypeRefSeq.erl +++ b/lib/asn1/test/testChoTypeRefSeq.erl @@ -28,15 +28,24 @@ -record('ChoSeqExp', {seqInt, seqOs}). seq(_Rules) -> - roundtrip('ChoTRseq', {choSeq,#'ChoSeq'{seqInt=88,seqOs="A string"}}), - roundtrip('ChoTRseq', {choSeqI,#'ChoSeq'{seqInt=88,seqOs="A string"}}), - roundtrip('ChoTRseq', {choSeqE,#'ChoSeq'{seqInt=88,seqOs="A string"}}), - roundtrip('ChoTRseq', {'choSeq-I',#'ChoSeqImp'{seqInt=88,seqOs="A string"}}), - roundtrip('ChoTRseq', {'choSeqI-I',#'ChoSeqImp'{seqInt=88,seqOs="A string"}}), - roundtrip('ChoTRseq', {'choSeqE-I',#'ChoSeqImp'{seqInt=88,seqOs="A string"}}), - roundtrip('ChoTRseq', {'choSeq-E',#'ChoSeqExp'{seqInt=88,seqOs="A string"}}), - roundtrip('ChoTRseq', {'choSeqI-E',#'ChoSeqExp'{seqInt=88,seqOs="A string"}}), - roundtrip('ChoTRseq', {'choSeqE-E',#'ChoSeqExp'{seqInt=88,seqOs="A string"}}), + roundtrip('ChoTRseq', {choSeq,#'ChoSeq'{seqInt=88, + seqOs = <<"A string">>}}), + roundtrip('ChoTRseq', {choSeqI,#'ChoSeq'{seqInt=88, + seqOs = <<"A string">>}}), + roundtrip('ChoTRseq', {choSeqE,#'ChoSeq'{seqInt=88, + seqOs = <<"A string">>}}), + roundtrip('ChoTRseq', {'choSeq-I',#'ChoSeqImp'{seqInt=88, + seqOs = <<"A string">>}}), + roundtrip('ChoTRseq', {'choSeqI-I',#'ChoSeqImp'{seqInt=88, + seqOs = <<"A string">>}}), + roundtrip('ChoTRseq', {'choSeqE-I',#'ChoSeqImp'{seqInt=88, + seqOs = <<"A string">>}}), + roundtrip('ChoTRseq', {'choSeq-E',#'ChoSeqExp'{seqInt=88, + seqOs = <<"A string">>}}), + roundtrip('ChoTRseq', {'choSeqI-E',#'ChoSeqExp'{seqInt=88, + seqOs = <<"A string">>}}), + roundtrip('ChoTRseq', {'choSeqE-E',#'ChoSeqExp'{seqInt=88, + seqOs = <<"A string">>}}), ok. roundtrip(Type, Value) -> diff --git a/lib/asn1/test/testChoTypeRefSet.erl b/lib/asn1/test/testChoTypeRefSet.erl index fd3d75cbcb..bd9068b53e 100644 --- a/lib/asn1/test/testChoTypeRefSet.erl +++ b/lib/asn1/test/testChoTypeRefSet.erl @@ -28,15 +28,24 @@ -record('ChoSetExp', {setInt, setOs}). set(_Rules) -> - roundtrip('ChoTRset', {choSet,#'ChoSet'{setInt=88,setOs="A string"}}), - roundtrip('ChoTRset', {choSetI,#'ChoSet'{setInt=88,setOs="A string"}}), - roundtrip('ChoTRset', {choSetE,#'ChoSet'{setInt=88,setOs="A string"}}), - roundtrip('ChoTRset', {'choSet-I',#'ChoSetImp'{setInt=88,setOs="A string"}}), - roundtrip('ChoTRset', {'choSetI-I',#'ChoSetImp'{setInt=88,setOs="A string"}}), - roundtrip('ChoTRset', {'choSetE-I',#'ChoSetImp'{setInt=88,setOs="A string"}}), - roundtrip('ChoTRset', {'choSet-E',#'ChoSetExp'{setInt=88,setOs="A string"}}), - roundtrip('ChoTRset', {'choSetI-E',#'ChoSetExp'{setInt=88,setOs="A string"}}), - roundtrip('ChoTRset', {'choSetE-E',#'ChoSetExp'{setInt=88,setOs="A string"}}), + roundtrip('ChoTRset', {choSet,#'ChoSet'{setInt=88, + setOs = <<"A string">>}}), + roundtrip('ChoTRset', {choSetI,#'ChoSet'{setInt=88, + setOs = <<"A string">>}}), + roundtrip('ChoTRset', {choSetE,#'ChoSet'{setInt=88, + setOs = <<"A string">>}}), + roundtrip('ChoTRset', {'choSet-I',#'ChoSetImp'{setInt=88, + setOs = <<"A string">>}}), + roundtrip('ChoTRset', {'choSetI-I',#'ChoSetImp'{setInt=88, + setOs = <<"A string">>}}), + roundtrip('ChoTRset', {'choSetE-I',#'ChoSetImp'{setInt=88, + setOs = <<"A string">>}}), + roundtrip('ChoTRset', {'choSet-E',#'ChoSetExp'{setInt=88, + setOs = <<"A string">>}}), + roundtrip('ChoTRset', {'choSetI-E',#'ChoSetExp'{setInt=88, + setOs = <<"A string">>}}), + roundtrip('ChoTRset', {'choSetE-E',#'ChoSetExp'{setInt=88, + setOs = <<"A string">>}}), ok. roundtrip(Type, Value) -> diff --git a/lib/asn1/test/testConstraints.erl b/lib/asn1/test/testConstraints.erl index 54ba748519..3ccf883bd6 100644 --- a/lib/asn1/test/testConstraints.erl +++ b/lib/asn1/test/testConstraints.erl @@ -208,14 +208,14 @@ int_constraints(Rules) -> %% More SIZE Constraints %%========================================================== - roundtrip('FixedSize', "0123456789"), - roundtrip('FixedSize2', "0123456789"), - roundtrip('FixedSize2', "0123456789abcdefghij"), + roundtrip('FixedSize', <<"0123456789">>), + roundtrip('FixedSize2', <<"0123456789">>), + roundtrip('FixedSize2', <<"0123456789abcdefghij">>), range_error(Rules, 'FixedSize', "short"), range_error(Rules, 'FixedSize2', "short"), - [roundtrip('VariableSize', lists:seq($A, $A+L-1)) || + [roundtrip('VariableSize', list_to_binary(lists:seq($A, $A+L-1))) || L <- lists:seq(1, 10)], roundtrip_enc('ShorterExt', "a", shorter_ext(Rules, "a")), diff --git a/lib/asn1/test/testFragmented.erl b/lib/asn1/test/testFragmented.erl index 8d5fa07a5b..35b21f90a9 100644 --- a/lib/asn1/test/testFragmented.erl +++ b/lib/asn1/test/testFragmented.erl @@ -22,10 +22,10 @@ -export([main/1]). main(_Erule) -> - roundtrip('PDU', {'PDU',1,false,["abc","def"]}), + roundtrip('PDU', {'PDU',1,false,[<<"abc">>,<<"def">>]}), B256 = lists:seq(0, 255), K1 = lists:duplicate(4, B256), - K8 = binary_to_list(iolist_to_binary(lists:duplicate(8, K1))), + K8 = iolist_to_binary(lists:duplicate(8, K1)), roundtrip('PDU', {'PDU',1,false,[K8,K8]}), roundtrip('PDU', {'PDU',1,false,[K8,K8,K8,K8]}), roundtrip('PDU', {'PDU',1,false,[K8,K8,K8,K8,K8,K8]}), diff --git a/lib/asn1/test/testInfObj.erl b/lib/asn1/test/testInfObj.erl index cd335e1023..311595cfda 100644 --- a/lib/asn1/test/testInfObj.erl +++ b/lib/asn1/test/testInfObj.erl @@ -49,7 +49,7 @@ main(_Erule) -> roundtrip('RANAPextract1', 'InitiatingMessage2', Val3), roundtrip('InfObj', 'MyPdu', {'MyPdu',42,12,false,"string"}), - roundtrip('InfObj', 'MyPdu', {'MyPdu',{'Seq',1023,"hello"}, + roundtrip('InfObj', 'MyPdu', {'MyPdu',{'Seq',1023,<<"hello">>}, 42,true,"longer string"}), roundtrip('InfObj', 'MyPdu', {'MyPdu',"75712346",43,true,"string"}), @@ -110,11 +110,11 @@ main(_Erule) -> enc_dec('InfObj', 'DefaultInSeq', {'DefaultInSeq',3,asn1_DEFAULT}), roundtrip('InfObj', 'Multiple-Optionals', - {'Multiple-Optionals',1,42,true,"abc"}), + {'Multiple-Optionals',1,42,true,<<"abc">>}), roundtrip('InfObj', 'Multiple-Optionals', - {'Multiple-Optionals',1,asn1_NOVALUE,true,"abc"}), + {'Multiple-Optionals',1,asn1_NOVALUE,true,<<"abc">>}), roundtrip('InfObj', 'Multiple-Optionals', - {'Multiple-Optionals',1,42,asn1_NOVALUE,"abc"}), + {'Multiple-Optionals',1,42,asn1_NOVALUE,<<"abc">>}), roundtrip('InfObj', 'Multiple-Optionals', {'Multiple-Optionals',1,42,true,asn1_NOVALUE}), roundtrip('InfObj', 'Multiple-Optionals', diff --git a/lib/asn1/test/testMergeCompile.erl b/lib/asn1/test/testMergeCompile.erl index 7cda71c441..b21897cfc2 100644 --- a/lib/asn1/test/testMergeCompile.erl +++ b/lib/asn1/test/testMergeCompile.erl @@ -30,12 +30,12 @@ main(Erule) -> %% test of module MS.set.asn that tests OTP-4492: different tagdefault in %% modules and types with same name in modules - MSVal = {'Type4M2',8,true,three,"OCTET STRING"}, + MSVal = {'Type4M2',8,true,three,<<"OCTET STRING">>}, asn1_test_lib:roundtrip('MS', 'Type4M2', MSVal), %% test of RANAP.set.asn1 PIEVal2 = [{'ProtocolIE-Field',4,ignore,{radioNetwork,'rab-pre-empted'}}], - EncVal = + EncVal0 = case Erule of per -> <<1,100>>; @@ -44,6 +44,7 @@ main(Erule) -> ber -> <<2,1,1>> end, + EncVal = {asn1_OPENTYPE,EncVal0}, PEVal2 = [{'ProtocolExtensionField',1,ignore,EncVal}, {'ProtocolExtensionField',2,reject,EncVal}], Val2 = @@ -142,7 +143,40 @@ test('InsertSubscriberDataArg') -> ok. test(mvrasn6,'InsertSubscriberDataArg') -> - Val = {'InsertSubscriberDataArg',"IMSI","Address","C",serviceGranted,["abc","cde"],["tele","serv","ice"],asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE,{'NAEA-PreferredCI',"NCC",asn1_NOVALUE},{'GPRSSubscriptionData','NULL',[{'PDP-Context',49,"PT","PDP-Address","QoS",'NULL',"APN",asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE}],asn1_NOVALUE},'NULL',onlyMSC,{'LSAInformation','NULL',accessOutsideLSAsAllowed,[{'LSAData',"LSA","L",'NULL',asn1_NOVALUE},{'LSAData',"LSA","L",'NULL',asn1_NOVALUE}],asn1_NOVALUE},'NULL',{'LCSInformation',["Addr","ess","string"],[{'LCS-PrivacyClass',"S","ExtSS",notifyLocationAllowed,[{'ExternalClient',{'LCSClientExternalID',"Addr",asn1_NOVALUE},asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE}],[broadcastService,anonymousLocation,targetMSsubscribedService],asn1_NOVALUE}],asn1_NOVALUE},100,"age",{'MC-SS-Info',"S","ExtSS",5,4,asn1_NOVALUE},"C",{'SGSN-CAMEL-SubscriptionInfo',{'GPRS-CSI',[{'GPRS-CamelTDPData',attach,13,"Addr",continueTransaction,asn1_NOVALUE}],11,asn1_NOVALUE,'NULL','NULL'},{'SMS-CSI',[{'SMS-CAMEL-TDP-DataList','sms-CollectedInfo',13,"Addr",continueTransaction,asn1_NOVALUE}],11,asn1_NOVALUE,'NULL','NULL'},asn1_NOVALUE},"ON"}, - {ok,Bytes} = 'Mvrasn6':encode('InsertSubscriberDataArg', Val), - {ok,_} = 'Mvrasn6':decode('InsertSubscriberDataArg', Bytes), + Val = {'InsertSubscriberDataArg',<<"IMSI">>,<<"Address">>,<<"C">>, + serviceGranted,[<<"abc">>,<<"cde">>], + [<<"tele">>,<<"serv">>,<<"ice">>], + asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE, + asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE, + {'NAEA-PreferredCI',<<"NCC">>,asn1_NOVALUE}, + {'GPRSSubscriptionData','NULL', + [{'PDP-Context',49,<<"PT">>,<<"PDP-Address">>,<<"QoS">>, + 'NULL',<<"APN">>,asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE}], + asn1_NOVALUE},'NULL',onlyMSC, + {'LSAInformation','NULL',accessOutsideLSAsAllowed, + [{'LSAData',<<"LSA">>,<<"L">>,'NULL',asn1_NOVALUE}, + {'LSAData',<<"LSA">>,<<"L">>,'NULL',asn1_NOVALUE}], + asn1_NOVALUE},'NULL', + {'LCSInformation',[<<"Addr">>,<<"ess">>,<<"string">>], + [{'LCS-PrivacyClass',<<"S">>,<<"ExtSS">>,notifyLocationAllowed, + [{'ExternalClient', + {'LCSClientExternalID',<<"Addr">>,asn1_NOVALUE}, + asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE}], + [broadcastService,anonymousLocation,targetMSsubscribedService], + asn1_NOVALUE}],asn1_NOVALUE}, + 100,<<"age">>, + {'MC-SS-Info',<<"S">>,<<"ExtSS">>,5,4,asn1_NOVALUE}, + <<"C">>, + {'SGSN-CAMEL-SubscriptionInfo', + {'GPRS-CSI', + [{'GPRS-CamelTDPData',attach,13,<<"Addr">>, + continueTransaction,asn1_NOVALUE}], + 11,asn1_NOVALUE,'NULL','NULL'}, + {'SMS-CSI', + [{'SMS-CAMEL-TDP-Data','sms-CollectedInfo', + 13,<<"Addr">>,continueTransaction,asn1_NOVALUE}], + 11,asn1_NOVALUE,'NULL','NULL'}, + asn1_NOVALUE}, + <<"ON">>}, + asn1_test_lib:roundtrip('Mvrasn6', 'InsertSubscriberDataArg', Val), ok. diff --git a/lib/asn1/test/testParameterizedInfObj.erl b/lib/asn1/test/testParameterizedInfObj.erl index f3b4f9b170..2fe900792d 100644 --- a/lib/asn1/test/testParameterizedInfObj.erl +++ b/lib/asn1/test/testParameterizedInfObj.erl @@ -20,7 +20,7 @@ -module(testParameterizedInfObj). --export([main/2,ranap/1]). +-export([main/2,param/1,ranap/1]). -include_lib("test_server/include/test_server.hrl"). @@ -36,31 +36,29 @@ main(Config, Erule) -> param2(Config, Erule). param(Erule) -> - PERVal = #'AllocationOrRetentionPriority' - {priorityLevel = true, - iE_Extensions = - [#'ProtocolExtensionField'{id=14, - criticality=reject, - extensionValue= <<0>>}, - #'ProtocolExtensionField'{id=2, - criticality=ignore, - extensionValue= <<1>>}]}, - BERVal = #'AllocationOrRetentionPriority' - {priorityLevel = true, - iE_Extensions = - [#'ProtocolExtensionField'{id=14, - criticality=reject, - extensionValue= <<2,1,0>>}, - #'ProtocolExtensionField'{id=2, - criticality=ignore, - extensionValue= <<2,1,1>>}]}, - case Erule of - ber -> - roundtrip('AllocationOrRetentionPriority', BERVal); - per -> - roundtrip('AllocationOrRetentionPriority', PERVal); - uper -> - roundtrip('AllocationOrRetentionPriority', PERVal) + Exts0 = case Erule of + ber -> + %% As implemented, the open type must contain + %% valid BER-encoded data. + [{14,<<2,1,0>>},{2,<<2,1,0>>}]; + _ -> + %% The PER decoder will not look inside the open type. + [{14,<<0>>},{2,<<"anything goes">>}] + end, + case 'Param':legacy_erlang_types() of + false -> + Exts = [#'ProtocolExtensionField'{id=Id, + criticality=reject, + extensionValue={asn1_OPENTYPE, + Eval}} || + {Id,Eval} <- Exts0], + aor_roundtrip(Exts); + true -> + Exts = [#'ProtocolExtensionField'{id=Id, + criticality=reject, + extensionValue=Eval} || + {Id,Eval} <- Exts0], + aor_roundtrip(Exts) end, %% test code for OTP-4242, ValueFromObject @@ -72,8 +70,13 @@ param(Erule) -> {error,_Reason2} = 'Param':decode('OS2',[4,4,1,2,3,4]), {ok,_Val4} = 'Param':decode('OS1',[4,2,1,2]); _ -> %per/uper - roundtrip('OS1', [1,2]), - {error,_Reason3} = 'Param':encode('OS1', [1,2,3,4]) + case 'Param':legacy_erlang_types() of + false -> + roundtrip('OS1', <<1,2>>), + {error,_Reason3} = 'Param':encode('OS1', <<1,2,3,4>>); + true -> + ok + end end, roundtrip('Scl', {'Scl',42,{a,9738654}}), @@ -82,6 +85,11 @@ param(Erule) -> ok. +aor_roundtrip(Exts) -> + Val = #'AllocationOrRetentionPriority'{priorityLevel = true, + iE_Extensions = Exts}, + roundtrip('AllocationOrRetentionPriority', Val). + roundtrip(T, V) -> asn1_test_lib:roundtrip('Param', T, V). @@ -102,11 +110,11 @@ ranap(_Erule) -> param2(Config, Erule) -> roundtrip2('HandoverRequired', {'HandoverRequired', - [{'ProtocolIE-Field',1,"ABC"}, + [{'ProtocolIE-Field',1,<<"ABC">>}, {'ProtocolIE-Field',2,577799}]}), Enc = roundtrip2('HandoverRequired', {'HandoverRequired', - [{'ProtocolIE-Field',1,"ABC"}, + [{'ProtocolIE-Field',1,<<"ABC">>}, {'ProtocolIE-Field',2,-42}, {'ProtocolIE-Field',100,533}, {'ProtocolIE-Field',101,true}]}), @@ -127,17 +135,19 @@ param2(Config, Erule) -> [{i,DataDir},{outdir,CaseDir},Erule]), %% Decompile extended data. - {ok,{'HandoverRequired',[{'ProtocolIE-Field',1,"ABC"}, + {ok,{'HandoverRequired',[{'ProtocolIE-Field',1,<<"ABC">>}, {'ProtocolIE-Field',2,-42}, - {'ProtocolIE-Field',100,Open100}, - {'ProtocolIE-Field',101,Open101}]}} = + {'ProtocolIE-Field',100, + {asn1_OPENTYPE,Open100}}, + {'ProtocolIE-Field',101, + {asn1_OPENTYPE,Open101}}]}} = 'Param2':decode('HandoverRequired', Enc), true = is_binary(Open100), true = is_binary(Open101), %% Test single root. roundtrip2('SingleRoot', - {'SingleRoot',[{'ProtocolIE-Field',1,"ABC"}, + {'SingleRoot',[{'ProtocolIE-Field',1,<<"ABC">>}, {'ProtocolIE-Field',2,9999}]}), ok. diff --git a/lib/asn1/test/testPrimExternal.erl b/lib/asn1/test/testPrimExternal.erl index 07a1de931f..a03760976d 100644 --- a/lib/asn1/test/testPrimExternal.erl +++ b/lib/asn1/test/testPrimExternal.erl @@ -45,6 +45,6 @@ external(_Rules) -> 'XExpNT', 'XExpImp', 'XExpExp'], - _ = [asn1_test_lib:roundtrip('PrimExternal', T, "kalle") || + _ = [asn1_test_lib:roundtrip('PrimExternal', T, <<"kalle">>) || T <- Types], ok. diff --git a/lib/asn1/test/testPrimStrings.erl b/lib/asn1/test/testPrimStrings.erl index 2fe0780701..3262d61a4d 100644 --- a/lib/asn1/test/testPrimStrings.erl +++ b/lib/asn1/test/testPrimStrings.erl @@ -34,14 +34,11 @@ fragmented(Rules) -> Lens = fragmented_lengths(), - fragmented_octet_string(Rules, Lens), - case Rules of - per -> - %% NYI. - ok; - _ -> - fragmented_strings(Lens) - end. + case 'PrimStrings':legacy_erlang_types() of + false -> fragmented_octet_string(Rules, Lens); + true -> ok + end, + fragmented_strings(Lens). fragmented_strings(Lens) -> Types = ['Ns','Ps','Ps11','Vis','IA5'], @@ -74,33 +71,37 @@ bit_string(Rules, Opts) -> %% Bs1 ::= BIT STRING %%========================================================== - bs_roundtrip('Bs1', 0, <<>>), - bs_roundtrip('Bs1', 4, <<1:3>>), - bs_roundtrip('Bs1', 15, <<15:4>>), - bs_roundtrip('Bs1', 255, <<255:8>>), - - bs_roundtrip('Bs1', 256, [0,0,0,0,0,0,0,0,1]), - bs_roundtrip('Bs1', 257, [1,0,0,0,0,0,0,0,1]), - bs_roundtrip('Bs1', 444, [0,0,1,1,1,1,0,1,1]), - - {ok,Enc1} = 'PrimStrings':encode('Bs1', 12345678901234567890), - {ok,_} = 'PrimStrings':decode('Bs1', Enc1), + bs_roundtrip('Bs1', <<>>), + bs_roundtrip('Bs1', <<1:3>>), + bs_roundtrip('Bs1', <<15:4>>), + bs_roundtrip('Bs1', <<2#010010:6>>), + bs_roundtrip('Bs1', <<2#11111111:8>>), + bs_roundtrip('Bs1', <<2#100000000:9>>), + bs_roundtrip('Bs1', <<2#100000001:9>>), + bs_roundtrip('Bs1', <<2#001111011:9>>), + bs_roundtrip('Bs1', <<2#0100101111100010011:19>>), - bs_roundtrip('Bs1', [1,1,1,1,1,1,1,1]), - bs_roundtrip('Bs1', [0,1,0,0,1,0]), - bs_roundtrip('Bs1', [1,0,0,0,0,0,0,0,0]), - bs_roundtrip('Bs1', [0,1,0,0,1,0,1,1,1,1,1,0,0,0,1,0,0,1,1]), + case 'PrimStrings':legacy_erlang_types() of + false -> + ok; + true -> + {ok,Enc1} = 'PrimStrings':encode('Bs1', 12345678901234567890), + {ok,_} = 'PrimStrings':decode('Bs1', Enc1) + end, case {Rules,Opts} of - {ber,[]} -> + {ber,[legacy_erlang_types]} -> bs_decode('Bs1', <<35,8,3,2,0,73,3,2,4,32>>, [0,1,0,0,1,0,0,1,0,0,1,0]), bs_decode('Bs1', <<35,9,3,2,0,234,3,3,7,156,0>>, [1,1,1,0,1,0,1,0,1,0,0,1,1,1,0,0,0]), bs_decode('Bs1', <<35,128,3,2,0,234,3,3,7,156,0,0,0>>, [1,1,1,0,1,0,1,0,1,0,0,1,1,1,0,0,0]); - _ -> + {ber,[]} -> + %% XXX + ok; + {_,_} -> %% DER, PER, UPER consistent_def_enc('BsDef1', [2#111101, @@ -120,30 +121,39 @@ bit_string(Rules, Opts) -> %%========================================================== roundtrip('Bs2', [mo,tu,fr]), - roundtrip('Bs2', [0,1,1,0,0,1,0], [mo,tu,fr]), + bs_roundtrip('Bs2', <<2#0110010:7>>, [mo,tu,fr]), + bs_roundtrip('Bs2', <<2#0110011:7>>, [mo,tu,fr,sa]), %%========================================================== %% Bs3 ::= BIT STRING {su(0), mo(1), tu(2), we(3), th(4), fr(5), sa(6) } (SIZE (1..7)) %%========================================================== roundtrip('Bs3', [mo,tu,fr]), - bs_roundtrip('Bs3', [0,1,1,0,0,1,0], [mo,tu,fr]), + bs_roundtrip('Bs3', <<2#0110010:7>>, [mo,tu,fr]), + bs_roundtrip('Bs3', <<2#0110010:7>>, [mo,tu,fr]), + bs_roundtrip('Bs2', <<2#0110011:7>>, [mo,tu,fr,sa]), + bs_roundtrip('Bs3', <<2#011001:6>>, [mo,tu,fr]), + bs_roundtrip('Bs3', <<2#11:2>>, [su,mo]), %%========================================================== %% Bs7 ::= BIT STRING (SIZE (24)) %%========================================================== - bs_roundtrip('Bs7', 53245, - [1,0,1,1,1,1,1,1,1,1,1,1,0,0,1,1,0,0,0,0,0,0,0,0]), - bs_roundtrip('Bs7', [1,0,1,0], - [1,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]), + bs_roundtrip('Bs7', <<23563:24>>), + case 'PrimStrings':legacy_erlang_types() of + false -> +%% {error,_} = 'PrimStrings':encode('Bs7', <<2#1010:4>>); + ok; + true -> + ok + end, %%========================================================== %% BsPri ::= [PRIVATE 61] BIT STRING %%========================================================== - bs_roundtrip('BsPri', 45, [1,0,1,1,0,1]), - bs_roundtrip('BsPri', 211, [1,1,0,0,1,0,1,1]), + bs_roundtrip('BsPri', <<2#101101:6>>), + bs_roundtrip('BsPri', <<2#11001011:8>>), case Rules of ber -> @@ -164,8 +174,8 @@ bit_string(Rules, Opts) -> %% BsExpPri ::= [PRIVATE 61] EXPLICIT BIT STRING %%========================================================== - bs_roundtrip('BsExpPri', 45, [1,0,1,1,0,1]), - bs_roundtrip('BsExpPri', 211, [1,1,0,0,1,0,1,1]), + bs_roundtrip('BsExpPri', <<2#101101:6>>), + bs_roundtrip('BsExpPri', <<2#11001011:8>>), case Rules of ber -> @@ -186,14 +196,14 @@ bit_string(Rules, Opts) -> %% veteran(2), collegeGraduate(3)}, test case for OTP-5710 %%========================================================== - {ok,Bytes54} = 'BitStr':encode('PersonalStatus', []), + {ok,Bytes54} = 'BitStr':encode('PersonalStatus', <<>>), {ok,[]} = 'BitStr':decode('PersonalStatus', Bytes54), %%========================================================== %% BS5932 ::= BIT STRING (SIZE (5..MAX)) %% test case for OTP-5932 %%========================================================== - bs_roundtrip('BSMAX', [1,0,1,0,1]), + bs_roundtrip('BSMAX', <<2#10101:5>>), case Rules of ber -> {error,_} = 'PrimStrings':encode('BSMAX', [1,0,1]); @@ -207,28 +217,35 @@ bit_string(Rules, Opts) -> %% BS1024 ::= BIT STRING (SIZE (1024)) %% test case for OTP-7602 %%========================================================== - BSmaker = - fun(_F,S,S,_,Acc) -> - Acc; - (F,Ix,S,{A,B},Acc) -> - F(F,Ix+1,S,{B,A},[A|Acc]) - end, - - BSList255 = BSmaker(BSmaker,0,255,{1,0},[]), - bs_roundtrip('BS255', BSList255), - BSList256 = BSmaker(BSmaker,0,256,{1,0},[]), - bs_roundtrip('BS256', BSList256), - BSList1024 = BSmaker(BSmaker,0,1024,{1,0},[]), - bs_roundtrip('BS1024', BSList1024), - bs_roundtrip('TransportLayerAddress', [0,1,1,0]), + bs_roundtrip('BS255', random_bits(255)), + bs_roundtrip('BS256', random_bits(256)), + bs_roundtrip('BS1024', random_bits(1024)), + + bs_roundtrip('TransportLayerAddress', <<2#0110:4>>), case Rules of ber -> ok; _ -> per_bs_strings() end. -consistent_def_enc(Type, Vs) -> +random_bits(N) -> + Seed = integer_to_list(erlang:phash2(erlang:now())), + random_bits(<<>>, N, Seed). + +random_bits(Bin, N, Seed) -> + RandomBits = erlang:md5(Seed), + Bits = bit_size(RandomBits), + if + Bits < N -> + random_bits(<<Bin/bitstring,RandomBits/bitstring>>, + N-Bits, RandomBits); + true -> + <<LastBits:N/bitstring,_/bitstring>> = RandomBits, + <<Bin/bitstring,LastBits/bitstring>> + end. + +consistent_def_enc(Type, Vs0) -> M = 'PrimStrings', {ok,Enc} = M:encode(Type, {Type,asn1_DEFAULT}), {ok,Val} = M:decode(Type, Enc), @@ -241,6 +258,13 @@ consistent_def_enc(Type, Vs) -> {legacy,{_,Bs}} when is_list(Bs) -> ok end, + %% If this is not the legacy format, only bitstrings are + %% allowed. + Vs = case M:legacy_erlang_types() of + false -> [V || V <- Vs0, is_bitstring(V)]; + true -> Vs0 + end, + %% All values should be recognized and encoded as the %% the default value (i.e. not encoded at all). _ = [{ok,Enc} = M:encode(Type, {Type,V}) || V <- Vs], @@ -252,18 +276,9 @@ consistent_def_enc(Type, Vs) -> %% a SIZE constraint). per_bs_strings() -> - bs_roundtrip('Bs3', [0,0,1,0,0,0,0], [tu]), bs_roundtrip('Bs3', <<2#0010000:7>>, [tu]), - bs_roundtrip('Bs3', {1,<<2#00100000:8>>}, [tu]), - - bs_roundtrip('Bs4', [0,1,1,0,0,1,0], [mo,tu,fr]), bs_roundtrip('Bs4', <<2#0110010:7>>, [mo,tu,fr]), - bs_roundtrip('Bs4', {1,<<2#01100100:8>>}, [mo,tu,fr]), - - bs_roundtrip('Bs4', [0,1,1,0,0,0,0], [mo,tu]), bs_roundtrip('Bs4', <<2#011:3,0:32>>, [mo,tu]), - bs_roundtrip('Bs4', {5,<<2#011:3,0:32,0:5>>}, [mo,tu]), - [per_trailing_zeroes(B) || B <- lists:seq(0, 255)], ok. @@ -279,10 +294,6 @@ per_trailing_zeroes(Byte) -> {bit,LastBitPos} -> LastBitPos+1 end, - %% List of zeroes and ones. - named_roundtrip(L, Pos, ExpectedSz), - named_roundtrip(L++[0,0,0,0,0], Pos, ExpectedSz), - %% Bitstrings. Bs = << <<B:1>> || B <- L >>, Sz = bit_size(Bs), @@ -290,14 +301,22 @@ per_trailing_zeroes(Byte) -> Bin = <<Bs:Sz/bits,0:16,0:7>>, named_roundtrip(Bin, Pos, ExpectedSz), - %% Compact bitstring. - named_roundtrip({7,Bin}, Pos, ExpectedSz), + case 'PrimStrings':legacy_erlang_types() of + false -> + ok; + true -> + %% List of zeroes and ones. + named_roundtrip(L, Pos, ExpectedSz), + named_roundtrip(L++[0,0,0,0,0], Pos, ExpectedSz), - %% Integer bitstring (obsolete). - IntBs = intlist_to_integer(L, 0, 0), - named_roundtrip(IntBs, Pos, ExpectedSz), + %% Compact bitstring. + named_roundtrip({7,Bin}, Pos, ExpectedSz), - ok. + %% Integer bitstring (obsolete). + IntBs = intlist_to_integer(L, 0, 0), + named_roundtrip(IntBs, Pos, ExpectedSz), + ok + end. make_bit_list(0) -> []; make_bit_list(B) -> [B band 1|make_bit_list(B bsr 1)]. @@ -331,61 +350,62 @@ octet_string(Rules) -> %% Os ::= OCTET STRING %%========================================================== + Legacy = 'PrimStrings':legacy_erlang_types(), case Rules of - ber -> - {ok,"Jones"} = + ber when not Legacy -> + {ok,<<"Jones">>} = 'PrimStrings':decode('Os', <<4,5,16#4A,16#6F,16#6E,16#65,16#73>>), - {ok,"Jones"} = + {ok,<<"Jones">>} = 'PrimStrings':decode('Os', <<36,9,4,3,16#4A,16#6F,16#6E,4,2,16#65,16#73>>), - {ok,"Jones"} = + {ok,<<"Jones">>} = 'PrimStrings':decode('Os', <<36,128,4,3,16#4A,16#6F,16#6E,4,2,16#65,16#73,0,0>>), ok; _ -> ok end, - roundtrip('Os', [47,23,99,255,1]), - roundtrip('OsCon', [47,23,99,255,1]), - roundtrip('OsPri', [47,23,99,255,1]), - roundtrip('OsApp', [47,23,99,255,1]), + os_roundtrip('Os', <<47,23,99,255,1>>), + os_roundtrip('OsCon', <<47,23,99,255,1>>), + os_roundtrip('OsPri', <<47,23,99,255,1>>), + os_roundtrip('OsApp', <<47,23,99,255,1>>), - roundtrip('OsExpCon', [47,23,99,255,1]), - roundtrip('OsExpPri', [47,23,99,255,1]), - roundtrip('OsExpApp', [47,23,99,255,1]), + os_roundtrip('OsExpCon', <<47,23,99,255,1>>), + os_roundtrip('OsExpPri', <<47,23,99,255,1>>), + os_roundtrip('OsExpApp', <<47,23,99,255,1>>), - roundtrip('Os', []), - roundtrip('OsApp', []), - roundtrip('OsExpApp',[]), + os_roundtrip('Os', <<>>), + os_roundtrip('OsApp', <<>>), + os_roundtrip('OsExpApp', <<>>), - OsR = "12345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890", + OsR = <<"12345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890">>, - roundtrip('Os', OsR), - roundtrip('OsCon', OsR), - roundtrip('OsExpApp', OsR), + os_roundtrip('Os', OsR), + os_roundtrip('OsCon', OsR), + os_roundtrip('OsExpApp', OsR), case Rules of - ber -> - {ok,"Jones"} = 'PrimStrings':decode('OsExpApp', <<127,62,7,4,5,16#4A,16#6F,16#6E,16#65,16#73>>), - {ok,"Jones"} = 'PrimStrings':decode('OsExpApp', <<127,62,11,36,9,4,3,16#4A,16#6F,16#6E,4,2,16#65,16#73>>), - {ok,"Jones"} = 'PrimStrings':decode('OsExpApp', <<127,62,13,36,128,4,3,16#4A,16#6F,16#6E,4,2,16#65,16#73,0,0>>), - {ok,"Jones"} = 'PrimStrings':decode('OsExpApp', <<127,62,128,36,128,4,3,16#4A,16#6F,16#6E,4,2,16#65,16#73,0,0,0,0>>), - {ok,"JonesJones"} = 'PrimStrings':decode('OsExpApp', <<127,62,128,36,128,4,3,16#4A,16#6F,16#6E,4,2,16#65,16#73,0,0,36,128,4,3,16#4A,16#6F,16#6E,4,2,16#65,16#73,0,0,0,0>>), + ber when not Legacy -> + {ok,<<"Jones">>} = 'PrimStrings':decode('OsExpApp', <<127,62,7,4,5,16#4A,16#6F,16#6E,16#65,16#73>>), + {ok,<<"Jones">>} = 'PrimStrings':decode('OsExpApp', <<127,62,11,36,9,4,3,16#4A,16#6F,16#6E,4,2,16#65,16#73>>), + {ok,<<"Jones">>} = 'PrimStrings':decode('OsExpApp', <<127,62,13,36,128,4,3,16#4A,16#6F,16#6E,4,2,16#65,16#73,0,0>>), + {ok,<<"Jones">>} = 'PrimStrings':decode('OsExpApp', <<127,62,128,36,128,4,3,16#4A,16#6F,16#6E,4,2,16#65,16#73,0,0,0,0>>), + {ok,<<"JonesJones">>} = 'PrimStrings':decode('OsExpApp', <<127,62,128,36,128,4,3,16#4A,16#6F,16#6E,4,2,16#65,16#73,0,0,36,128,4,3,16#4A,16#6F,16#6E,4,2,16#65,16#73,0,0,0,0>>), ok; - - _-> + _ -> ok end, S255 = lists:seq(1, 255), - Strings = {type,true,"","1","12","345",true, - S255,[$a|S255],[$a,$b|S255],397}, - p_roundtrip('OsFixedStrings', Strings), - p_roundtrip('OsFixedStringsExt', Strings), - p_roundtrip('OsVarStringsExt', Strings), + Strings = {type,true,<<"">>,<<"1">>,<<"12">>,<<"345">>,true, + list_to_binary(S255),list_to_binary([$a|S255]), + list_to_binary([$a,$b|S255]),397}, + p_os_roundtrip('OsFixedStrings', Strings), + p_os_roundtrip('OsFixedStringsExt', Strings), + p_os_roundtrip('OsVarStringsExt', Strings), ShortenedStrings = shorten_by_two(Strings), - p_roundtrip('OsFixedStringsExt', ShortenedStrings), - p_roundtrip('OsVarStringsExt', ShortenedStrings), + p_os_roundtrip('OsFixedStringsExt', ShortenedStrings), + p_os_roundtrip('OsVarStringsExt', ShortenedStrings), ok. fragmented_octet_string(Erules, Lens) -> @@ -414,13 +434,14 @@ fragmented_octet_string(Erules, Types, L) -> ok. enc_frag(Erules, Type, Value) -> - {ok,Encoded} = 'PrimStrings':encode(Type, Value), + M = 'PrimStrings', + {ok,Encoded} = M:encode(Type, Value), case Erules of ber -> Encoded; _ -> %% Validate encoding with our own encoder. - Encoded = enc_frag_1(<<>>, list_to_binary(Value)) + Encoded = enc_frag_1(<<>>, Value) end. enc_frag_1(Res, Bin0) -> @@ -439,12 +460,12 @@ enc_frag_1(Res, Bin0) -> end. make_value(L) -> - make_value(L, 0, []). + make_value(L, 0, <<>>). make_value(0, _, Acc) -> Acc; make_value(N, Byte, Acc) when Byte =< 255 -> - make_value(N-1, Byte+7, [Byte|Acc]); + make_value(N-1, Byte+7, <<Acc/binary,Byte:8>>); make_value(N, Byte, Acc) -> make_value(N, Byte band 16#FF, Acc). @@ -742,10 +763,32 @@ utf8_string(_Rules) -> shorten_by_two(Tuple) -> L = [case E of [_,_|T] -> T; + <<_:16,T/binary>> -> T; _ -> E end || E <- tuple_to_list(Tuple)], list_to_tuple(L). +p_os_roundtrip(Type, Value0) -> + Value = setelement(1, Value0, Type), + p_os_roundtrip_1(Type, Value). + +p_os_roundtrip_1(Type, Value) -> + M = 'PrimStrings', + case M:legacy_erlang_types() of + false -> + asn1_test_lib:roundtrip(M, Type, Value); + true -> + {ok,Encoded} = M:encode(Type, Value), + Es0 = tuple_to_list(Value), + Es1 = [if + is_binary(E) -> binary_to_list(E); + true -> E + end || E <- Es0], + ListValue = list_to_tuple(Es1), + {ok,Encoded} = M:encode(Type, ListValue), + {ok,ListValue} = M:decode(Type, Encoded) + end. + p_roundtrip(Type, Value0) -> Value = setelement(1, Value0, Type), roundtrip(Type, Value). @@ -759,15 +802,57 @@ roundtrip(Type, Value, Expected) -> bs_roundtrip(Type, Value) -> bs_roundtrip(Type, Value, Value). -bs_roundtrip(Type, Value, Expected) -> +os_roundtrip(Type, Bin) when is_binary(Bin) -> M = 'PrimStrings', - {ok,Encoded} = M:encode(Type, Value), - {ok,Encoded} = M:encode(Type, Expected), - case M:decode(Type, Encoded) of - {ok,Expected} -> - ok; - {ok,Other} -> - Expected = convert(Other, Expected) + case M:legacy_erlang_types() of + false -> + asn1_test_lib:roundtrip(M, Type, Bin); + true -> + {ok,Encoded} = M:encode(Type, Bin), + List = binary_to_list(Bin), + {ok,Encoded} = M:encode(Type, List), + {ok,List} = M:decode(Type, Encoded) + end. + +bs_roundtrip(Type, Value, Expected) when is_bitstring(Value) -> + M = 'PrimStrings', + case M:legacy_erlang_types() of + false -> + asn1_test_lib:roundtrip(M, Type, Value, Expected); + true -> + {ok,Encoded} = M:encode(Type, Value), + BitList = [B || <<B:1>> <= Value], + {ok,Encoded} = M:encode(Type, BitList), + case BitList of + [] -> + {ok,Encoded} = M:encode(Type, 0); + [_|_] -> + case lists:last(BitList) of + 1 -> + Int = lists:foldr(fun(B, A) -> + (A bsl 1) bor B + end, 0, BitList), + {ok,Encoded} = M:encode(Type, Int); + 0 -> + %% This BIT STRING cannot be represented + %% as an integer. + ok + end + end, + Compact = case bit_size(Value) of + Bits when Bits rem 8 =:= 0 -> + {0,Value}; + Bits -> + Unused = 8 - Bits rem 8, + {Unused,<<Value:Bits/bitstring,0:Unused>>} + end, + {ok,Encoded} = M:encode(Type, Compact), + case M:decode(Type, Encoded) of + {ok,Expected} -> + ok; + {ok,Other} -> + Expected = convert(Other, Expected) + end end. bs_decode(Type, Encoded, Expected) -> diff --git a/lib/asn1/test/testSeqExtension.erl b/lib/asn1/test/testSeqExtension.erl index 8473459c36..c16e9fcd4c 100644 --- a/lib/asn1/test/testSeqExtension.erl +++ b/lib/asn1/test/testSeqExtension.erl @@ -44,7 +44,7 @@ main(Erule, DataDir, Opts) -> roundtrip('SeqExt4', #'SeqExt4'{bool=true,int=12345}), roundtrip('SeqExt4', #'SeqExt4'{bool=false,int=123456}), - roundtrip('SeqExt5', #'SeqExt5'{name="Arne",shoesize=47}), + roundtrip('SeqExt5', #'SeqExt5'{name = <<"Arne">>,shoesize=47}), %% Encode a value with this version of the specification. BigInt = 128638468966, @@ -52,7 +52,7 @@ main(Erule, DataDir, Opts) -> s2=#'SeqExt2'{bool=true,int=2345}, s3=#'SeqExt3'{bool=false,int=17}, s4=#'SeqExt4'{bool=true,int=38739739}, - s5=#'SeqExt5'{name="Arne",shoesize=47}, + s5=#'SeqExt5'{name = <<"Arne">>,shoesize=47}, s6=#'SeqExt6'{i1=531,i2=601,i3=999, i4=777,i5=11953, i6=13553,i7=77777}, diff --git a/lib/asn1/test/testSeqExternal.erl b/lib/asn1/test/testSeqExternal.erl index a8e0902244..0b1d305054 100644 --- a/lib/asn1/test/testSeqExternal.erl +++ b/lib/asn1/test/testSeqExternal.erl @@ -29,15 +29,15 @@ -record('SeqXSet3',{bool, int, set}). main(_Rules) -> - roundtrip('XNTNT', #'XSeqNT'{os="kalle",bool=true}), - roundtrip('XImpNT', #'XSeqNT'{os="kalle",bool=true}), - roundtrip('XExpNT', #'XSeqNT'{os="kalle",bool=true}), - roundtrip('XNTImp', #'XSeqImp'{os="kalle",bool=true}), - roundtrip('XImpImp', #'XSeqImp'{os="kalle",bool=true}), - roundtrip('XExpImp', #'XSeqImp'{os="kalle",bool=true}), - roundtrip('XNTExp', #'XSeqExp'{os="kalle",bool=true}), - roundtrip('XImpExp', #'XSeqExp'{os="kalle",bool=true}), - roundtrip('XExpExp', #'XSeqExp'{os="kalle",bool=true}), + roundtrip('XNTNT', #'XSeqNT'{os = <<"kalle">>,bool=true}), + roundtrip('XImpNT', #'XSeqNT'{os = <<"kalle">>,bool=true}), + roundtrip('XExpNT', #'XSeqNT'{os = <<"kalle">>,bool=true}), + roundtrip('XNTImp', #'XSeqImp'{os = <<"kalle">>,bool=true}), + roundtrip('XImpImp', #'XSeqImp'{os = <<"kalle">>,bool=true}), + roundtrip('XExpImp', #'XSeqImp'{os = <<"kalle">>,bool=true}), + roundtrip('XNTExp', #'XSeqExp'{os = <<"kalle">>,bool=true}), + roundtrip('XImpExp', #'XSeqExp'{os = <<"kalle">>,bool=true}), + roundtrip('XExpExp', #'XSeqExp'{os = <<"kalle">>,bool=true}), roundtrip('SeqXSet1', #'SeqXSet1'{set=#'XSet1'{bool1=true,int1=77, set1=#'XSetIn'{boolIn=false,intIn=88}}, diff --git a/lib/asn1/test/testSeqOf.erl b/lib/asn1/test/testSeqOf.erl index 7f8f4079b4..25059d6052 100644 --- a/lib/asn1/test/testSeqOf.erl +++ b/lib/asn1/test/testSeqOf.erl @@ -85,10 +85,10 @@ main(_Rules) -> seq43=SeqIn3}), roundtrip('Seq5', {'Seq5',true,[],77}), - roundtrip('Seq5', {'Seq5',true,[""],77}), - roundtrip('Seq5', {'Seq5',true,["a"],77}), - roundtrip('Seq5', {'Seq5',true,["ab"],77}), - roundtrip('Seq5', {'Seq5',true,["abc"],77}), + roundtrip('Seq5', {'Seq5',true,[<<"">>],77}), + roundtrip('Seq5', {'Seq5',true,[<<"a">>],77}), + roundtrip('Seq5', {'Seq5',true,[<<"ab">>],77}), + roundtrip('Seq5', {'Seq5',true,[<<"abc">>],77}), roundtrip('Seq6', {'Seq6',[],[],101}), roundtrip('Seq6', {'Seq6',[],[7],101}), @@ -100,15 +100,15 @@ main(_Rules) -> roundtrip('Seq8', {'Seq8',[],37}), roundtrip('Seq9', {'Seq9',true,[],97}), - roundtrip('Seq9', {'Seq9',true,[""],97}), - roundtrip('Seq9', {'Seq9',true,["x"],97}), - roundtrip('Seq9', {'Seq9',true,["xy"],97}), - roundtrip('Seq9', {'Seq9',true,["xyz"],97}), - - roundtrip('Seq10', {'Seq10',true,[""],97}), - roundtrip('Seq10', {'Seq10',true,["a"],97}), - roundtrip('Seq10', {'Seq10',true,["a","b"],97}), - roundtrip('Seq10', {'Seq10',true,["a","b","c"],97}), + roundtrip('Seq9', {'Seq9',true,[<<"">>],97}), + roundtrip('Seq9', {'Seq9',true,[<<"x">>],97}), + roundtrip('Seq9', {'Seq9',true,[<<"xy">>],97}), + roundtrip('Seq9', {'Seq9',true,[<<"xyz">>],97}), + + roundtrip('Seq10', {'Seq10',true,[<<"">>],97}), + roundtrip('Seq10', {'Seq10',true,[<<"a">>],97}), + roundtrip('Seq10', {'Seq10',true,[<<"a">>,<<"b">>],97}), + roundtrip('Seq10', {'Seq10',true,[<<"a">>,<<"b">>,<<"c">>],97}), roundtrip('SeqEmp', #'SeqEmp'{seq1=[#'Empty'{}]}), diff --git a/lib/asn1/test/testSeqOfExternal.erl b/lib/asn1/test/testSeqOfExternal.erl index 2e60f441c1..38b9f0ce7c 100644 --- a/lib/asn1/test/testSeqOfExternal.erl +++ b/lib/asn1/test/testSeqOfExternal.erl @@ -29,50 +29,59 @@ main(_Rules) -> roundtrip('NTNT', - [#'NT'{os="kalle",bool=true},#'NT'{os="kalle",bool=true}]), + [#'NT'{os = <<"kalle">>,bool=true}, + #'NT'{os = <<"kalle">>,bool=true}]), roundtrip('ImpNT', - [#'NT'{os="kalle",bool=true},#'NT'{os="kalle",bool=true}]), + [#'NT'{os = <<"kalle">>,bool=true}, + #'NT'{os = <<"kalle">>,bool=true}]), roundtrip('ExpNT', - [#'NT'{os="kalle",bool=true},#'NT'{os="kalle",bool=true}]), + [#'NT'{os = <<"kalle">>,bool=true}, + #'NT'{os = <<"kalle">>,bool=true}]), roundtrip('NTImp', - [#'Imp'{os="kalle",bool=true},#'Imp'{os="kalle",bool=true}]), + [#'Imp'{os = <<"kalle">>,bool=true}, + #'Imp'{os = <<"kalle">>,bool=true}]), roundtrip('ImpImp', - [#'Imp'{os="kalle",bool=true},#'Imp'{os="kalle",bool=true}]), + [#'Imp'{os = <<"kalle">>,bool=true}, + #'Imp'{os = <<"kalle">>,bool=true}]), roundtrip('ExpImp', - [#'Imp'{os="kalle",bool=true},#'Imp'{os="kalle",bool=true}]), + [#'Imp'{os = <<"kalle">>,bool=true}, + #'Imp'{os = <<"kalle">>,bool=true}]), roundtrip('NTExp', - [#'Exp'{os="kalle",bool=true},#'Exp'{os="kalle",bool=true}]), + [#'Exp'{os = <<"kalle">>,bool=true}, + #'Exp'{os = <<"kalle">>,bool=true}]), roundtrip('ImpExp', - [#'Exp'{os="kalle",bool=true},#'Exp'{os="kalle",bool=true}]), + [#'Exp'{os = <<"kalle">>,bool=true}, + #'Exp'{os = <<"kalle">>,bool=true}]), roundtrip('ExpExp', - [#'Exp'{os="kalle",bool=true},#'Exp'{os="kalle",bool=true}]), + [#'Exp'{os = <<"kalle">>,bool=true}, + #'Exp'{os = <<"kalle">>,bool=true}]), roundtrip('XNTNT', - [#'XSeqNT'{os="kalle",bool=true}, - #'XSeqNT'{os="kalle",bool=true}]), + [#'XSeqNT'{os = <<"kalle">>,bool=true}, + #'XSeqNT'{os = <<"kalle">>,bool=true}]), roundtrip('XImpNT', - [#'XSeqNT'{os="kalle",bool=true}, - #'XSeqNT'{os="kalle",bool=true}]), + [#'XSeqNT'{os = <<"kalle">>,bool=true}, + #'XSeqNT'{os = <<"kalle">>,bool=true}]), roundtrip('XExpNT', - [#'XSeqNT'{os="kalle",bool=true}, - #'XSeqNT'{os="kalle",bool=true}]), + [#'XSeqNT'{os = <<"kalle">>,bool=true}, + #'XSeqNT'{os = <<"kalle">>,bool=true}]), roundtrip('XNTImp', - [#'XSeqImp'{os="kalle",bool=true}, - #'XSeqImp'{os="kalle",bool=true}]), + [#'XSeqImp'{os = <<"kalle">>,bool=true}, + #'XSeqImp'{os = <<"kalle">>,bool=true}]), roundtrip('XImpImp', - [#'XSeqImp'{os="kalle",bool=true}, - #'XSeqImp'{os="kalle",bool=true}]), + [#'XSeqImp'{os = <<"kalle">>,bool=true}, + #'XSeqImp'{os = <<"kalle">>,bool=true}]), roundtrip('XExpImp', - [#'XSeqImp'{os="kalle",bool=true}, - #'XSeqImp'{os="kalle",bool=true}]), + [#'XSeqImp'{os = <<"kalle">>,bool=true}, + #'XSeqImp'{os = <<"kalle">>,bool=true}]), roundtrip('XNTExp', - [#'XSeqExp'{os="kalle",bool=true}, - #'XSeqExp'{os="kalle",bool=true}]), + [#'XSeqExp'{os = <<"kalle">>,bool=true}, + #'XSeqExp'{os = <<"kalle">>,bool=true}]), roundtrip('XImpExp', - [#'XSeqExp'{os="kalle",bool=true}, - #'XSeqExp'{os="kalle",bool=true}]), + [#'XSeqExp'{os = <<"kalle">>,bool=true}, + #'XSeqExp'{os = <<"kalle">>,bool=true}]), roundtrip('XExpExp', - [#'XSeqExp'{os="kalle",bool=true}, - #'XSeqExp'{os="kalle",bool=true}]), + [#'XSeqExp'{os = <<"kalle">>,bool=true}, + #'XSeqExp'{os = <<"kalle">>,bool=true}]), ok. roundtrip(T, V) -> diff --git a/lib/asn1/test/testSeqOfTag.erl b/lib/asn1/test/testSeqOfTag.erl index 38c1dcb90f..f66e29e91d 100644 --- a/lib/asn1/test/testSeqOfTag.erl +++ b/lib/asn1/test/testSeqOfTag.erl @@ -44,47 +44,47 @@ -record('Exp',{os, bool}). main(_Rules) -> - roundtrip('SeqTagNt', #'SeqTagNt'{nt=[#'NT'{os="kalle",bool=true}, - #'NT'{os="kalle",bool=true}]}), - roundtrip('SeqTagNtI', #'SeqTagNtI'{imp=[#'Imp'{os="kalle",bool=true}, - #'Imp'{os="kalle",bool=true}]}), - roundtrip('SeqTagNtE', #'SeqTagNtE'{exp=[#'Exp'{os="kalle",bool=true}, - #'Exp'{os="kalle",bool=true}]}), - roundtrip('SeqTagI', #'SeqTagI'{nt=[#'NT'{os="kalle",bool=true}, - #'NT'{os="kalle",bool=true}]}), - roundtrip('SeqTagII', #'SeqTagII'{imp=[#'Imp'{os="kalle",bool=true}, - #'Imp'{os="kalle",bool=true}]}), - roundtrip('SeqTagIE', #'SeqTagIE'{exp=[#'Exp'{os="kalle",bool=true}, - #'Exp'{os="kalle",bool=true}]}), - roundtrip('SeqTagE', #'SeqTagE'{nt=[#'NT'{os="kalle",bool=true}, - #'NT'{os="kalle",bool=true}]}), - roundtrip('SeqTagEI', #'SeqTagEI'{imp=[#'Imp'{os="kalle",bool=true}, - #'Imp'{os="kalle",bool=true}]}), - roundtrip('SeqTagEE', #'SeqTagEE'{exp=[#'Exp'{os="kalle",bool=true}, - #'Exp'{os="kalle",bool=true}]}), + roundtrip('SeqTagNt', #'SeqTagNt'{nt=[#'NT'{os = <<"kalle">>,bool=true}, + #'NT'{os = <<"kalle">>,bool=true}]}), + roundtrip('SeqTagNtI', #'SeqTagNtI'{imp=[#'Imp'{os = <<"kalle">>,bool=true}, + #'Imp'{os = <<"kalle">>,bool=true}]}), + roundtrip('SeqTagNtE', #'SeqTagNtE'{exp=[#'Exp'{os = <<"kalle">>,bool=true}, + #'Exp'{os = <<"kalle">>,bool=true}]}), + roundtrip('SeqTagI', #'SeqTagI'{nt=[#'NT'{os = <<"kalle">>,bool=true}, + #'NT'{os = <<"kalle">>,bool=true}]}), + roundtrip('SeqTagII', #'SeqTagII'{imp=[#'Imp'{os = <<"kalle">>,bool=true}, + #'Imp'{os = <<"kalle">>,bool=true}]}), + roundtrip('SeqTagIE', #'SeqTagIE'{exp=[#'Exp'{os = <<"kalle">>,bool=true}, + #'Exp'{os = <<"kalle">>,bool=true}]}), + roundtrip('SeqTagE', #'SeqTagE'{nt=[#'NT'{os = <<"kalle">>,bool=true}, + #'NT'{os = <<"kalle">>,bool=true}]}), + roundtrip('SeqTagEI', #'SeqTagEI'{imp=[#'Imp'{os = <<"kalle">>,bool=true}, + #'Imp'{os = <<"kalle">>,bool=true}]}), + roundtrip('SeqTagEE', #'SeqTagEE'{exp=[#'Exp'{os = <<"kalle">>,bool=true}, + #'Exp'{os = <<"kalle">>,bool=true}]}), roundtrip('SeqTagXNt', - #'SeqTagXNt'{xnt=[#'XSeqNT'{os="kalle",bool=true}, - #'XSeqNT'{os="kalle",bool=true}]}), + #'SeqTagXNt'{xnt=[#'XSeqNT'{os = <<"kalle">>,bool=true}, + #'XSeqNT'{os = <<"kalle">>,bool=true}]}), roundtrip('SeqTagXI', - #'SeqTagXI'{ximp=[#'XSeqImp'{os="kalle",bool=true}, - #'XSeqImp'{os="kalle",bool=true}]}), + #'SeqTagXI'{ximp=[#'XSeqImp'{os = <<"kalle">>,bool=true}, + #'XSeqImp'{os = <<"kalle">>,bool=true}]}), roundtrip('SeqTagXE', - #'SeqTagXE'{xexp=[#'XSeqExp'{os="kalle",bool=true}, - #'XSeqExp'{os="kalle",bool=true}]}), + #'SeqTagXE'{xexp=[#'XSeqExp'{os = <<"kalle">>,bool=true}, + #'XSeqExp'{os = <<"kalle">>,bool=true}]}), roundtrip('SeqTagImpX', - #'SeqTagImpX'{xnt=[#'XSeqNT'{os="kalle",bool=true}, - #'XSeqNT'{os="kalle",bool=true}], - ximp=[#'XSeqImp'{os="kalle",bool=true}, - #'XSeqImp'{os="kalle",bool=true}], - xexp=[#'XSeqExp'{os="kalle",bool=true}, - #'XSeqExp'{os="kalle",bool=true}]}), + #'SeqTagImpX'{xnt=[#'XSeqNT'{os = <<"kalle">>,bool=true}, + #'XSeqNT'{os = <<"kalle">>,bool=true}], + ximp=[#'XSeqImp'{os = <<"kalle">>,bool=true}, + #'XSeqImp'{os = <<"kalle">>,bool=true}], + xexp=[#'XSeqExp'{os = <<"kalle">>,bool=true}, + #'XSeqExp'{os = <<"kalle">>,bool=true}]}), roundtrip('SeqTagExpX', - #'SeqTagExpX'{xnt=[#'XSeqNT'{os="kalle",bool=true}, - #'XSeqNT'{os="kalle",bool=true}], - ximp=[#'XSeqImp'{os="kalle",bool=true}, - #'XSeqImp'{os="kalle",bool=true}], - xexp=[#'XSeqExp'{os="kalle",bool=true}, - #'XSeqExp'{os="kalle",bool=true}]}), + #'SeqTagExpX'{xnt=[#'XSeqNT'{os = <<"kalle">>,bool=true}, + #'XSeqNT'{os = <<"kalle">>,bool=true}], + ximp=[#'XSeqImp'{os = <<"kalle">>,bool=true}, + #'XSeqImp'{os = <<"kalle">>,bool=true}], + xexp=[#'XSeqExp'{os = <<"kalle">>,bool=true}, + #'XSeqExp'{os = <<"kalle">>,bool=true}]}), ok. roundtrip(T, V) -> diff --git a/lib/asn1/test/testSeqPrim.erl b/lib/asn1/test/testSeqPrim.erl index 46bac77910..7f3ef86ac5 100644 --- a/lib/asn1/test/testSeqPrim.erl +++ b/lib/asn1/test/testSeqPrim.erl @@ -36,9 +36,9 @@ main(_Rules) -> roundtrip('Seq', #'Seq'{bool=false,boolCon=true,boolPri=false,boolApp=true, boolExpCon=false,boolExpPri=true,boolExpApp=false}), roundtrip('Empty', #'Empty'{}), - roundtrip('Big', #'Big'{os1=lists:duplicate(120, 16#A5), - os2=lists:duplicate(128, 16#A7), - os3=lists:duplicate(17777, 16#F5)}), + roundtrip('Big', #'Big'{os1=list_to_binary(lists:duplicate(120, 16#A5)), + os2=list_to_binary(lists:duplicate(128, 16#A7)), + os3=list_to_binary(lists:duplicate(17777, 16#F5))}), ok. roundtrip(Type, Value) -> diff --git a/lib/asn1/test/testSeqSetDefaultVal.erl b/lib/asn1/test/testSeqSetDefaultVal.erl index 044099199f..79992a0a94 100644 --- a/lib/asn1/test/testSeqSetDefaultVal.erl +++ b/lib/asn1/test/testSeqSetDefaultVal.erl @@ -162,7 +162,7 @@ main(Rule, Opts) -> {#'SeqOS'{}, [{#'SeqOS'.a, [asn1_DEFAULT, - [172]]}]}, + <<172>>]}]}, {#'SeqOI'{}, [{#'SeqOI'.a, @@ -314,17 +314,10 @@ der() -> c=[second], d = <<>>}), roundtrip(<<48,0>>, 'SeqOS', - #'SeqOS'{a=[172],b=[16#A8,16#A0],c='NULL'}), - roundtrip(<<48,0>>, - 'SeqOS', - #'SeqOS'{a=172,b=43168,c='NULL'}, - #'SeqOS'{a=[172],b=[16#A8,16#A0],c='NULL'}), + #'SeqOS'{a = <<172>>,b = <<16#A8,16#A0>>,c='NULL'}), - roundtrip(<<49,0>>, 'SetOS', #'SetOS'{a=[172],b=[16#A8,16#A0],c='NULL'}), - roundtrip(<<49,0>>, - 'SetOS', - #'SetOS'{a=172,b=43168,c='NULL'}, - #'SetOS'{a=[172],b=[16#A8,16#A0],c='NULL'}), + roundtrip(<<49,0>>, 'SetOS', + #'SetOS'{a = <<172>>,b = <<16#A8,16#A0>>,c='NULL'}), roundtrip(<<48,0>>, 'SeqOI', diff --git a/lib/asn1/test/testSeqTag.erl b/lib/asn1/test/testSeqTag.erl index 2f127b3e97..6bacca6808 100644 --- a/lib/asn1/test/testSeqTag.erl +++ b/lib/asn1/test/testSeqTag.erl @@ -35,24 +35,24 @@ -record('Exp',{os, bool}). main(_Rules) -> - roundtrip('SeqTag', #'SeqTag'{nt=#'NT'{os="kalle",bool=true}, - imp=#'Imp'{os="kalle",bool=true}, - exp=#'Exp'{os="kalle",bool=true}}), - roundtrip('SeqTagImp', #'SeqTagImp'{nt=#'NT'{os="kalle",bool=true}, - imp=#'Imp'{os="kalle",bool=true}, - exp=#'Exp'{os="kalle",bool=true}}), - roundtrip('SeqTagExp', #'SeqTagExp'{nt=#'NT'{os="kalle",bool=true}, - imp=#'Imp'{os="kalle",bool=true}, - exp=#'Exp'{os="kalle",bool=true}}), - roundtrip('SeqTagX', #'SeqTagX'{xnt=#'XSeqNT'{os="kalle",bool=true}, - ximp=#'XSeqImp'{os="kalle",bool=true}, - xexp=#'XSeqExp'{os="kalle",bool=true}}), - roundtrip('SeqTagImpX', #'SeqTagImpX'{xnt=#'XSeqNT'{os="kalle",bool=true}, - ximp=#'XSeqImp'{os="kalle",bool=true}, - xexp=#'XSeqExp'{os="kalle",bool=true}}), - roundtrip('SeqTagExpX', #'SeqTagExpX'{xnt=#'XSeqNT'{os="kalle",bool=true}, - ximp=#'XSeqImp'{os="kalle",bool=true}, - xexp=#'XSeqExp'{os="kalle",bool=true}}), + roundtrip('SeqTag', #'SeqTag'{nt=#'NT'{os = <<"kalle">>,bool=true}, + imp=#'Imp'{os = <<"kalle">>,bool=true}, + exp=#'Exp'{os = <<"kalle">>,bool=true}}), + roundtrip('SeqTagImp', #'SeqTagImp'{nt=#'NT'{os = <<"kalle">>,bool=true}, + imp=#'Imp'{os = <<"kalle">>,bool=true}, + exp=#'Exp'{os = <<"kalle">>,bool=true}}), + roundtrip('SeqTagExp', #'SeqTagExp'{nt=#'NT'{os = <<"kalle">>,bool=true}, + imp=#'Imp'{os = <<"kalle">>,bool=true}, + exp=#'Exp'{os = <<"kalle">>,bool=true}}), + roundtrip('SeqTagX', #'SeqTagX'{xnt=#'XSeqNT'{os = <<"kalle">>,bool=true}, + ximp=#'XSeqImp'{os = <<"kalle">>,bool=true}, + xexp=#'XSeqExp'{os = <<"kalle">>,bool=true}}), + roundtrip('SeqTagImpX', #'SeqTagImpX'{xnt=#'XSeqNT'{os = <<"kalle">>,bool=true}, + ximp=#'XSeqImp'{os = <<"kalle">>,bool=true}, + xexp=#'XSeqExp'{os = <<"kalle">>,bool=true}}), + roundtrip('SeqTagExpX', #'SeqTagExpX'{xnt=#'XSeqNT'{os = <<"kalle">>,bool=true}, + ximp=#'XSeqImp'{os = <<"kalle">>,bool=true}, + xexp=#'XSeqExp'{os = <<"kalle">>,bool=true}}), ok. roundtrip(T, V) -> diff --git a/lib/asn1/test/testSeqTypeRefCho.erl b/lib/asn1/test/testSeqTypeRefCho.erl index b008bc46b8..1a921c6f38 100644 --- a/lib/asn1/test/testSeqTypeRefCho.erl +++ b/lib/asn1/test/testSeqTypeRefCho.erl @@ -28,10 +28,10 @@ main(_Rules) -> roundtrip('SeqTRcho', - #'SeqTRcho'{'seqCho' = {choOs,"A string 1"}, - 'seqChoE' = {choOs,"A string 3"}, - 'seqCho-E' = {choOs,"A string 7"}, - 'seqChoE-E' = {choOs,"A string 9"}}), + #'SeqTRcho'{'seqCho' = {choOs,<<"A string 1">>}, + 'seqChoE' = {choOs,<<"A string 3">>}, + 'seqCho-E' = {choOs,<<"A string 7">>}, + 'seqChoE-E' = {choOs,<<"A string 9">>}}), ok. roundtrip(T, V) -> diff --git a/lib/asn1/test/testSeqTypeRefPrim.erl b/lib/asn1/test/testSeqTypeRefPrim.erl index b63882ae99..d66d1ebcfe 100644 --- a/lib/asn1/test/testSeqTypeRefPrim.erl +++ b/lib/asn1/test/testSeqTypeRefPrim.erl @@ -26,15 +26,15 @@ main(_Rules) -> roundtrip('SeqTR', - #'SeqTR'{'octStr' = "A string 1", - 'octStrI' = "A string 2", - 'octStrE' = "A string 3", - 'octStr-I' = "A string 4", - 'octStrI-I' = "A string 5", - 'octStrE-I' = "A string 6", - 'octStr-E' = "A string 7", - 'octStrI-E' = "A string 8", - 'octStrE-E' = "A string 9"}), + #'SeqTR'{'octStr' = <<"A string 1">>, + 'octStrI' = <<"A string 2">>, + 'octStrE' = <<"A string 3">>, + 'octStr-I' = <<"A string 4">>, + 'octStrI-I' = <<"A string 5">>, + 'octStrE-I' = <<"A string 6">>, + 'octStr-E' = <<"A string 7">>, + 'octStrI-E' = <<"A string 8">>, + 'octStrE-E' = <<"A string 9">>}), ok. roundtrip(T, V) -> diff --git a/lib/asn1/test/testSeqTypeRefSeq.erl b/lib/asn1/test/testSeqTypeRefSeq.erl index fc2e0a67c9..3288511f0a 100644 --- a/lib/asn1/test/testSeqTypeRefSeq.erl +++ b/lib/asn1/test/testSeqTypeRefSeq.erl @@ -71,15 +71,15 @@ main(_Rules) -> seqS2=#'SeqSTag_seqS2'{b2=true,i2=22}, seqS3=#'SeqSTag_seqS3'{b3=true,i3=33}}), roundtrip('SeqTRseq', - #'SeqTRseq'{seqSeq=#'SeqSeq'{seqInt=2,seqOs="A1"}, - seqSeqI=#'SeqSeq'{seqInt=2,seqOs="A2"}, - seqSeqE=#'SeqSeq'{seqInt=2,seqOs="A3"}, - 'seqSeq-I'=#'SeqSeqImp'{seqInt=2,seqOs="A4"}, - 'seqSeqI-I'=#'SeqSeqImp'{seqInt=2,seqOs="A5"}, - 'seqSeqE-I'=#'SeqSeqImp'{seqInt=2,seqOs="A6"}, - 'seqSeq-E'=#'SeqSeqExp'{seqInt=2,seqOs="A7"}, - 'seqSeqI-E'=#'SeqSeqExp'{seqInt=2,seqOs="A8"}, - 'seqSeqE-E'=#'SeqSeqExp'{seqInt=2,seqOs="A9"}}), + #'SeqTRseq'{seqSeq=#'SeqSeq'{seqInt=2,seqOs = <<"A1">>}, + seqSeqI=#'SeqSeq'{seqInt=2,seqOs = <<"A2">>}, + seqSeqE=#'SeqSeq'{seqInt=2,seqOs = <<"A3">>}, + 'seqSeq-I'=#'SeqSeqImp'{seqInt=2,seqOs = <<"A4">>}, + 'seqSeqI-I'=#'SeqSeqImp'{seqInt=2,seqOs = <<"A5">>}, + 'seqSeqE-I'=#'SeqSeqImp'{seqInt=2,seqOs = <<"A6">>}, + 'seqSeq-E'=#'SeqSeqExp'{seqInt=2,seqOs = <<"A7">>}, + 'seqSeqI-E'=#'SeqSeqExp'{seqInt=2,seqOs = <<"A8">>}, + 'seqSeqE-E'=#'SeqSeqExp'{seqInt=2,seqOs = <<"A9">>}}), ok. roundtrip(T, V) -> diff --git a/lib/asn1/test/testSeqTypeRefSet.erl b/lib/asn1/test/testSeqTypeRefSet.erl index 911a4b7a47..d73423284b 100644 --- a/lib/asn1/test/testSeqTypeRefSet.erl +++ b/lib/asn1/test/testSeqTypeRefSet.erl @@ -32,15 +32,15 @@ main(_Rules) -> roundtrip('SeqTRset', - #'SeqTRset'{seqSet=#'SeqSet'{setInt=2,setOs="A1"}, - seqSetI=#'SeqSet'{setInt=2,setOs="A2"}, - seqSetE=#'SeqSet'{setInt=2,setOs="A3"}, - 'seqSet-I'=#'SeqSetImp'{setInt=2,setOs="A4"}, - 'seqSetI-I'=#'SeqSetImp'{setInt=2,setOs="A5"}, - 'seqSetE-I'=#'SeqSetImp'{setInt=2,setOs="A6"}, - 'seqSet-E'=#'SeqSetExp'{setInt=2,setOs="A7"}, - 'seqSetI-E'=#'SeqSetExp'{setInt=2,setOs="A8"}, - 'seqSetE-E'=#'SeqSetExp'{setInt=2,setOs="A9"}}), + #'SeqTRset'{seqSet=#'SeqSet'{setInt=2,setOs = <<"A1">>}, + seqSetI=#'SeqSet'{setInt=2,setOs = <<"A2">>}, + seqSetE=#'SeqSet'{setInt=2,setOs = <<"A3">>}, + 'seqSet-I'=#'SeqSetImp'{setInt=2,setOs = <<"A4">>}, + 'seqSetI-I'=#'SeqSetImp'{setInt=2,setOs = <<"A5">>}, + 'seqSetE-I'=#'SeqSetImp'{setInt=2,setOs = <<"A6">>}, + 'seqSet-E'=#'SeqSetExp'{setInt=2,setOs = <<"A7">>}, + 'seqSetI-E'=#'SeqSetExp'{setInt=2,setOs = <<"A8">>}, + 'seqSetE-E'=#'SeqSetExp'{setInt=2,setOs = <<"A9">>}}), ok. roundtrip(T, V) -> diff --git a/lib/asn1/test/testSetExternal.erl b/lib/asn1/test/testSetExternal.erl index e17d7053aa..626adc5822 100644 --- a/lib/asn1/test/testSetExternal.erl +++ b/lib/asn1/test/testSetExternal.erl @@ -28,15 +28,15 @@ -record('SetXSeq3',{bool, int, seq}). main(_Rules) -> - roundtrip('XNTNT', #'XSetNT'{os="kalle",bool=true}), - roundtrip('XImpNT', #'XSetNT'{os="kalle",bool=true}), - roundtrip('XExpNT', #'XSetNT'{os="kalle",bool=true}), - roundtrip('XNTImp', #'XSetImp'{os="kalle",bool=true}), - roundtrip('XImpImp', #'XSetImp'{os="kalle",bool=true}), - roundtrip('XExpImp', #'XSetImp'{os="kalle",bool=true}), - roundtrip('XNTExp', #'XSetExp'{os="kalle",bool=true}), - roundtrip('XImpExp', #'XSetExp'{os="kalle",bool=true}), - roundtrip('XExpExp', #'XSetExp'{os="kalle",bool=true}), + roundtrip('XNTNT', #'XSetNT'{os = <<"kalle">>,bool=true}), + roundtrip('XImpNT', #'XSetNT'{os = <<"kalle">>,bool=true}), + roundtrip('XExpNT', #'XSetNT'{os = <<"kalle">>,bool=true}), + roundtrip('XNTImp', #'XSetImp'{os = <<"kalle">>,bool=true}), + roundtrip('XImpImp', #'XSetImp'{os = <<"kalle">>,bool=true}), + roundtrip('XExpImp', #'XSetImp'{os = <<"kalle">>,bool=true}), + roundtrip('XNTExp', #'XSetExp'{os = <<"kalle">>,bool=true}), + roundtrip('XImpExp', #'XSetExp'{os = <<"kalle">>,bool=true}), + roundtrip('XExpExp', #'XSetExp'{os = <<"kalle">>,bool=true}), roundtrip('SetXSeq1', #'SetXSeq1'{seq=#'XSeq1'{bool1=true,int1=77, seq1=#'XSeqIn'{boolIn=false,intIn=88}}, bool=true,int=66}), diff --git a/lib/asn1/test/testSetOf.erl b/lib/asn1/test/testSetOf.erl index 54c42c1f21..0f82a14625 100644 --- a/lib/asn1/test/testSetOf.erl +++ b/lib/asn1/test/testSetOf.erl @@ -121,9 +121,9 @@ main(_Rules) -> #'SetIn'{boolIn=false,intIn=125}, #'SetIn'{boolIn=false,intIn=225}]}), - roundtrip('SetOs', ["First","Second","Third"]), - roundtrip('SetOsImp', ["First","Second","Third"]), - roundtrip('SetOsExp', ["First","Second","Third"]), + roundtrip('SetOs', [<<"First">>,<<"Second">>,<<"Third">>]), + roundtrip('SetOsImp', [<<"First">>,<<"Second">>,<<"Third">>]), + roundtrip('SetOsExp', [<<"First">>,<<"Second">>,<<"Third">>]), roundtrip('SetEmp', #'SetEmp'{set1=[#'Empty'{}]}), ok. diff --git a/lib/asn1/test/testSetOfExternal.erl b/lib/asn1/test/testSetOfExternal.erl index a380ba5ac1..cc5fe10710 100644 --- a/lib/asn1/test/testSetOfExternal.erl +++ b/lib/asn1/test/testSetOfExternal.erl @@ -28,24 +28,42 @@ -record('Exp',{os, bool}). main(_Rules) -> - roundtrip('NTNT', [#'NT'{os="kalle",bool=true},#'NT'{os="kalle",bool=true}]), - roundtrip('ImpNT', [#'NT'{os="kalle",bool=true},#'NT'{os="kalle",bool=true}]), - roundtrip('ExpNT', [#'NT'{os="kalle",bool=true},#'NT'{os="kalle",bool=true}]), - roundtrip('NTImp', [#'Imp'{os="kalle",bool=true},#'Imp'{os="kalle",bool=true}]), - roundtrip('ImpImp', [#'Imp'{os="kalle",bool=true},#'Imp'{os="kalle",bool=true}]), - roundtrip('ExpImp', [#'Imp'{os="kalle",bool=true},#'Imp'{os="kalle",bool=true}]), - roundtrip('NTExp', [#'Exp'{os="kalle",bool=true},#'Exp'{os="kalle",bool=true}]), - roundtrip('ImpExp', [#'Exp'{os="kalle",bool=true},#'Exp'{os="kalle",bool=true}]), - roundtrip('ExpExp', [#'Exp'{os="kalle",bool=true},#'Exp'{os="kalle",bool=true}]), - roundtrip('XNTNT', [#'XSetNT'{os="kalle",bool=true},#'XSetNT'{os="kalle",bool=true}]), - roundtrip('XImpNT', [#'XSetNT'{os="kalle",bool=true},#'XSetNT'{os="kalle",bool=true}]), - roundtrip('XExpNT', [#'XSetNT'{os="kalle",bool=true},#'XSetNT'{os="kalle",bool=true}]), - roundtrip('XNTImp', [#'XSetImp'{os="kalle",bool=true},#'XSetImp'{os="kalle",bool=true}]), - roundtrip('XImpImp', [#'XSetImp'{os="kalle",bool=true},#'XSetImp'{os="kalle",bool=true}]), - roundtrip('XExpImp', [#'XSetImp'{os="kalle",bool=true},#'XSetImp'{os="kalle",bool=true}]), - roundtrip('XNTExp', [#'XSetExp'{os="kalle",bool=true},#'XSetExp'{os="kalle",bool=true}]), - roundtrip('XImpExp', [#'XSetExp'{os="kalle",bool=true},#'XSetExp'{os="kalle",bool=true}]), - roundtrip('XExpExp', [#'XSetExp'{os="kalle",bool=true},#'XSetExp'{os="kalle",bool=true}]), + roundtrip('NTNT', [#'NT'{os = <<"kalle">>,bool=true}, + #'NT'{os = <<"kalle">>,bool=true}]), + roundtrip('ImpNT', [#'NT'{os = <<"kalle">>,bool=true}, + #'NT'{os = <<"kalle">>,bool=true}]), + roundtrip('ExpNT', [#'NT'{os = <<"kalle">>,bool=true}, + #'NT'{os = <<"kalle">>,bool=true}]), + roundtrip('NTImp', [#'Imp'{os = <<"kalle">>,bool=true}, + #'Imp'{os = <<"kalle">>,bool=true}]), + roundtrip('ImpImp', [#'Imp'{os = <<"kalle">>,bool=true}, + #'Imp'{os = <<"kalle">>,bool=true}]), + roundtrip('ExpImp', [#'Imp'{os = <<"kalle">>,bool=true}, + #'Imp'{os = <<"kalle">>,bool=true}]), + roundtrip('NTExp', [#'Exp'{os = <<"kalle">>,bool=true}, + #'Exp'{os = <<"kalle">>,bool=true}]), + roundtrip('ImpExp', [#'Exp'{os = <<"kalle">>,bool=true}, + #'Exp'{os = <<"kalle">>,bool=true}]), + roundtrip('ExpExp', [#'Exp'{os = <<"kalle">>,bool=true}, + #'Exp'{os = <<"kalle">>,bool=true}]), + roundtrip('XNTNT', [#'XSetNT'{os = <<"kalle">>,bool=true}, + #'XSetNT'{os = <<"kalle">>,bool=true}]), + roundtrip('XImpNT', [#'XSetNT'{os = <<"kalle">>,bool=true}, + #'XSetNT'{os = <<"kalle">>,bool=true}]), + roundtrip('XExpNT', [#'XSetNT'{os = <<"kalle">>,bool=true}, + #'XSetNT'{os = <<"kalle">>,bool=true}]), + roundtrip('XNTImp', [#'XSetImp'{os = <<"kalle">>,bool=true}, + #'XSetImp'{os = <<"kalle">>,bool=true}]), + roundtrip('XImpImp', [#'XSetImp'{os = <<"kalle">>,bool=true}, + #'XSetImp'{os = <<"kalle">>,bool=true}]), + roundtrip('XExpImp', [#'XSetImp'{os = <<"kalle">>,bool=true}, + #'XSetImp'{os = <<"kalle">>,bool=true}]), + roundtrip('XNTExp', [#'XSetExp'{os = <<"kalle">>,bool=true}, + #'XSetExp'{os = <<"kalle">>,bool=true}]), + roundtrip('XImpExp', [#'XSetExp'{os = <<"kalle">>,bool=true}, + #'XSetExp'{os = <<"kalle">>,bool=true}]), + roundtrip('XExpExp', [#'XSetExp'{os = <<"kalle">>,bool=true}, + #'XSetExp'{os = <<"kalle">>,bool=true}]), ok. roundtrip(T, V) -> diff --git a/lib/asn1/test/testSetOfTag.erl b/lib/asn1/test/testSetOfTag.erl index 81bc467abb..0d656f05a6 100644 --- a/lib/asn1/test/testSetOfTag.erl +++ b/lib/asn1/test/testSetOfTag.erl @@ -42,42 +42,42 @@ -record('Exp',{os, bool}). main(_Rules) -> - roundtrip('SetTagNt', #'SetTagNt'{nt=[#'NT'{os="kalle",bool=true}, - #'NT'{os="kalle",bool=true}]}), - roundtrip('SetTagNtI', #'SetTagNtI'{imp=[#'Imp'{os="kalle",bool=true}, - #'Imp'{os="kalle",bool=true}]}), - roundtrip('SetTagNtE', #'SetTagNtE'{exp=[#'Exp'{os="kalle",bool=true}, - #'Exp'{os="kalle",bool=true}]}), - roundtrip('SetTagI', #'SetTagI'{nt=[#'NT'{os="kalle",bool=true}, - #'NT'{os="kalle",bool=true}]}), - roundtrip('SetTagII', #'SetTagII'{imp=[#'Imp'{os="kalle",bool=true}, - #'Imp'{os="kalle",bool=true}]}), - roundtrip('SetTagIE', #'SetTagIE'{exp=[#'Exp'{os="kalle",bool=true}, - #'Exp'{os="kalle",bool=true}]}), - roundtrip('SetTagE', #'SetTagE'{nt=[#'NT'{os="kalle",bool=true}, - #'NT'{os="kalle",bool=true}]}), - roundtrip('SetTagEI', #'SetTagEI'{imp=[#'Imp'{os="kalle",bool=true}, - #'Imp'{os="kalle",bool=true}]}), - roundtrip('SetTagEE', #'SetTagEE'{exp=[#'Exp'{os="kalle",bool=true}, - #'Exp'{os="kalle",bool=true}]}), - roundtrip('SetTagXNt', #'SetTagXNt'{xnt=[#'XSetNT'{os="kalle",bool=true}, - #'XSetNT'{os="kalle",bool=true}]}), - roundtrip('SetTagXI', #'SetTagXI'{ximp=[#'XSetImp'{os="kalle",bool=true}, - #'XSetImp'{os="kalle",bool=true}]}), - roundtrip('SetTagXE', #'SetTagXE'{xexp=[#'XSetExp'{os="kalle",bool=true}, - #'XSetExp'{os="kalle",bool=true}]}), - roundtrip('SetTagImpX', #'SetTagImpX'{xnt=[#'XSetNT'{os="kalle",bool=true}, - #'XSetNT'{os="kalle",bool=true}], - ximp=[#'XSetImp'{os="kalle",bool=true}, - #'XSetImp'{os="kalle",bool=true}], - xexp=[#'XSetExp'{os="kalle",bool=true}, - #'XSetExp'{os="kalle",bool=true}]}), - roundtrip('SetTagExpX', #'SetTagExpX'{xnt=[#'XSetNT'{os="kalle",bool=true}, - #'XSetNT'{os="kalle",bool=true}], - ximp=[#'XSetImp'{os="kalle",bool=true}, - #'XSetImp'{os="kalle",bool=true}], - xexp=[#'XSetExp'{os="kalle",bool=true}, - #'XSetExp'{os="kalle",bool=true}]}), + roundtrip('SetTagNt', #'SetTagNt'{nt=[#'NT'{os = <<"kalle">>,bool=true}, + #'NT'{os = <<"kalle">>,bool=true}]}), + roundtrip('SetTagNtI', #'SetTagNtI'{imp=[#'Imp'{os = <<"kalle">>,bool=true}, + #'Imp'{os = <<"kalle">>,bool=true}]}), + roundtrip('SetTagNtE', #'SetTagNtE'{exp=[#'Exp'{os = <<"kalle">>,bool=true}, + #'Exp'{os = <<"kalle">>,bool=true}]}), + roundtrip('SetTagI', #'SetTagI'{nt=[#'NT'{os = <<"kalle">>,bool=true}, + #'NT'{os = <<"kalle">>,bool=true}]}), + roundtrip('SetTagII', #'SetTagII'{imp=[#'Imp'{os = <<"kalle">>,bool=true}, + #'Imp'{os = <<"kalle">>,bool=true}]}), + roundtrip('SetTagIE', #'SetTagIE'{exp=[#'Exp'{os = <<"kalle">>,bool=true}, + #'Exp'{os = <<"kalle">>,bool=true}]}), + roundtrip('SetTagE', #'SetTagE'{nt=[#'NT'{os = <<"kalle">>,bool=true}, + #'NT'{os = <<"kalle">>,bool=true}]}), + roundtrip('SetTagEI', #'SetTagEI'{imp=[#'Imp'{os = <<"kalle">>,bool=true}, + #'Imp'{os = <<"kalle">>,bool=true}]}), + roundtrip('SetTagEE', #'SetTagEE'{exp=[#'Exp'{os = <<"kalle">>,bool=true}, + #'Exp'{os = <<"kalle">>,bool=true}]}), + roundtrip('SetTagXNt', #'SetTagXNt'{xnt=[#'XSetNT'{os = <<"kalle">>,bool=true}, + #'XSetNT'{os = <<"kalle">>,bool=true}]}), + roundtrip('SetTagXI', #'SetTagXI'{ximp=[#'XSetImp'{os = <<"kalle">>,bool=true}, + #'XSetImp'{os = <<"kalle">>,bool=true}]}), + roundtrip('SetTagXE', #'SetTagXE'{xexp=[#'XSetExp'{os = <<"kalle">>,bool=true}, + #'XSetExp'{os = <<"kalle">>,bool=true}]}), + roundtrip('SetTagImpX', #'SetTagImpX'{xnt=[#'XSetNT'{os = <<"kalle">>,bool=true}, + #'XSetNT'{os = <<"kalle">>,bool=true}], + ximp=[#'XSetImp'{os = <<"kalle">>,bool=true}, + #'XSetImp'{os = <<"kalle">>,bool=true}], + xexp=[#'XSetExp'{os = <<"kalle">>,bool=true}, + #'XSetExp'{os = <<"kalle">>,bool=true}]}), + roundtrip('SetTagExpX', #'SetTagExpX'{xnt=[#'XSetNT'{os = <<"kalle">>,bool=true}, + #'XSetNT'{os = <<"kalle">>,bool=true}], + ximp=[#'XSetImp'{os = <<"kalle">>,bool=true}, + #'XSetImp'{os = <<"kalle">>,bool=true}], + xexp=[#'XSetExp'{os = <<"kalle">>,bool=true}, + #'XSetExp'{os = <<"kalle">>,bool=true}]}), ok. roundtrip(T, V) -> diff --git a/lib/asn1/test/testSetTag.erl b/lib/asn1/test/testSetTag.erl index 5863a149b9..fa1d84f50d 100644 --- a/lib/asn1/test/testSetTag.erl +++ b/lib/asn1/test/testSetTag.erl @@ -34,24 +34,24 @@ -record('Exp',{os, bool}). main(_Rules) -> - roundtrip('SetTag', #'SetTag'{nt=#'NT'{os="kalle",bool=true}, - imp=#'Imp'{os="kalle",bool=true}, - exp=#'Exp'{os="kalle",bool=true}}), - roundtrip('SetTagImp', #'SetTagImp'{nt=#'NT'{os="kalle",bool=true}, - imp=#'Imp'{os="kalle",bool=true}, - exp=#'Exp'{os="kalle",bool=true}}), - roundtrip('SetTagExp', #'SetTagExp'{nt=#'NT'{os="kalle",bool=true}, - imp=#'Imp'{os="kalle",bool=true}, - exp=#'Exp'{os="kalle",bool=true}}), - roundtrip('SetTagX', #'SetTagX'{xnt=#'XSetNT'{os="kalle",bool=true}, - ximp=#'XSetImp'{os="kalle",bool=true}, - xexp=#'XSetExp'{os="kalle",bool=true}}), - roundtrip('SetTagImpX', #'SetTagImpX'{xnt=#'XSetNT'{os="kalle",bool=true}, - ximp=#'XSetImp'{os="kalle",bool=true}, - xexp=#'XSetExp'{os="kalle",bool=true}}), - roundtrip('SetTagExpX', #'SetTagExpX'{xnt=#'XSetNT'{os="kalle",bool=true}, - ximp=#'XSetImp'{os="kalle",bool=true}, - xexp=#'XSetExp'{os="kalle",bool=true}}), + roundtrip('SetTag', #'SetTag'{nt=#'NT'{os = <<"kalle">>,bool=true}, + imp=#'Imp'{os = <<"kalle">>,bool=true}, + exp=#'Exp'{os = <<"kalle">>,bool=true}}), + roundtrip('SetTagImp', #'SetTagImp'{nt=#'NT'{os = <<"kalle">>,bool=true}, + imp=#'Imp'{os = <<"kalle">>,bool=true}, + exp=#'Exp'{os = <<"kalle">>,bool=true}}), + roundtrip('SetTagExp', #'SetTagExp'{nt=#'NT'{os = <<"kalle">>,bool=true}, + imp=#'Imp'{os = <<"kalle">>,bool=true}, + exp=#'Exp'{os = <<"kalle">>,bool=true}}), + roundtrip('SetTagX', #'SetTagX'{xnt=#'XSetNT'{os = <<"kalle">>,bool=true}, + ximp=#'XSetImp'{os = <<"kalle">>,bool=true}, + xexp=#'XSetExp'{os = <<"kalle">>,bool=true}}), + roundtrip('SetTagImpX', #'SetTagImpX'{xnt=#'XSetNT'{os = <<"kalle">>,bool=true}, + ximp=#'XSetImp'{os = <<"kalle">>,bool=true}, + xexp=#'XSetExp'{os = <<"kalle">>,bool=true}}), + roundtrip('SetTagExpX', #'SetTagExpX'{xnt=#'XSetNT'{os = <<"kalle">>,bool=true}, + ximp=#'XSetImp'{os = <<"kalle">>,bool=true}, + xexp=#'XSetExp'{os = <<"kalle">>,bool=true}}), ok. roundtrip(T, V) -> diff --git a/lib/asn1/test/testSetTypeRefCho.erl b/lib/asn1/test/testSetTypeRefCho.erl index 8d62f45bfa..97bbd557e0 100644 --- a/lib/asn1/test/testSetTypeRefCho.erl +++ b/lib/asn1/test/testSetTypeRefCho.erl @@ -29,10 +29,10 @@ main(_Rules) -> roundtrip('SetTRcho', - #'SetTRcho'{'setCho' = {choOs,"A string 1"}, - 'setChoE' = {choOs,"A string 3"}, - 'setCho-E' = {choOs,"A string 7"}, - 'setChoE-E' = {choOs,"A string 9"}}), + #'SetTRcho'{'setCho' = {choOs,<<"A string 1">>}, + 'setChoE' = {choOs,<<"A string 3">>}, + 'setCho-E' = {choOs,<<"A string 7">>}, + 'setChoE-E' = {choOs,<<"A string 9">>}}), ok. roundtrip(T, V) -> diff --git a/lib/asn1/test/testSetTypeRefPrim.erl b/lib/asn1/test/testSetTypeRefPrim.erl index cc2e157e68..d441fb789d 100644 --- a/lib/asn1/test/testSetTypeRefPrim.erl +++ b/lib/asn1/test/testSetTypeRefPrim.erl @@ -28,15 +28,15 @@ main(_Rules) -> roundtrip('SetTR', - #'SetTR'{'octStr' = "A string 1", - 'octStrI' = "A string 2", - 'octStrE' = "A string 3", - 'octStr-I' = "A string 4", - 'octStrI-I' = "A string 5", - 'octStrE-I' = "A string 6", - 'octStr-E' = "A string 7", - 'octStrI-E' = "A string 8", - 'octStrE-E' = "A string 9"}), + #'SetTR'{'octStr' = <<"A string 1">>, + 'octStrI' = <<"A string 2">>, + 'octStrE' = <<"A string 3">>, + 'octStr-I' = <<"A string 4">>, + 'octStrI-I' = <<"A string 5">>, + 'octStrE-I' = <<"A string 6">>, + 'octStr-E' = <<"A string 7">>, + 'octStrI-E' = <<"A string 8">>, + 'octStrE-E' = <<"A string 9">>}), ok. roundtrip(T, V) -> diff --git a/lib/asn1/test/testSetTypeRefSeq.erl b/lib/asn1/test/testSetTypeRefSeq.erl index 17af5c2922..a2b5f5745e 100644 --- a/lib/asn1/test/testSetTypeRefSeq.erl +++ b/lib/asn1/test/testSetTypeRefSeq.erl @@ -30,23 +30,23 @@ main(_Rules) -> roundtrip('SetTRseq', - #'SetTRseq'{'setSeq' = #'SetSeq'{seqOs = "A1", + #'SetTRseq'{'setSeq' = #'SetSeq'{seqOs = <<"A1">>, seqInt = 2}, - 'setSeqI' = #'SetSeq'{seqOs = "A2", + 'setSeqI' = #'SetSeq'{seqOs = <<"A2">>, seqInt = 2}, - 'setSeqE' = #'SetSeq'{seqOs = "A3", + 'setSeqE' = #'SetSeq'{seqOs = <<"A3">>, seqInt = 2}, - 'setSeq-I' = #'SetSeqImp'{seqOs = "A4", + 'setSeq-I' = #'SetSeqImp'{seqOs = <<"A4">>, seqInt = 2}, - 'setSeqI-I' = #'SetSeqImp'{seqOs = "A5", + 'setSeqI-I' = #'SetSeqImp'{seqOs = <<"A5">>, seqInt = 2}, - 'setSeqE-I' = #'SetSeqImp'{seqOs = "A6", + 'setSeqE-I' = #'SetSeqImp'{seqOs = <<"A6">>, seqInt = 2}, - 'setSeq-E' = #'SetSeqExp'{seqOs = "A7", + 'setSeq-E' = #'SetSeqExp'{seqOs = <<"A7">>, seqInt = 2}, - 'setSeqI-E' = #'SetSeqExp'{seqOs = "A8", + 'setSeqI-E' = #'SetSeqExp'{seqOs = <<"A8">>, seqInt = 2}, - 'setSeqE-E' = #'SetSeqExp'{seqOs = "A9", + 'setSeqE-E' = #'SetSeqExp'{seqOs = <<"A9">>, seqInt = 2}}), ok. diff --git a/lib/asn1/test/testSetTypeRefSet.erl b/lib/asn1/test/testSetTypeRefSet.erl index 8786e0fb4d..80a6be58c9 100644 --- a/lib/asn1/test/testSetTypeRefSet.erl +++ b/lib/asn1/test/testSetTypeRefSet.erl @@ -71,15 +71,15 @@ main(_Rules) -> setS2=#'SetSTag_setS2'{b2=true,i2=22}, setS3=#'SetSTag_setS3'{b3=true,i3=33}}), roundtrip('SetTRset', - #'SetTRset'{setSet=#'SetSet'{setInt=2,setOs="A1"}, - setSetI=#'SetSet'{setInt=2,setOs="A2"}, - setSetE=#'SetSet'{setInt=2,setOs="A3"}, - 'setSet-I'=#'SetSetImp'{setInt=2,setOs="A4"}, - 'setSetI-I'=#'SetSetImp'{setInt=2,setOs="A5"}, - 'setSetE-I'=#'SetSetImp'{setInt=2,setOs="A6"}, - 'setSet-E'=#'SetSetExp'{setInt=2,setOs="A7"}, - 'setSetI-E'=#'SetSetExp'{setInt=2,setOs="A8"}, - 'setSetE-E'=#'SetSetExp'{setInt=2,setOs="A9"}}), + #'SetTRset'{setSet=#'SetSet'{setInt=2,setOs = <<"A1">>}, + setSetI=#'SetSet'{setInt=2,setOs = <<"A2">>}, + setSetE=#'SetSet'{setInt=2,setOs = <<"A3">>}, + 'setSet-I'=#'SetSetImp'{setInt=2,setOs = <<"A4">>}, + 'setSetI-I'=#'SetSetImp'{setInt=2,setOs = <<"A5">>}, + 'setSetE-I'=#'SetSetImp'{setInt=2,setOs = <<"A6">>}, + 'setSet-E'=#'SetSetExp'{setInt=2,setOs = <<"A7">>}, + 'setSetI-E'=#'SetSetExp'{setInt=2,setOs = <<"A8">>}, + 'setSetE-E'=#'SetSetExp'{setInt=2,setOs = <<"A9">>}}), ok. diff --git a/lib/asn1/test/testTimer.erl b/lib/asn1/test/testTimer.erl index 0f02bab6e0..89bc2b463d 100644 --- a/lib/asn1/test/testTimer.erl +++ b/lib/asn1/test/testTimer.erl @@ -18,163 +18,141 @@ %% %% -module(testTimer). --export([go/2]). +-export([go/0]). -include_lib("test_server/include/test_server.hrl"). -define(times, 5000). val() -> - _Value = {'H323-UserInformation',{'H323-UU-PDU', - {callProceeding, - {'CallProceeding-UUIE', - {0,8,222}, - {'EndpointType', - {'NonStandardParameter', - {object,{0,9,237}}, - "O"}, - {'VendorIdentifier', - {'H221NonStandard',62,63,16282}, - "OC", - "OC"}, - {'GatekeeperInfo', - {'NonStandardParameter', - {object,{0,10,260}}, - "O"}}, - {'GatewayInfo', - [{h320, - {'H320Caps', - {'NonStandardParameter', - {object,{0,11,282}}, - "O"}, - [{'DataRate', - {'NonStandardParameter', - {object, - {0,11,295}}, - "O"}, - 1290470518, - 78}], - [{'SupportedPrefix', - {'NonStandardParameter', - {object, - {0,12,312}}, - "O"}, - {'h323-ID',"BM"}}]}}], - {'NonStandardParameter', - {object,{0,13,326}}, - "O"}}, - {'McuInfo', - {'NonStandardParameter', - {object,{1,13,340,340}}, - "OC"}}, - {'TerminalInfo', - {'NonStandardParameter', - {object,{1,14,353,354}}, - "OC"}}, - true, - true}, - {ipxAddress, - {'TransportAddress_ipxAddress', - "OCTET ", - "OCTE", - "OC"}}, - {'CallIdentifier',"OCTET STRINGOCTE"}, - {noSecurity,'NULL'}, - [{'ClearToken', - 1667517741, - "BM", - {'DHset',[1],[1],[1]}, - "OCTET STR", - -26430296, - {'TypedCertificate', - {1,16,405,406}, - "OC"}, - "BMP", - {'NonStandardParameter', - {1,16,414,415}, - "OC"}}, - {'ClearToken', - 1817656756, - "BMP", - {'DHset',[1],[1],[1]}, - "OCTET STRI", - -16356110, - {'TypedCertificate', - {1,17,442,443}, - "OC"}, - "BMP", - {'NonStandardParameter', - {1,18,452,452}, - "OC"}}], - [{cryptoGKPwdEncr, - {'CryptoH323Token_cryptoGKPwdEncr', - {1,18,467,467}, - {'Params',-7477016,"OCTET ST"}, - "OC"}}, - {cryptoGKPwdEncr, - {'CryptoH323Token_cryptoGKPwdEncr', - {1,19,486,486}, - {'Params',-2404513,"OCTET ST"}, - []}}], - []}}, - {'NonStandardParameter',{object,{0,3,84}},[]}, - [], - true, - [], - []}, - {'H323-UserInformation_user-data',24,"O"}}. + {'H323-UserInformation',{'H323-UU-PDU', + {callProceeding, + {'CallProceeding-UUIE', + {0,8,222}, + {'EndpointType', + {'NonStandardParameter', + {object,{0,9,237}}, + <<"O">>}, + {'VendorIdentifier', + {'H221NonStandard',62,63,16282}, + <<"OC">>, + <<"OC">>}, + {'GatekeeperInfo', + {'NonStandardParameter', + {object,{0,10,260}}, + <<"O">>}}, + {'GatewayInfo', + [{h320, + {'H320Caps', + {'NonStandardParameter', + {object,{0,11,282}}, + <<"O">>}, + [{'DataRate', + {'NonStandardParameter', + {object, + {0,11,295}}, + <<"O">>}, + 1290470518, + 78}], + [{'SupportedPrefix', + {'NonStandardParameter', + {object, + {0,12,312}}, + <<"O">>}, + {'h323-ID',"BM"}}]}}], + {'NonStandardParameter', + {object,{0,13,326}}, + <<"O">>}}, + {'McuInfo', + {'NonStandardParameter', + {object,{1,13,340,340}}, + <<"OC">>}}, + {'TerminalInfo', + {'NonStandardParameter', + {object,{1,14,353,354}}, + <<"OC">>}}, + true, + true}, + {ipxAddress, + {'TransportAddress_ipxAddress', + <<"OCTET ">>, + <<"OCTE">>, + <<"OC">>}}, + {'CallIdentifier',<<"OCTET STRINGOCTE">>}, + {noSecurity,'NULL'}, + [{'ClearToken', + 1667517741, + "BM", + {'DHset',<<1:1>>,<<1:1>>,<<1:1>>}, + <<"OCTET STR">>, + -26430296, + {'TypedCertificate', + {1,16,405,406}, + <<"OC">>}, + "BMP", + {'NonStandardParameter', + {1,16,414,415}, + <<"OC">>}}, + {'ClearToken', + 1817656756, + "BMP", + {'DHset',<<1:1>>,<<1:1>>,<<1:1>>}, + <<"OCTET STRI">>, + -16356110, + {'TypedCertificate', + {1,17,442,443}, + <<"OC">>}, + "BMP", + {'NonStandardParameter', + {1,18,452,452}, + <<"OC">>}}], + [{cryptoGKPwdEncr, + {'CryptoH323Token_cryptoGKPwdEncr', + {1,18,467,467}, + {'Params',-7477016,<<"OCTET ST">>}, + <<"OC">>}}, + {cryptoGKPwdEncr, + {'CryptoH323Token_cryptoGKPwdEncr', + {1,19,486,486}, + {'Params',-2404513,<<"OCTET ST">>}, + <<>>}}], + []}}, + {'NonStandardParameter',{object,{0,3,84}},<<>>}, + [], + true, + [], + []}, + {'H323-UserInformation_user-data',24,<<"O">>}}. -go(Config, _Enc) -> - ?line true = code:add_patha(?config(priv_dir,Config)), - +go() -> Module = 'H323-MESSAGES', Type = 'H323-UserInformation', Value = val(), - {ok,Bytes} = asn1rt:encode(Module,Type,Value), + Bytes = Module:encode(Type, Value), + Value = Module:decode(Type, Bytes), - CompileOptions = compile_options(), - {ValWr,done} = timer:tc(fun() -> encode(?times, Module, Type, Value) end), - ?line io:format("ASN1 encode ~p: ~p micro~n", [CompileOptions, ValWr / ?times]), + io:format("ASN.1 encoding: ~p micro~n", [ValWr / ?times]), done = decode(2, Module, Type, Bytes), {ValRead,done} = timer:tc(fun() -> decode(?times, Module, Type, Bytes) end), - ?line io:format("ASN1 decode ~p: ~p micro~n", [CompileOptions, ValRead /?times]), - + io:format("ASN.1 decoding: ~p micro~n", [ValRead /?times]), - ?line Comment = "encode: "++integer_to_list(round(ValWr/?times))++ - " micro, decode: "++integer_to_list(round(ValRead /?times))++ - " micro. " ++ CompileOptions, + Comment = "encode: "++integer_to_list(round(ValWr/?times)) ++ + " micro, decode: "++integer_to_list(round(ValRead /?times)) ++ + " micro. [" ++ atom_to_list(Module:encoding_rule()) ++ "]", {comment,Comment}. encode(0, _Module,_Type,_Value) -> done; encode(N, Module,Type,Value) -> - ?line {ok,B} = asn1rt:encode(Module,Type,Value), - _B2 = if - is_list(B) -> list_to_binary(B); - true -> B - end, - encode(N-1, Module,Type,Value). + Module:encode(Type, Value), + encode(N-1, Module, Type, Value). decode(0, _Module, _Type, _Value) -> done; decode(N, Module, Type, Value) -> - {ok,_B} = asn1rt:decode(Module, Type, Value), + Module:decode(Type, Value), decode(N-1, Module, Type, Value). - -compile_options() -> - {ok,Info} = asn1rt:info('H323-MESSAGES'), - case lists:keyfind(options, 1, Info) of - {_,Opts0} -> - Opts1 = [X || X <- Opts0, - (X =:= ber orelse - X =:= per orelse - X =:= uper)], - lists:flatten(io_lib:format("~p", [Opts1])); - _ -> - "[]" - end. - diff --git a/lib/asn1/test/testTypeValueNotation.erl b/lib/asn1/test/testTypeValueNotation.erl index b46d7177f5..2b5f3f74c1 100644 --- a/lib/asn1/test/testTypeValueNotation.erl +++ b/lib/asn1/test/testTypeValueNotation.erl @@ -24,7 +24,7 @@ -record('Seq', {octstr, int, bool, enum, bitstr, null, oid, vstr}). main(_Rule, _Option) -> - Value = #'Seq'{octstr = [1, 2, 3, 4], + Value = #'Seq'{octstr = <<1,2,3,4>>, int = 12, bool = true, enum = a, diff --git a/lib/common_test/src/ct_conn_log_h.erl b/lib/common_test/src/ct_conn_log_h.erl index ac08a3e0ad..d733df27dc 100644 --- a/lib/common_test/src/ct_conn_log_h.erl +++ b/lib/common_test/src/ct_conn_log_h.erl @@ -30,80 +30,88 @@ handle_event/2, handle_call/2, handle_info/2, terminate/2]). --record(state, {group_leader,logs=[]}). +-record(state, {logs=[], default_gl}). -define(WIDTH,80). %%%----------------------------------------------------------------- %%% Callbacks -init({GL,Logs}) -> - open_files(Logs,#state{group_leader=GL}). +init({GL,ConnLogs}) -> + open_files(GL,ConnLogs,#state{default_gl=GL}). -open_files([{ConnMod,{LogType,Logs}}|T],State) -> - case do_open_files(Logs,[]) of +open_files(GL,[{ConnMod,{LogType,LogFiles}}|T],State=#state{logs=Logs}) -> + case do_open_files(LogFiles,[]) of {ok,Fds} -> - open_files(T,State#state{logs=[{ConnMod,{LogType,Fds}} | - State#state.logs]}); + ConnInfo = proplists:get_value(GL,Logs,[]), + Logs1 = [{GL,[{ConnMod,{LogType,Fds}}|ConnInfo]} | + proplists:delete(GL,Logs)], + open_files(GL,T,State#state{logs=Logs1}); Error -> Error end; -open_files([],State) -> +open_files(_GL,[],State) -> {ok,State}. - -do_open_files([{Tag,File}|Logs],Acc) -> - case file:open(File, [write,{encoding,utf8}]) of +do_open_files([{Tag,File}|LogFiles],Acc) -> + case file:open(File, [write,append,{encoding,utf8}]) of {ok,Fd} -> - do_open_files(Logs,[{Tag,Fd}|Acc]); + do_open_files(LogFiles,[{Tag,Fd}|Acc]); {error,Reason} -> {error,{could_not_open_log,File,Reason}} end; do_open_files([],Acc) -> {ok,lists:reverse(Acc)}. +handle_event({info_report,_,{From,update,{GL,ConnLogs}}}, + State) when node(GL) == node() -> + Result = open_files(GL,ConnLogs,State), + From ! {updated,GL}, + Result; handle_event({_Type, GL, _Msg}, State) when node(GL) /= node() -> {ok, State}; -handle_event({_Type,_GL,{Pid,{ct_connection,Action,ConnName},Report}},State) -> - %% NOTE: if the format of this event is changed - %% ({ct_connection,Action,ConnName}) then remember to change - %% test_server_h:report_receiver as well!!! - Info = conn_info(Pid,#conn_log{name=ConnName,action=Action}), - write_report(now(),Info,Report,State), +handle_event({_Type,GL,{Pid,{ct_connection,Mod,Action,ConnName},Report}}, + State) -> + Info = conn_info(Pid,#conn_log{name=ConnName,action=Action,module=Mod}), + write_report(now(),Info,Report,GL,State), {ok, State}; -handle_event({_Type,_GL,{Pid,Info=#conn_log{},Report}},State) -> - %% NOTE: if the format of this event is changed - %% (Info=#conn_log{}) then remember to change - %% test_server_h:report_receiver as well!!! - write_report(now(),conn_info(Pid,Info),Report,State), +handle_event({_Type,GL,{Pid,Info=#conn_log{},Report}}, State) -> + write_report(now(),conn_info(Pid,Info),Report,GL,State), {ok, State}; -handle_event({error_report,_,{Pid,_,[{ct_connection,ConnName}|R]}},State) -> +handle_event({error_report,GL,{Pid,_,[{ct_connection,ConnName}|R]}}, State) -> %% Error reports from connection - write_error(now(),conn_info(Pid,#conn_log{name=ConnName}),R,State), + write_error(now(),conn_info(Pid,#conn_log{name=ConnName}),R,GL,State), {ok, State}; -handle_event(_, State) -> +handle_event(_What, State) -> {ok, State}. -handle_info(_, State) -> +handle_info(_What, State) -> {ok, State}. handle_call(_Query, State) -> {ok, {error, bad_query}, State}. terminate(_,#state{logs=Logs}) -> - [file:close(Fd) || {_,{_,Fds}} <- Logs, {_,Fd} <- Fds], + lists:foreach( + fun({_GL,ConnLogs}) -> + [file:close(Fd) || {_,{_,Fds}} <- ConnLogs, {_,Fd} <- Fds] + end, Logs), ok. %%%----------------------------------------------------------------- %%% Writing reports -write_report(Time,#conn_log{module=ConnMod}=Info,Data,State) -> - {LogType,Fd} = get_log(Info,State), +write_report(_Time,#conn_log{header=false,module=ConnMod}=Info,Data,GL,State) -> + {LogType,Fd} = get_log(Info,GL,State), + io:format(Fd,"~n~ts",[format_data(ConnMod,LogType,Data)]); + +write_report(Time,#conn_log{module=ConnMod}=Info,Data,GL,State) -> + {LogType,Fd} = get_log(Info,GL,State), io:format(Fd,"~n~ts~ts~ts",[format_head(ConnMod,LogType,Time), format_title(LogType,Info), format_data(ConnMod,LogType,Data)]). -write_error(Time,#conn_log{module=ConnMod}=Info,Report,State) -> - case get_log(Info,State) of +write_error(Time,#conn_log{module=ConnMod}=Info,Report,GL,State) -> + case get_log(Info,GL,State) of {html,_} -> %% The error will anyway be written in the html log by the %% sasl error handler, so don't write it again. @@ -115,14 +123,19 @@ write_error(Time,#conn_log{module=ConnMod}=Info,Report,State) -> format_error(LogType,Report)]) end. -get_log(Info,State) -> - case proplists:get_value(Info#conn_log.module,State#state.logs) of - {html,_} -> - {html,State#state.group_leader}; - {LogType,Fds} -> - {LogType,get_fd(Info,Fds)}; +get_log(Info,GL,State) -> + case proplists:get_value(GL,State#state.logs) of undefined -> - {html,State#state.group_leader} + {html,State#state.default_gl}; + ConnLogs -> + case proplists:get_value(Info#conn_log.module,ConnLogs) of + {html,_} -> + {html,GL}; + {LogType,Fds} -> + {LogType,get_fd(Info,Fds)}; + undefined -> + {html,GL} + end end. get_fd(#conn_log{name=undefined},Fds) -> @@ -191,17 +204,27 @@ pretty_head({{{Y,Mo,D},{H,Mi,S}},MicroS},ConnMod,Text0) -> micro2milli(MicroS)]). pretty_title(#conn_log{client=Client}=Info) -> - io_lib:format("= Client ~w ~s Server ~ts ", - [Client,actionstr(Info),serverstr(Info)]). + case actionstr(Info) of + {no_server,Action} -> + io_lib:format("= Client ~w ~s ",[Client,Action]); + Action -> + io_lib:format("= Client ~w ~s ~ts ",[Client,Action, + serverstr(Info)]) + end. actionstr(#conn_log{action=send}) -> "----->"; +actionstr(#conn_log{action=cmd}) -> "----->"; actionstr(#conn_log{action=recv}) -> "<-----"; actionstr(#conn_log{action=open}) -> "opened session to"; actionstr(#conn_log{action=close}) -> "closed session to"; actionstr(_) -> "<---->". +serverstr(#conn_log{name=undefined,address={undefined,_}}) -> + io_lib:format("server",[]); serverstr(#conn_log{name=undefined,address=Address}) -> io_lib:format("~p",[Address]); +serverstr(#conn_log{name=Alias,address={undefined,_}}) -> + io_lib:format("~w",[Alias]); serverstr(#conn_log{name=Alias,address=Address}) -> io_lib:format("~w(~p)",[Alias,Address]). diff --git a/lib/common_test/src/ct_framework.erl b/lib/common_test/src/ct_framework.erl index e81b69a1b5..54510a657a 100644 --- a/lib/common_test/src/ct_framework.erl +++ b/lib/common_test/src/ct_framework.erl @@ -730,9 +730,14 @@ end_tc(Mod,Func,TCPid,Result,Args,Return) -> (undefined) -> undefined; (Unexpected) -> - exit({error,{reset_curr_tc,{Mod,Func},Unexpected}}) + {error,{reset_curr_tc,{Mod,Func},Unexpected}} end, - ct_util:update_testdata(curr_tc, ClearCurrTC), + case ct_util:update_testdata(curr_tc, ClearCurrTC) of + {error,_} = ClearError -> + exit(ClearError); + _ -> + ok + end, case FinalResult of {auto_skip,{sequence_failed,_,_}} -> diff --git a/lib/common_test/src/ct_gen_conn.erl b/lib/common_test/src/ct_gen_conn.erl index a5b736136f..078d6b1a44 100644 --- a/lib/common_test/src/ct_gen_conn.erl +++ b/lib/common_test/src/ct_gen_conn.erl @@ -29,6 +29,13 @@ -export([start/4, stop/1, get_conn_pid/1]). -export([call/2, call/3, return/2, do_within_time/2]). +%%---------------------------------------------------------------------- +%% Exported types +%%---------------------------------------------------------------------- +-export_type([server_id/0, + target_name/0, + key_or_name/0]). + -ifdef(debug). -define(dbg,true). -else. @@ -47,6 +54,18 @@ cb_state, ct_util_server}). +%%------------------------------------------------------------------ +%% Type declarations +%%------------------------------------------------------------------ +-type server_id() :: atom(). +%% A `ServerId' which exists in a configuration file. +-type target_name() :: atom(). +%% A name which is associated to a `server_id()' via a +%% `require' statement or a call to {@link ct:require/2} in the +%% test suite. +-type key_or_name() :: server_id() | target_name(). + + %%%----------------------------------------------------------------- %%% @spec start(Address,InitData,CallbackMod,Opts) -> %%% {ok,Handle} | {error,Reason} diff --git a/lib/common_test/src/ct_netconfc.erl b/lib/common_test/src/ct_netconfc.erl index 64fe8b4bb0..35920ec1dc 100644 --- a/lib/common_test/src/ct_netconfc.erl +++ b/lib/common_test/src/ct_netconfc.erl @@ -212,11 +212,7 @@ %%---------------------------------------------------------------------- %% Exported types %%---------------------------------------------------------------------- --export_type([hook_options/0, - conn_mod/0, - log_type/0, - key_or_name/0, - notification/0]). +-export_type([notification/0]). %%---------------------------------------------------------------------- %% Internal exports @@ -292,19 +288,11 @@ %%---------------------------------------------------------------------- %% Type declarations %%---------------------------------------------------------------------- --type client() :: handle() | server_id() | target_name(). +-type client() :: handle() | ct_gen_conn:server_id() | ct_gen_conn:target_name(). -type handle() :: term(). %% An opaque reference for a connection (netconf session). See {@link %% ct} for more information. --type server_id() :: atom(). -%% A `ServerId' which exists in a configuration file. --type target_name() :: atom(). -%% A name which is associated to a `server_id()' via a -%% `require' statement or a call to {@link ct:require/2} in the -%% test suite. --type key_or_name() :: server_id() | target_name(). - -type options() :: [option()]. %% Options used for setting up ssh connection to a netconf server. @@ -326,14 +314,7 @@ %% See XML Schema for Event Notifications found in RFC5277 for further %% detail about the data format for the string values. --type hook_options() :: [hook_option()]. -%% Options that can be given to `cth_conn_log' in the `ct_hook' statement. --type hook_option() :: {log_type,log_type()} | - {hosts,[key_or_name()]}. --type log_type() :: raw | pretty | html | silent. %-type error_handler() :: module(). --type conn_mod() :: ct_netconfc. - -type error_reason() :: term(). -type simple_xml() :: {xml_tag(), xml_attributes(), xml_content()} | @@ -384,7 +365,7 @@ open(Options) -> %%---------------------------------------------------------------------- -spec open(KeyOrName, ExtraOptions) -> Result when - KeyOrName :: key_or_name(), + KeyOrName :: ct_gen_conn:key_or_name(), ExtraOptions :: options(), Result :: {ok,handle()} | {error,error_reason()}. %% @doc Open a named netconf session and exchange `hello' messages. @@ -461,7 +442,7 @@ only_open(Options) -> %%---------------------------------------------------------------------- -spec only_open(KeyOrName,ExtraOptions) -> Result when - KeyOrName :: key_or_name(), + KeyOrName :: ct_gen_conn:key_or_name(), ExtraOptions :: options(), Result :: {ok,handle()} | {error,error_reason()}. %% @doc Open a name netconf session, but don't send `hello'. diff --git a/lib/common_test/src/ct_telnet.erl b/lib/common_test/src/ct_telnet.erl index 4092d33bc0..b4d82a53cf 100644 --- a/lib/common_test/src/ct_telnet.erl +++ b/lib/common_test/src/ct_telnet.erl @@ -17,51 +17,147 @@ %% %CopyrightEnd% %% -%%% @doc Common Test specific layer on top of telnet client ct_telnet_client.erl -%%% -%%% <p>Use this module to set up telnet connections, send commands and -%%% perform string matching on the result. -%%% See the <c>unix_telnet</c> manual page for information about how to use -%%% ct_telnet, and configure connections, specifically for unix hosts.</p> -%%% <p>The following default values are defined in ct_telnet:</p> -%%% <pre> -%%% Connection timeout = 10 sec (time to wait for connection) -%%% Command timeout = 10 sec (time to wait for a command to return) -%%% Max no of reconnection attempts = 3 -%%% Reconnection interval = 5 sek (time to wait in between reconnection attempts) -%%% Keep alive = true (will send NOP to the server every 10 sec if connection is idle)</pre> -%%% <p>These parameters can be altered by the user with the following -%%% configuration term:</p> -%%% <pre> -%%% {telnet_settings, [{connect_timeout,Millisec}, -%%% {command_timeout,Millisec}, -%%% {reconnection_attempts,N}, -%%% {reconnection_interval,Millisec}, -%%% {keep_alive,Bool}]}.</pre> -%%% <p><code>Millisec = integer(), N = integer()</code></p> -%%% <p>Enter the <code>telnet_settings</code> term in a configuration -%%% file included in the test and ct_telnet will retrieve the information -%%% automatically. Note that <c>keep_alive</c> may be specified per connection if -%%% required. See <c>unix_telnet</c> for details.</p></doc> - -%%% @type connection_type() = telnet | ts1 | ts2 - -%%% @type connection() = handle() | -%%% {ct:target_name(),connection_type()} | ct:target_name() - -%%% @type handle() = ct_gen_conn:handle(). Handle for a -%%% specific telnet connection. - -%%% @type prompt_regexp() = string(). A regular expression which -%%% matches all possible prompts for a specific type of target. The -%%% regexp must not have any groups i.e. when matching, re:run/3 shall -%%% return a list with one single element. -%%% -%%% @see unix_telnet +%% @doc Common Test specific layer on top of telnet client `ct_telnet_client.erl' +%% +%% <p>Use this module to set up telnet connections, send commands and +%% perform string matching on the result. +%% See the `unix_telnet' manual page for information about how to use +%% `ct_telnet', and configure connections, specifically for unix hosts.</p> +%% <p>The following default values are defined in `ct_telnet':</p> +%% <pre> +%% Connection timeout = 10 sec (time to wait for connection) +%% Command timeout = 10 sec (time to wait for a command to return) +%% Max no of reconnection attempts = 3 +%% Reconnection interval = 5 sek (time to wait in between reconnection attempts) +%% Keep alive = true (will send NOP to the server every 10 sec if connection is idle)</pre> +%% <p>These parameters can be altered by the user with the following +%% configuration term:</p> +%% <pre> +%% {telnet_settings, [{connect_timeout,Millisec}, +%% {command_timeout,Millisec}, +%% {reconnection_attempts,N}, +%% {reconnection_interval,Millisec}, +%% {keep_alive,Bool}]}.</pre> +%% <p><code>Millisec = integer(), N = integer()</code></p> +%% <p>Enter the <code>telnet_settings</code> term in a configuration +%% file included in the test and ct_telnet will retrieve the information +%% automatically. Note that `keep_alive' may be specified per connection if +%% required. See `unix_telnet' for details.</p> +%% +%% == Logging == +%% +%% `ct_telnet' can be configured to uses the `error_logger' for logging telnet +%% traffic. A special purpose error handler is implemented in +%% `ct_conn_log_h'. To use this error handler, add the `cth_conn_log' +%% hook in your test suite, e.g: +%% +%% +%% ``` +%% suite() -> +%% [{ct_hooks, [{cth_conn_log, [{conn_mod(),hook_options()}]}]}]. +%%''' +%% +%% `conn_mod()' is the name of the common_test module implementing +%% the connection protocol, i.e. `ct_telnet'. +%% +%% The hook option `log_type' specifies the type of logging: +%% +%% <dl> +%% <dt>`raw'</dt> +%% <dd>The sent and received telnet data is logged to a separate +%% text file as is, without any formatting. A link to the file is +%% added to the test case HTML log.</dd> +%% +%% <dt>`html (default)'</dt> +%% <dd>The sent and received telnet traffic is pretty printed +%% directly in the test case HTML log.</dd> +%% +%% <dt>`silent'</dt> +%% <dd>Telnet traffic is not logged.</dd> +%% </dl> +%% +%% By default, all telnet traffic is logged in one single log +%% file. However, it is possible to have different connections logged +%% in separate files. To do this, use the hook option `hosts' and +%% list the names of the servers/connections that will be used in the +%% suite. Note that the connections must be named for this to work +%% (see the `open' function below). +%% +%% The `hosts' option has no effect if `log_type' is set to `html' or +%% `silent'. +%% +%% The hook options can also be specified in a configuration file with +%% the configuration variable `ct_conn_log': +%% +%% ``` +%% {ct_conn_log,[{conn_mod(),hook_options()}]}. +%% ''' +%% +%% For example: +%% +%% ``` +%% {ct_conn_log,[{ct_telnet,[{log_type,raw}, +%% {hosts,[key_or_name()]}]}]} +%% ''' +%% +%% <b>Note</b> that hook options specified in a configuration file +%% will overwrite any hardcoded hook options in the test suite. +%% +%% === Logging example 1 === +%% +%% The following `ct_hooks' statement will cause raw printing of +%% telnet traffic to separate logs for the connections named +%% `server1' and `server2'. Any other connections will be logged +%% to default telnet log. +%% +%% ``` +%% suite() -> +%% [{ct_hooks, [{cth_conn_log, [{ct_telnet,[{log_type,raw}}, +%% {hosts,[server1,server2]}]} +%% ]}]}]. +%%''' +%% +%% === Logging example 2 === +%% +%% The following configuration file will cause raw logging of all +%% telnet traffic into one single text file. +%% +%% ``` +%% {ct_conn_log,[{ct_telnet,[{log_type,raw}]}]}. +%% ''' +%% +%% The `ct_hooks' statement must look like this: +%% +%% ``` +%% suite() -> +%% [{ct_hooks, [{cth_conn_log, []}]}]. +%% ''' +%% +%% The same `ct_hooks' statement without the configuration file would +%% cause HTML logging of all telnet connections into the test case +%% HTML log. +%% +%% <b>Note</b> that if the `cth_conn_log' hook is not added, telnet +%% traffic is still logged in the test case HTML log file (on the legacy +%% `ct_telnet' format). +%% @end --module(ct_telnet). +%% @type connection_type() = telnet | ts1 | ts2 + +%% @type connection() = handle() | +%% {ct:target_name(),connection_type()} | ct:target_name() --compile(export_all). +%% @type handle() = ct_gen_conn:handle(). Handle for a +%% specific telnet connection. + +%% @type prompt_regexp() = string(). A regular expression which +%% matches all possible prompts for a specific type of target. The +%% regexp must not have any groups i.e. when matching, re:run/3 shall +%% return a list with one single element. +%% +%% @see unix_telnet + +-module(ct_telnet). -export([open/1, open/2, open/3, open/4, close/1]). -export([cmd/2, cmd/3, cmdf/3, cmdf/4, get_data/1, @@ -71,10 +167,9 @@ -export([init/3,handle_msg/2,reconnect/2,terminate/2]). %% Tool internals --export([silent_teln_expect/5, teln_receive_until_prompt/3, - start_log/1, log/3, cont_log/2, end_log/0, - try_start_log/1, try_log/3, try_cont_log/2, try_end_log/0]). - +-export([silent_teln_expect/6, teln_receive_until_prompt/3, + format_data/2]). +-export([start_gen_log/1, end_gen_log/0, log/3, log/4]). -define(RECONNS,3). -define(RECONN_TIMEOUT,5000). @@ -83,12 +178,14 @@ -include("ct_util.hrl"). --record(state,{teln_pid, +-record(state,{host, + port, + teln_pid, prx, - type, buffer=[], prompt=false, name, + type, target_mod, keep_alive, extra, @@ -160,8 +257,7 @@ open(KeyOrName,ConnType,TargetMod) -> open(KeyOrName,ConnType,TargetMod,Extra) -> case ct:get_config({KeyOrName,ConnType}) of undefined -> - log(heading(open,{KeyOrName,ConnType}),"Failed: ~p", - [{not_available,KeyOrName}]), + log(undefined,open,"Failed: ~p",[{not_available,KeyOrName}]), {error,{not_available,KeyOrName,ConnType}}; Addr -> Addr1 = @@ -183,8 +279,8 @@ open(KeyOrName,ConnType,TargetMod,Extra) -> end; Bool -> Bool end, - log(heading(open,{KeyOrName,ConnType}), - "Opening connection to: ~p",[Addr1]), + log(undefined,open,"Connecting to ~p(~p)", + [KeyOrName,Addr1]), ct_gen_conn:start(KeyOrName,full_addr(Addr1,ConnType), {TargetMod,KeepAlive,Extra},?MODULE) end. @@ -202,7 +298,7 @@ open(KeyOrName,ConnType,TargetMod,Extra) -> close(Connection) -> case get_handle(Connection) of {ok,Pid} -> - log("ct_telnet:close","Handle: ~w",[Pid]), + log(undefined,close,"Connection closed, handle: ~w",[Pid]), case ct_gen_conn:stop(Pid) of {error,{process_down,Pid,noproc}} -> {error,already_closed}; @@ -408,9 +504,20 @@ init(Name,{Ip,Port,Type},{TargetMod,KeepAlive,Extra}) -> Settings -> set_telnet_defaults(Settings,#state{}) end, - case catch TargetMod:connect(Ip,Port,S0#state.conn_to,KeepAlive,Extra) of + case catch TargetMod:connect(Name,Ip,Port,S0#state.conn_to, + KeepAlive,Extra) of {ok,TelnPid} -> - log(heading(init,{Name,Type}), + put({ct_telnet_pid2name,TelnPid},Name), + S1 = S0#state{host=Ip, + port=Port, + teln_pid=TelnPid, + name=Name, + type=type(Type), + target_mod=TargetMod, + keep_alive=KeepAlive, + extra=Extra, + prx=TargetMod:get_prompt_regexp()}, + log(S1,open, "Opened telnet connection\n" "IP: ~p\n" "Port: ~p\n" @@ -419,15 +526,9 @@ init(Name,{Ip,Port,Type},{TargetMod,KeepAlive,Extra}) -> "Reconnection interval: ~p\n" "Connection timeout: ~p\n" "Keep alive: ~w", - [Ip,Port,S0#state.com_to,S0#state.reconns, - S0#state.reconn_int,S0#state.conn_to,KeepAlive]), - {ok,TelnPid,S0#state{teln_pid=TelnPid, - type=type(Type), - name={Name,Type}, - target_mod=TargetMod, - keep_alive=KeepAlive, - extra=Extra, - prx=TargetMod:get_prompt_regexp()}}; + [Ip,Port,S1#state.com_to,S1#state.reconns, + S1#state.reconn_int,S1#state.conn_to,KeepAlive]), + {ok,TelnPid,S1}; {'EXIT',Reason} -> {error,Reason}; Error -> @@ -448,27 +549,31 @@ set_telnet_defaults([{reconnection_interval,RInt}|Ss],S) -> set_telnet_defaults([{keep_alive,_}|Ss],S) -> set_telnet_defaults(Ss,S); set_telnet_defaults([Unknown|Ss],S) -> - log(heading(set_telnet_defaults,{telnet_settings,Unknown}), - "Bad element in telnet_settings: ~p",[Unknown]), + force_log(S,error, + "Bad element in telnet_settings: ~p",[Unknown]), set_telnet_defaults(Ss,S); set_telnet_defaults([],S) -> S. %% @hidden handle_msg({cmd,Cmd,Timeout},State) -> - try_start_log(heading(cmd,State#state.name)), - try_cont_log("Cmd: ~p", [Cmd]), - debug_cont_log("Throwing Buffer:",[]), + start_gen_log(heading(cmd,State#state.name)), + log(State,cmd,"Cmd: ~p",[Cmd]), + + debug_cont_gen_log("Throwing Buffer:",[]), debug_log_lines(State#state.buffer), + case {State#state.type,State#state.prompt} of {ts,_} -> - silent_teln_expect(State#state.teln_pid, + silent_teln_expect(State#state.name, + State#state.teln_pid, State#state.buffer, prompt, State#state.prx, [{timeout,2000}]); {ip,false} -> - silent_teln_expect(State#state.teln_pid, + silent_teln_expect(State#state.name, + State#state.teln_pid, State#state.buffer, prompt, State#state.prx, @@ -482,29 +587,36 @@ handle_msg({cmd,Cmd,Timeout},State) -> {Return,NewBuffer,Prompt} = case teln_cmd(State#state.teln_pid, Cmd, State#state.prx, TO) of {ok,Data,_PromptType,Rest} -> - try_cont_log("Return: ~p", [{ok,Data}]), + log(State,recv,"Return: ~p",[{ok,Data}]), {{ok,Data},Rest,true}; Error -> - Retry = {retry,{Error,State#state.name,State#state.teln_pid, + Retry = {retry,{Error, + {State#state.name, + State#state.type}, + State#state.teln_pid, {cmd,Cmd,TO}}}, - try_cont_log("Return: ~p", [Error]), + log(State,recv,"Return: ~p",[Error]), {Retry,[],false} end, - try_end_log(), + end_gen_log(), {Return,State#state{buffer=NewBuffer,prompt=Prompt}}; handle_msg({send,Cmd},State) -> - try_log(heading(send,State#state.name),"Cmd: ~p",[Cmd]), - debug_cont_log("Throwing Buffer:",[]), + log(State,send,"Cmd: ~p",[Cmd]), + + debug_cont_gen_log("Throwing Buffer:",[]), debug_log_lines(State#state.buffer), + case {State#state.type,State#state.prompt} of {ts,_} -> - silent_teln_expect(State#state.teln_pid, + silent_teln_expect(State#state.name, + State#state.teln_pid, State#state.buffer, prompt, State#state.prx, [{timeout,2000}]); {ip,false} -> - silent_teln_expect(State#state.teln_pid, + silent_teln_expect(State#state.name, + State#state.teln_pid, State#state.buffer, prompt, State#state.prx, @@ -515,19 +627,21 @@ handle_msg({send,Cmd},State) -> ct_telnet_client:send_data(State#state.teln_pid,Cmd), {ok,State#state{buffer=[],prompt=false}}; handle_msg(get_data,State) -> - try_start_log(heading(get_data,State#state.name)), + start_gen_log(heading(get_data,State#state.name)), + log(State,cmd,"Reading data...",[]), {ok,Data,Buffer} = teln_get_all_data(State#state.teln_pid, State#state.prx, State#state.buffer, [],[]), - try_cont_log("Return: ~p",[{ok,Data}]), - try_end_log(), + log(State,recv,"Return: ~p",[{ok,Data}]), + end_gen_log(), {{ok,Data},State#state{buffer=Buffer}}; handle_msg({expect,Pattern,Opts},State) -> - try_start_log(heading(expect,State#state.name)), - try_cont_log("Expect: ~p\nOpts=~p\n",[Pattern,Opts]), + start_gen_log(heading(expect,State#state.name)), + log(State,expect,"Expect: ~p\nOpts = ~p\n",[Pattern,Opts]), {Return,NewBuffer,Prompt} = - case teln_expect(State#state.teln_pid, + case teln_expect(State#state.name, + State#state.teln_pid, State#state.buffer, Pattern, State#state.prx, @@ -536,22 +650,23 @@ handle_msg({expect,Pattern,Opts},State) -> P = check_if_prompt_was_reached(Data,[]), {{ok,Data},Rest,P}; {ok,Data,HaltReason,Rest} -> - force_cont_log("HaltReason: ~p", - [HaltReason]), + force_log(State,expect,"HaltReason: ~p",[HaltReason]), P = check_if_prompt_was_reached(Data,HaltReason), {{ok,Data,HaltReason},Rest,P}; {error,Reason,Rest} -> - force_cont_log("Expect failed\n~p",[{error,Reason}]), + force_log(State,expect,"Expect failed\n~p",[{error,Reason}]), P = check_if_prompt_was_reached([],Reason), {{error,Reason},Rest,P}; {error,Reason} -> - force_cont_log("Expect failed\n~p",[{error,Reason}]), + force_log(State,expect,"Expect failed\n~p",[{error,Reason}]), P = check_if_prompt_was_reached([],Reason), {{error,Reason},[],P} end, - try_end_log(), + end_gen_log(), Return1 = case Return of - {error,_} -> {retry,{Return,State#state.name, + {error,_} -> {retry,{Return, + {State#state.name, + State#state.type}, State#state.teln_pid, {expect,Pattern,Opts}}}; _ -> Return @@ -562,18 +677,20 @@ handle_msg({expect,Pattern,Opts},State) -> %% @hidden reconnect({Ip,Port,_Type},State) -> reconnect(Ip,Port,State#state.reconns,State). -reconnect(Ip,Port,N,State=#state{target_mod=TargetMod, +reconnect(Ip,Port,N,State=#state{name=Name, + target_mod=TargetMod, keep_alive=KeepAlive, extra=Extra, conn_to=ConnTo, reconn_int=ReconnInt}) -> - case TargetMod:connect(Ip,Port,ConnTo,KeepAlive,Extra) of - {ok, NewPid} -> + case TargetMod:connect(Name,Ip,Port,ConnTo,KeepAlive,Extra) of + {ok,NewPid} -> + put({ct_telnet_pid2name,NewPid},Name), {ok, NewPid, State#state{teln_pid=NewPid}}; Error when N==0 -> Error; _Error -> - log("Reconnect failed!","Retries left: ~w",[N]), + log(State,reconnect,"Reconnect failed!","Retries left: ~w",[N]), timer:sleep(ReconnInt), reconnect(Ip,Port,N-1,State) end. @@ -581,11 +698,9 @@ reconnect(Ip,Port,N,State=#state{target_mod=TargetMod, %% @hidden terminate(TelnPid,State) -> - log(heading(terminate,State#state.name), - "Closing telnet connection.\nId: ~w", - [TelnPid]), - ct_telnet_client:close(TelnPid). - + Result = ct_telnet_client:close(TelnPid), + log(State,close,"Telnet connection for ~w closed.",[TelnPid]), + Result. %%%================================================================= %%% Internal function @@ -637,79 +752,109 @@ check_if_prompt_was_reached(Data,_) when is_list(Data) -> check_if_prompt_was_reached(_,_) -> false. -%tc(Fun) -> -% Before = erlang:now(), -% Val = Fun(), -% After = erlang:now(), -% {now_diff(After, Before), Val}. -%now_diff({A2, B2, C2}, {A1, B1, C1}) -> -% ((A2-A1)*1000000 + B2-B1)*1000000 + C2-C1. - -heading(Function,Name) -> - io_lib:format("~w:~w ~p",[?MODULE,Function,Name]). - -%%% @hidden -%% Functions for regular (unconditional) logging, to be -%% used during connect, reconnect, disconnect etc. -log(Heading,Str,Args) -> - ct_gen_conn:log(Heading,Str,Args). -%%% @hidden -start_log(Heading) -> - ct_gen_conn:start_log(Heading). -cont_log(Str,Args) -> - ct_gen_conn:cont_log(Str,Args). -end_log() -> - ct_gen_conn:end_log(). - -%%% @hidden -%% Functions for conditional logging, to be used by -%% cmd, send, receive, expect etc (this output may be -%% silenced by user). -try_start_log(Heading) -> - do_try_log(start_log,[Heading]). -%%% @hidden -try_end_log() -> - do_try_log(end_log,[]). - -%%% @hidden -try_log(Heading,Str,Args) -> - do_try_log(log,[Heading,Str,Args]). - -%%% @hidden -try_cont_log(Str,Args) -> - do_try_log(cont_log,[Str,Args]). - %%% @hidden -do_try_log(Func,Args) -> - %% check if output is suppressed - case ct_util:is_silenced(telnet) of - true -> +%% Functions for logging ct_telnet reports and telnet data + +heading(Action,undefined) -> + io_lib:format("~w ~w",[?MODULE,Action]); +heading(Action,Name) -> + io_lib:format("~w ~w for ~p",[?MODULE,Action,Name]). + +force_log(State,Action,String,Args) -> + log(State,Action,String,Args,true). + +log(State,Action,String,Args) when is_record(State, state) -> + log(State,Action,String,Args,false); +log(Name,Action,String,Args) when is_atom(Name) -> + log(#state{name=Name},Action,String,Args,false); +log(TelnPid,Action,String,Args) when is_pid(TelnPid) -> + log(#state{teln_pid=TelnPid},Action,String,Args,false). + +log(undefined,String,Args) -> + log(#state{},undefined,String,Args,false); +log(Name,String,Args) when is_atom(Name) -> + log(#state{name=Name},undefined,String,Args,false); +log(TelnPid,String,Args) when is_pid(TelnPid) -> + log(#state{teln_pid=TelnPid},undefined,String,Args). + +log(#state{name=Name,teln_pid=TelnPid,host=Host,port=Port}, + Action,String,Args,ForcePrint) -> + Name1 = if Name == undefined -> get({ct_telnet_pid2name,TelnPid}); + true -> Name + end, + Silent = get(silent), + case ct_util:get_testdata({cth_conn_log,?MODULE}) of + Result when Result /= undefined, Result /= silent, Silent /= true -> + {PrintHeader,PreBR} = if Action==undefined -> + {false,""}; + true -> + {true,"\n"} + end, + error_logger:info_report(#conn_log{header=PrintHeader, + client=self(), + conn_pid=TelnPid, + address={Host,Port}, + name=Name1, + action=Action, + module=?MODULE}, + {PreBR++String,Args}); + Result when Result /= undefined -> ok; - false -> - apply(ct_gen_conn,Func,Args) + _ when Action == open; Action == close; Action == reconnect; + Action == info; Action == error -> + ct_gen_conn:log(heading(Action,Name1),String,Args); + _ when ForcePrint == false -> + case ct_util:is_silenced(telnet) of + true -> + ok; + false -> + ct_gen_conn:cont_log(String,Args) + end; + _ when ForcePrint == true -> + case ct_util:is_silenced(telnet) of + true -> + %% call log/3 now instead of cont_log/2 since + %% start_gen_log/1 will not have been previously called + ct_gen_conn:log(heading(Action,Name1),String,Args); + false -> + ct_gen_conn:cont_log(String,Args) + end end. -%%% @hidden -%% Functions that will force printout even if ct_telnet -%% output has been silenced, to be used for error printouts. -force_cont_log(Str,Args) -> - case ct_util:is_silenced(telnet) of - true -> - %% call log/3 now instead of cont_log/2 since - %% start_log/1 will not have been previously called - log("ct_telnet info",Str,Args); - false -> - cont_log(Str,Args) +start_gen_log(Heading) -> + case ct_util:get_testdata({cth_conn_log,?MODULE}) of + undefined -> + %% check if output is suppressed + case ct_util:is_silenced(telnet) of + true -> ok; + false -> ct_gen_conn:start_log(Heading) + end; + _ -> + ok + end. + +end_gen_log() -> + case ct_util:get_testdata({cth_conn_log,?MODULE}) of + undefined -> + %% check if output is suppressed + case ct_util:is_silenced(telnet) of + true -> ok; + false -> ct_gen_conn:end_log() + end; + _ -> + ok end. %%% @hidden %% Debug printouts. -debug_cont_log(Str,Args) -> +debug_cont_gen_log(Str,Args) -> Old = put(silent,true), - cont_log(Str,Args), + ct_gen_conn:cont_log(Str,Args), put(silent,Old). - +%% Log callback - called from the error handler process +format_data(_How,{String,Args}) -> + io_lib:format(String,Args). %%%================================================================= %%% Abstraction layer on top of ct_telnet_client.erl @@ -717,7 +862,6 @@ teln_cmd(Pid,Cmd,Prx,Timeout) -> ct_telnet_client:send_data(Pid,Cmd), teln_receive_until_prompt(Pid,Prx,Timeout). - teln_get_all_data(Pid,Prx,Data,Acc,LastLine) -> case check_for_prompt(Prx,lists:reverse(LastLine) ++ Data) of {prompt,Lines,_PromptType,Rest} -> @@ -746,11 +890,9 @@ teln_get_all_data(Pid,Prx,Data,Acc,LastLine) -> %% @doc Externally the silent_teln_expect function shall only be used %% by the TargetModule, i.e. the target specific module which %% implements connect/2 and get_prompt_regexp/0. -silent_teln_expect(Pid,Data,Pattern,Prx,Opts) -> +silent_teln_expect(Name,Pid,Data,Pattern,Prx,Opts) -> Old = put(silent,true), - try_cont_log("silent_teln_expect/5, Pattern = ~p",[Pattern]), - Result = teln_expect(Pid,Data,Pattern,Prx,Opts), - try_cont_log("silent_teln_expect -> ~p\n",[Result]), + Result = teln_expect(Name,Pid,Data,Pattern,Prx,Opts), put(silent,Old), Result. @@ -766,7 +908,7 @@ silent_teln_expect(Pid,Data,Pattern,Prx,Opts) -> %% condition is fullfilled. %% 3b) Repeat (sequence): 2) is repeated either N times or until a %% halt condition is fullfilled. -teln_expect(Pid,Data,Pattern0,Prx,Opts) -> +teln_expect(Name,Pid,Data,Pattern0,Prx,Opts) -> HaltPatterns = case get_ignore_prompt(Opts) of true -> @@ -790,7 +932,7 @@ teln_expect(Pid,Data,Pattern0,Prx,Opts) -> case get_repeat(Opts) of false -> - case teln_expect1(Data,Pattern,[],EO) of + case teln_expect1(Name,Pid,Data,Pattern,[],EO) of {ok,Matched,Rest} -> {ok,Matched,Rest}; {halt,Why,Rest} -> @@ -800,7 +942,7 @@ teln_expect(Pid,Data,Pattern0,Prx,Opts) -> end; N -> EO1 = EO#eo{repeat=N}, - repeat_expect(Data,Pattern,[],EO1) + repeat_expect(Name,Pid,Data,Pattern,[],EO1) end. convert_pattern(Pattern,Seq) @@ -855,23 +997,27 @@ get_prompt_check(Opts) -> %% Repeat either single or sequence. All match results are accumulated %% and returned when a halt condition is fulllfilled. -repeat_expect(Rest,_Pattern,Acc,#eo{repeat=0}) -> +repeat_expect(_Name,_Pid,Rest,_Pattern,Acc,#eo{repeat=0}) -> {ok,lists:reverse(Acc),done,Rest}; -repeat_expect(Data,Pattern,Acc,EO) -> - case teln_expect1(Data,Pattern,[],EO) of +repeat_expect(Name,Pid,Data,Pattern,Acc,EO) -> + case teln_expect1(Name,Pid,Data,Pattern,[],EO) of {ok,Matched,Rest} -> EO1 = EO#eo{repeat=EO#eo.repeat-1}, - repeat_expect(Rest,Pattern,[Matched|Acc],EO1); + repeat_expect(Name,Pid,Rest,Pattern,[Matched|Acc],EO1); {halt,Why,Rest} -> {ok,lists:reverse(Acc),Why,Rest}; {error,Reason} -> {error,Reason} end. -teln_expect1(Data,Pattern,Acc,EO) -> +teln_expect1(Name,Pid,Data,Pattern,Acc,EO) -> ExpectFun = case EO#eo.seq of - true -> fun() -> seq_expect(Data,Pattern,Acc,EO) end; - false -> fun() -> one_expect(Data,Pattern,EO) end + true -> fun() -> + seq_expect(Name,Pid,Data,Pattern,Acc,EO) + end; + false -> fun() -> + one_expect(Name,Pid,Data,Pattern,EO) + end end, case ExpectFun() of {match,Match,Rest} -> @@ -890,10 +1036,10 @@ teln_expect1(Data,Pattern,Acc,EO) -> case NotFinished of {nomatch,Rest} -> %% One expect - teln_expect1(Rest++Data1,Pattern,[],EO); + teln_expect1(Name,Pid,Rest++Data1,Pattern,[],EO); {continue,Patterns1,Acc1,Rest} -> %% Sequence - teln_expect1(Rest++Data1,Patterns1,Acc1,EO) + teln_expect1(Name,Pid,Rest++Data1,Patterns1,Acc1,EO) end end end. @@ -913,47 +1059,45 @@ get_data1(Pid) -> %% lines and each line is matched against each pattern. %% one_expect: split data chunk at prompts -one_expect(Data,Pattern,EO) when EO#eo.prompt_check==false -> +one_expect(Name,Pid,Data,Pattern,EO) when EO#eo.prompt_check==false -> % io:format("Raw Data ~p Pattern ~p EO ~p ",[Data,Pattern,EO]), - one_expect1(Data,Pattern,[],EO#eo{found_prompt=false}); -one_expect(Data,Pattern,EO) -> + one_expect1(Name,Pid,Data,Pattern,[],EO#eo{found_prompt=false}); +one_expect(Name,Pid,Data,Pattern,EO) -> case match_prompt(Data,EO#eo.prx) of {prompt,UptoPrompt,PromptType,Rest} -> case Pattern of [Prompt] when Prompt==prompt; Prompt=={prompt,PromptType} -> %% Only searching for prompt - log_lines(UptoPrompt), - try_cont_log("<b>PROMPT:</b> ~ts", [PromptType]), + log_lines(Name,Pid,UptoPrompt), + log(name_or_pid(Name,Pid),"PROMPT: ~ts",[PromptType]), {match,{prompt,PromptType},Rest}; [{prompt,_OtherPromptType}] -> %% Only searching for one specific prompt, not thisone - log_lines(UptoPrompt), + log_lines(Name,Pid,UptoPrompt), {nomatch,Rest}; _ -> - one_expect1(UptoPrompt,Pattern,Rest, + one_expect1(Name,Pid,UptoPrompt,Pattern,Rest, EO#eo{found_prompt=PromptType}) end; noprompt -> case Pattern of [Prompt] when Prompt==prompt; element(1,Prompt)==prompt -> %% Only searching for prompt - LastLine = log_lines_not_last(Data), + LastLine = log_lines_not_last(Name,Pid,Data), {nomatch,LastLine}; _ -> - one_expect1(Data,Pattern,[],EO#eo{found_prompt=false}) + one_expect1(Name,Pid,Data,Pattern,[], + EO#eo{found_prompt=false}) end end. -remove_zero(List) -> - [Ch || Ch <- List, Ch=/=0, Ch=/=13]. - %% one_expect1: split data chunk at lines -one_expect1(Data,Pattern,Rest,EO) -> - case match_lines(Data,Pattern,EO) of +one_expect1(Name,Pid,Data,Pattern,Rest,EO) -> + case match_lines(Name,Pid,Data,Pattern,EO) of {match,Match,MatchRest} -> {match,Match,MatchRest++Rest}; {nomatch,prompt} -> - one_expect(Rest,Pattern,EO); + one_expect(Name,Pid,Rest,Pattern,EO); {nomatch,NoMatchRest} -> {nomatch,NoMatchRest++Rest}; {halt,Why,HaltRest} -> @@ -970,77 +1114,77 @@ one_expect1(Data,Pattern,Rest,EO) -> %% searching for the next pattern in the list. %% seq_expect: Split data chunk at prompts -seq_expect(Data,[],Acc,_EO) -> +seq_expect(_Name,_Pid,Data,[],Acc,_EO) -> {match,lists:reverse(Acc),Data}; -seq_expect([],Patterns,Acc,_EO) -> +seq_expect(_Name,_Pid,[],Patterns,Acc,_EO) -> {continue,Patterns,lists:reverse(Acc),[]}; -seq_expect(Data,Patterns,Acc,EO) when EO#eo.prompt_check==false -> - seq_expect1(Data,Patterns,Acc,[],EO#eo{found_prompt=false}); -seq_expect(Data,Patterns,Acc,EO) -> +seq_expect(Name,Pid,Data,Patterns,Acc,EO) when EO#eo.prompt_check==false -> + seq_expect1(Name,Pid,Data,Patterns,Acc,[],EO#eo{found_prompt=false}); +seq_expect(Name,Pid,Data,Patterns,Acc,EO) -> case match_prompt(Data,EO#eo.prx) of {prompt,UptoPrompt,PromptType,Rest} -> - seq_expect1(UptoPrompt,Patterns,Acc,Rest, + seq_expect1(Name,Pid,UptoPrompt,Patterns,Acc,Rest, EO#eo{found_prompt=PromptType}); noprompt -> - seq_expect1(Data,Patterns,Acc,[],EO#eo{found_prompt=false}) + seq_expect1(Name,Pid,Data,Patterns,Acc,[],EO#eo{found_prompt=false}) end. %% seq_expect1: For one prompt-chunk, match each pattern - line by %% line if it is other than the prompt we are seaching for. -seq_expect1(Data,[prompt|Patterns],Acc,Rest,EO) -> +seq_expect1(Name,Pid,Data,[prompt|Patterns],Acc,Rest,EO) -> case EO#eo.found_prompt of false -> - LastLine = log_lines_not_last(Data), + LastLine = log_lines_not_last(Name,Pid,Data), %% Rest==[] because no prompt is found {continue,[prompt|Patterns],Acc,LastLine}; PromptType -> - log_lines(Data), - try_cont_log("<b>PROMPT:</b> ~ts", [PromptType]), - seq_expect(Rest,Patterns,[{prompt,PromptType}|Acc],EO) + log_lines(Name,Pid,Data), + log(name_or_pid(Name,Pid),"PROMPT: ~ts",[PromptType]), + seq_expect(Name,Pid,Rest,Patterns,[{prompt,PromptType}|Acc],EO) end; -seq_expect1(Data,[{prompt,PromptType}|Patterns],Acc,Rest,EO) -> +seq_expect1(Name,Pid,Data,[{prompt,PromptType}|Patterns],Acc,Rest,EO) -> case EO#eo.found_prompt of false -> - LastLine = log_lines_not_last(Data), + LastLine = log_lines_not_last(Name,Pid,Data), %% Rest==[] because no prompt is found {continue,[{prompt,PromptType}|Patterns],Acc,LastLine}; PromptType -> - log_lines(Data), - try_cont_log("<b>PROMPT:</b> ~ts", [PromptType]), - seq_expect(Rest,Patterns,[{prompt,PromptType}|Acc],EO); + log_lines(Name,Pid,Data), + log(name_or_pid(Name,Pid),"PROMPT: ~ts", [PromptType]), + seq_expect(Name,Pid,Rest,Patterns,[{prompt,PromptType}|Acc],EO); _OtherPromptType -> - log_lines(Data), - seq_expect(Rest,[{prompt,PromptType}|Patterns],Acc,EO) + log_lines(Name,Pid,Data), + seq_expect(Name,Pid,Rest,[{prompt,PromptType}|Patterns],Acc,EO) end; -seq_expect1(Data,[Pattern|Patterns],Acc,Rest,EO) -> - case match_lines(Data,[Pattern],EO) of +seq_expect1(Name,Pid,Data,[Pattern|Patterns],Acc,Rest,EO) -> + case match_lines(Name,Pid,Data,[Pattern],EO) of {match,Match,MatchRest} -> - seq_expect1(MatchRest,Patterns,[Match|Acc],Rest,EO); + seq_expect1(Name,Pid,MatchRest,Patterns,[Match|Acc],Rest,EO); {nomatch,prompt} -> - seq_expect(Rest,[Pattern|Patterns],Acc,EO); + seq_expect(Name,Pid,Rest,[Pattern|Patterns],Acc,EO); {nomatch,NoMatchRest} when Rest==[] -> %% The data did not end with a prompt {continue,[Pattern|Patterns],Acc,NoMatchRest}; {halt,Why,HaltRest} -> {halt,Why,HaltRest++Rest} end; -seq_expect1(Data,[],Acc,Rest,_EO) -> +seq_expect1(_Name,_Pid,Data,[],Acc,Rest,_EO) -> {match,lists:reverse(Acc),Data++Rest}. %% Split prompt-chunk at lines -match_lines(Data,Patterns,EO) -> +match_lines(Name,Pid,Data,Patterns,EO) -> FoundPrompt = EO#eo.found_prompt, case one_line(Data,[]) of {noline,Rest} when FoundPrompt=/=false -> %% This is the line including the prompt - case match_line(Rest,Patterns,FoundPrompt,EO) of + case match_line(Name,Pid,Rest,Patterns,FoundPrompt,EO) of nomatch -> {nomatch,prompt}; {Tag,Match} -> {Tag,Match,[]} end; {noline,Rest} when EO#eo.prompt_check==false -> - case match_line(Rest,Patterns,false,EO) of + case match_line(Name,Pid,Rest,Patterns,false,EO) of nomatch -> {nomatch,Rest}; {Tag,Match} -> @@ -1049,9 +1193,9 @@ match_lines(Data,Patterns,EO) -> {noline,Rest} -> {nomatch,Rest}; {Line,Rest} -> - case match_line(Line,Patterns,false,EO) of + case match_line(Name,Pid,Line,Patterns,false,EO) of nomatch -> - match_lines(Rest,Patterns,EO); + match_lines(Name,Pid,Rest,Patterns,EO); {Tag,Match} -> {Tag,Match,Rest} end @@ -1059,43 +1203,43 @@ match_lines(Data,Patterns,EO) -> %% For one line, match each pattern -match_line(Line,Patterns,FoundPrompt,EO) -> - match_line(Line,Patterns,FoundPrompt,EO,match). - -match_line(Line,[prompt|Patterns],false,EO,RetTag) -> - match_line(Line,Patterns,false,EO,RetTag); -match_line(Line,[prompt|_Patterns],FoundPrompt,_EO,RetTag) -> - try_cont_log(" ~ts", [Line]), - try_cont_log("<b>PROMPT:</b> ~ts", [FoundPrompt]), +match_line(Name,Pid,Line,Patterns,FoundPrompt,EO) -> + match_line(Name,Pid,Line,Patterns,FoundPrompt,EO,match). + +match_line(Name,Pid,Line,[prompt|Patterns],false,EO,RetTag) -> + match_line(Name,Pid,Line,Patterns,false,EO,RetTag); +match_line(Name,Pid,Line,[prompt|_Patterns],FoundPrompt,_EO,RetTag) -> + log(name_or_pid(Name,Pid)," ~ts",[Line]), + log(name_or_pid(Name,Pid),"PROMPT: ~ts",[FoundPrompt]), {RetTag,{prompt,FoundPrompt}}; -match_line(Line,[{prompt,PromptType}|_Patterns],FoundPrompt,_EO,RetTag) +match_line(Name,Pid,Line,[{prompt,PromptType}|_Patterns],FoundPrompt,_EO,RetTag) when PromptType==FoundPrompt -> - try_cont_log(" ~ts", [Line]), - try_cont_log("<b>PROMPT:</b> ~ts", [FoundPrompt]), + log(name_or_pid(Name,Pid)," ~ts",[Line]), + log(name_or_pid(Name,Pid),"PROMPT: ~ts",[FoundPrompt]), {RetTag,{prompt,FoundPrompt}}; -match_line(Line,[{prompt,PromptType}|Patterns],FoundPrompt,EO,RetTag) +match_line(Name,Pid,Line,[{prompt,PromptType}|Patterns],FoundPrompt,EO,RetTag) when PromptType=/=FoundPrompt -> - match_line(Line,Patterns,FoundPrompt,EO,RetTag); -match_line(Line,[{Tag,Pattern}|Patterns],FoundPrompt,EO,RetTag) -> + match_line(Name,Pid,Line,Patterns,FoundPrompt,EO,RetTag); +match_line(Name,Pid,Line,[{Tag,Pattern}|Patterns],FoundPrompt,EO,RetTag) -> case re:run(Line,Pattern,[{capture,all,list}]) of nomatch -> - match_line(Line,Patterns,FoundPrompt,EO,RetTag); + match_line(Name,Pid,Line,Patterns,FoundPrompt,EO,RetTag); {match,Match} -> - try_cont_log("<b>MATCH:</b> ~ts", [Line]), + log(name_or_pid(Name,Pid),"MATCH: ~ts",[Line]), {RetTag,{Tag,Match}} end; -match_line(Line,[Pattern|Patterns],FoundPrompt,EO,RetTag) -> +match_line(Name,Pid,Line,[Pattern|Patterns],FoundPrompt,EO,RetTag) -> case re:run(Line,Pattern,[{capture,all,list}]) of nomatch -> - match_line(Line,Patterns,FoundPrompt,EO,RetTag); + match_line(Name,Pid,Line,Patterns,FoundPrompt,EO,RetTag); {match,Match} -> - try_cont_log("<b>MATCH:</b> ~ts", [Line]), + log(name_or_pid(Name,Pid),"MATCH: ~ts",[Line]), {RetTag,Match} end; -match_line(Line,[],FoundPrompt,EO,match) -> - match_line(Line,EO#eo.haltpatterns,FoundPrompt,EO,halt); -match_line(Line,[],_FoundPrompt,_EO,halt) -> - try_cont_log(" ~ts", [Line]), +match_line(Name,Pid,Line,[],FoundPrompt,EO,match) -> + match_line(Name,Pid,Line,EO#eo.haltpatterns,FoundPrompt,EO,halt); +match_line(Name,Pid,Line,[],_FoundPrompt,_EO,halt) -> + log(name_or_pid(Name,Pid)," ~ts",[Line]), nomatch. one_line([$\n|Rest],Line) -> @@ -1111,26 +1255,29 @@ one_line([],Line) -> debug_log_lines(String) -> Old = put(silent,true), - log_lines(String), + log_lines(undefined,undefined,String), put(silent,Old). -log_lines(String) -> - case log_lines_not_last(String) of +log_lines(Name,Pid,String) -> + case log_lines_not_last(Name,Pid,String) of [] -> ok; LastLine -> - try_cont_log(" ~ts", [LastLine]) + log(name_or_pid(Name,Pid)," ~ts",[LastLine]) end. -log_lines_not_last(String) -> +log_lines_not_last(Name,Pid,String) -> case add_tabs(String,[],[]) of {[],LastLine} -> LastLine; {String1,LastLine} -> - try_cont_log("~ts",[String1]), + log(name_or_pid(Name,Pid),"~ts",[String1]), LastLine end. +name_or_pid(undefined,Pid) -> Pid; +name_or_pid(Name,_) -> Name. + add_tabs([0|Rest],Acc,LastLine) -> add_tabs(Rest,Acc,LastLine); add_tabs([$\r|Rest],Acc,LastLine) -> @@ -1145,8 +1292,6 @@ add_tabs([],[],LastLine) -> {[],lists:reverse(LastLine)}. - - %%% @hidden teln_receive_until_prompt(Pid,Prx,Timeout) -> Fun = fun() -> teln_receive_until_prompt(Pid,Prx,[],[]) end, diff --git a/lib/common_test/src/ct_util.erl b/lib/common_test/src/ct_util.erl index bcc4caa62e..1d851f8d2f 100644 --- a/lib/common_test/src/ct_util.erl +++ b/lib/common_test/src/ct_util.erl @@ -382,9 +382,14 @@ loop(Mode,TestData,StartDir) -> TestData1 = case lists:keysearch(Key,1,TestData) of {value,{Key,Val}} -> - NewVal = Fun(Val), - return(From,NewVal), - [{Key,NewVal}|lists:keydelete(Key,1,TestData)]; + case Fun(Val) of + '$delete' -> + return(From,deleted), + lists:keydelete(Key,1,TestData); + NewVal -> + return(From,NewVal), + [{Key,NewVal}|lists:keydelete(Key,1,TestData)] + end; _ -> case lists:member(create,Opts) of true -> diff --git a/lib/common_test/src/ct_util.hrl b/lib/common_test/src/ct_util.hrl index 7c01e17c36..a82d58cc42 100644 --- a/lib/common_test/src/ct_util.hrl +++ b/lib/common_test/src/ct_util.hrl @@ -79,4 +79,10 @@ -define(tablesorter_script, "jquery.tablesorter.min.js"). %% Logging information for error handler --record(conn_log, {client, name, address, action, module}). +-record(conn_log, {header=true, + client, + name, + address, + conn_pid, + action, + module}). diff --git a/lib/common_test/src/cth_conn_log.erl b/lib/common_test/src/cth_conn_log.erl index 644594e34d..a731c8054c 100644 --- a/lib/common_test/src/cth_conn_log.erl +++ b/lib/common_test/src/cth_conn_log.erl @@ -56,11 +56,29 @@ pre_init_per_testcase/3, post_end_per_testcase/4]). +%%---------------------------------------------------------------------- +%% Exported types +%%---------------------------------------------------------------------- +-export_type([hook_options/0, + log_type/0, + conn_mod/0]). + +%%---------------------------------------------------------------------- +%% Type declarations +%%---------------------------------------------------------------------- +-type hook_options() :: [hook_option()]. +%% Options that can be given to `cth_conn_log' in the `ct_hook' statement. +-type hook_option() :: {log_type,log_type()} | + {hosts,[ct_gen_conn:key_or_name()]}. +-type log_type() :: raw | pretty | html | silent. +-type conn_mod() :: ct_netconfc | ct_telnet. +%%---------------------------------------------------------------------- + -spec init(Id, HookOpts) -> Result when Id :: term(), - HookOpts :: ct_netconfc:hook_options(), - Result :: {ok,[{ct_netconfc:conn_mod(), - {ct_netconfc:log_type(),[ct_netconfc:key_or_name()]}}]}. + HookOpts :: hook_options(), + Result :: {ok,[{conn_mod(), + {log_type(),[ct_gen_conn:key_or_name()]}}]}. init(_Id, HookOpts) -> ConfOpts = ct:get_config(ct_conn_log,[]), {ok,merge_log_info(ConfOpts,HookOpts)}. @@ -86,7 +104,8 @@ get_log_opts(Opts) -> pre_init_per_testcase(TestCase,Config,CthState) -> Logs = lists:map( - fun({ConnMod,{LogType,Hosts}}) -> + fun({ConnMod,{LogType,Hosts}}) -> + ct_util:set_testdata({{?MODULE,ConnMod},LogType}), case LogType of LogType when LogType==raw; LogType==pretty -> Dir = ?config(priv_dir,Config), @@ -117,9 +136,44 @@ pre_init_per_testcase(TestCase,Config,CthState) -> end end, CthState), - error_logger:add_report_handler(ct_conn_log_h,{group_leader(),Logs}), + + GL = group_leader(), + Update = + fun(Init) when Init == undefined; Init == [] -> + error_logger:add_report_handler(ct_conn_log_h,{GL,Logs}), + [TestCase]; + (PrevUsers) -> + error_logger:info_report(update,{GL,Logs}), + receive + {updated,GL} -> + [TestCase|PrevUsers] + after + 5000 -> + {error,no_response} + end + end, + ct_util:update_testdata(?MODULE, Update, [create]), {Config,CthState}. -post_end_per_testcase(_TestCase,_Config,Return,CthState) -> - error_logger:delete_report_handler(ct_conn_log_h), +post_end_per_testcase(TestCase,_Config,Return,CthState) -> + Update = + fun(PrevUsers) -> + case lists:delete(TestCase, PrevUsers) of + [] -> + '$delete'; + PrevUsers1 -> + PrevUsers1 + end + end, + case ct_util:update_testdata(?MODULE, Update) of + deleted -> + [ct_util:delete_testdata({?MODULE,ConnMod}) || + {ConnMod,_} <- CthState], + error_logger:delete_report_handler(ct_conn_log_h); + {error,no_response} -> + exit({?MODULE,no_response_from_logger}); + _PrevUsers -> + ok + end, {Return,CthState}. + diff --git a/lib/common_test/src/unix_telnet.erl b/lib/common_test/src/unix_telnet.erl index 88199b07d0..e049c3bf39 100644 --- a/lib/common_test/src/unix_telnet.erl +++ b/lib/common_test/src/unix_telnet.erl @@ -54,8 +54,8 @@ -compile(export_all). %% Callbacks for ct_telnet.erl --export([connect/5,get_prompt_regexp/0]). --import(ct_telnet,[start_log/1,cont_log/2,end_log/0]). +-export([connect/6,get_prompt_regexp/0]). +-import(ct_telnet,[start_gen_log/1,log/4,end_gen_log/0]). -define(username,"login: "). -define(password,"Password: "). @@ -76,7 +76,9 @@ get_prompt_regexp() -> %%%----------------------------------------------------------------- %%% @hidden -%%% @spec connect(Ip,Port,Timeout,KeepAlive,Extra) -> {ok,Handle} | {error,Reason} +%%% @spec connect(ConnName,Ip,Port,Timeout,KeepAlive,Extra) -> +%%% {ok,Handle} | {error,Reason} +%%% ConnName = ct:target_name() %%% Ip = string() | {integer(),integer(),integer(),integer()} %%% Port = integer() %%% Timeout = integer() @@ -89,59 +91,70 @@ get_prompt_regexp() -> %%% @doc Callback for ct_telnet.erl. %%% %%% <p>Setup telnet connection to a UNIX host.</p> -connect(Ip,Port,Timeout,KeepAlive,Extra) -> +connect(ConnName,Ip,Port,Timeout,KeepAlive,Extra) -> case Extra of {Username,Password} -> - connect1(Ip,Port,Timeout,KeepAlive,Username,Password); - Name -> - case get_username_and_password(Name) of + connect1(ConnName,Ip,Port,Timeout,KeepAlive, + Username,Password); + KeyOrName -> + case get_username_and_password(KeyOrName) of {ok,{Username,Password}} -> - connect1(Ip,Port,Timeout,KeepAlive,Username,Password); + connect1(ConnName,Ip,Port,Timeout,KeepAlive, + Username,Password); Error -> Error end end. -connect1(Ip,Port,Timeout,KeepAlive,Username,Password) -> - start_log("unix_telnet:connect"), +connect1(Name,Ip,Port,Timeout,KeepAlive,Username,Password) -> + start_gen_log("unix_telnet connect"), Result = case ct_telnet_client:open(Ip,Port,Timeout,KeepAlive) of {ok,Pid} -> - case ct_telnet:silent_teln_expect(Pid,[],[prompt],?prx,[]) of + case ct_telnet:silent_teln_expect(Name,Pid,[], + [prompt],?prx,[]) of {ok,{prompt,?username},_} -> + log(Name,send,"Logging in to ~p:~p", [Ip,Port]), ok = ct_telnet_client:send_data(Pid,Username), - cont_log("Username: ~ts",[Username]), - case ct_telnet:silent_teln_expect(Pid,[],prompt,?prx,[]) of + log(Name,send,"Username: ~ts",[Username]), + case ct_telnet:silent_teln_expect(Name,Pid,[], + prompt,?prx,[]) of {ok,{prompt,?password},_} -> ok = ct_telnet_client:send_data(Pid,Password), Stars = lists:duplicate(length(Password),$*), - cont_log("Password: ~s",[Stars]), + log(Name,send,"Password: ~s",[Stars]), ok = ct_telnet_client:send_data(Pid,""), - case ct_telnet:silent_teln_expect(Pid,[],prompt, + case ct_telnet:silent_teln_expect(Name,Pid,[], + prompt, ?prx,[]) of {ok,{prompt,Prompt},_} - when Prompt=/=?username, Prompt=/=?password -> + when Prompt=/=?username, + Prompt=/=?password -> {ok,Pid}; Error -> - cont_log("Password failed\n~p\n", - [Error]), + log(Name,recv,"Password failed\n~p\n", + [Error]), {error,Error} end; Error -> - cont_log("Login failed\n~p\n",[Error]), + log(Name,recv,"Login to ~p:~p failed\n~p\n",[Ip,Port,Error]), {error,Error} end; {ok,[{prompt,_OtherPrompt1},{prompt,_OtherPrompt2}],_} -> {ok,Pid}; Error -> - cont_log("Did not get expected prompt\n~p\n",[Error]), + log(Name,error, + "Did not get expected prompt from ~p:~p\n~p\n", + [Ip,Port,Error]), {error,Error} end; Error -> - cont_log("Could not open telnet connection\n~p\n",[Error]), + log(Name,error, + "Could not open telnet connection to ~p:~p\n~p\n", + [Ip,Port,Error]), Error end, - end_log(), + end_gen_log(), Result. get_username_and_password(Name) -> diff --git a/lib/common_test/test/ct_telnet_SUITE.erl b/lib/common_test/test/ct_telnet_SUITE.erl index e2ee207754..25debf09d4 100644 --- a/lib/common_test/test/ct_telnet_SUITE.erl +++ b/lib/common_test/test/ct_telnet_SUITE.erl @@ -46,6 +46,26 @@ %% instance, the tests need to be performed on a separate node (or %% there will be clashes with logging processes etc). %%-------------------------------------------------------------------- +suite() -> [{ct_hooks,[ts_install_cth]}]. + +groups() -> + [{legacy, [], [unix_telnet,own_server,timetrap]}, + {raw, [], [unix_telnet,own_server,timetrap]}, + {html, [], [unix_telnet,own_server]}, + {silent, [], [unix_telnet,own_server]}]. + +all() -> + [ + {group,legacy}, + {group,raw}, + {group,html}, + {group,silent} + ]. + +%%-------------------------------------------------------------------- +%% CONFIG FUNCTIONS +%%-------------------------------------------------------------------- + init_per_suite(Config) -> ct_test_support:init_per_suite(Config). @@ -67,14 +87,6 @@ end_per_testcase(TestCase, Config) -> end, ct_test_support:end_per_testcase(TestCase, Config). -suite() -> [{ct_hooks,[ts_install_cth]}]. - -all() -> - [ - unix_telnet, - own_server, - timetrap - ]. %%-------------------------------------------------------------------- %% TEST CASES @@ -82,27 +94,43 @@ all() -> %%%----------------------------------------------------------------- %%% -unix_telnet(Config) when is_list(Config) -> - all_tests_in_suite(unix_telnet,"ct_telnet_basic_SUITE","telnet.cfg",Config). +unix_telnet(Config) -> + CfgFile = "telnet.unix_telnet." ++ + atom_to_list(groupname(Config)) ++ ".cfg", + all_tests_in_suite(unix_telnet,"ct_telnet_basic_SUITE",CfgFile,Config). own_server(Config) -> + CfgFile = "telnet.own_server." ++ + atom_to_list(groupname(Config)) ++ ".cfg", all_tests_in_suite(own_server,"ct_telnet_own_server_SUITE", - "telnet2.cfg",Config). + CfgFile,Config). timetrap(Config) -> + CfgFile = "telnet.timetrap." ++ + atom_to_list(groupname(Config)) ++ ".cfg", all_tests_in_suite(timetrap,"ct_telnet_timetrap_SUITE", - "telnet3.cfg",Config). + CfgFile,Config). %%%----------------------------------------------------------------- %%% HELP FUNCTIONS %%%----------------------------------------------------------------- +groupname(Config) -> + case proplists:get_value(tc_group_properties, Config) of + undefined -> + undefined; + TGP -> + proplists:get_value(name, TGP) + end. + all_tests_in_suite(TestCase, SuiteName, CfgFileName, Config) -> + PrivDir = ?config(priv_dir, Config), DataDir = ?config(data_dir, Config), Suite = filename:join(DataDir, SuiteName), - CfgFile = filename:join(DataDir, CfgFileName), - Cfg = telnet_config(TestCase), - ok = file:write_file(CfgFile, io_lib:write(Cfg) ++ "."), + CfgFile = filename:join(PrivDir, CfgFileName), + Cfg = telnet_config(TestCase, groupname(Config)), + Txt = lists:flatten([lists:flatten(io_lib:write(C))++".\n" || C <- Cfg]), + ok = file:write_file(CfgFile, Txt), {Opts,ERPid} = setup([{suite,Suite}, {label,TestCase}, {config,CfgFile}], @@ -132,15 +160,36 @@ execute(Name, Opts, ERPid, Config) -> reformat(Events, EH) -> ct_test_support:reformat(Events, EH). - -telnet_config(unix_telnet) -> - {unix, ct:get_config(unix)}; -telnet_config(_) -> - {unix,[{telnet,"localhost"}, - {port, ?erl_telnet_server_port}, - {username,?erl_telnet_server_user}, - {password,?erl_telnet_server_pwd}, - {keep_alive,true}]}. +telnet_config(_, undefined) -> + []; +telnet_config(unix_telnet, legacy) -> + [{unix, ct:get_config(unix)}, + {ct_conn_log,[]}]; +%% LogType same as GroupName +telnet_config(unix_telnet, LogType) -> + [{unix, ct:get_config(unix)}, + {ct_conn_log, + [{ct_telnet,[{log_type,LogType}, + {hosts,[telnet_server_conn1, + telnet_server_conn2, + telnet_server_conn3, + telnet_server_conn4]}]}]}]; +telnet_config(_, LogType) -> + [{unix,[{telnet,"localhost"}, + {port, ?erl_telnet_server_port}, + {username,?erl_telnet_server_user}, + {password,?erl_telnet_server_pwd}, + {keep_alive,true}]} | + if LogType == legacy -> + [{ct_conn_log,[]}]; + true -> + [{ct_conn_log, + [{ct_telnet,[{log_type,LogType}, + {hosts,[telnet_server_conn1, + telnet_server_conn2, + telnet_server_conn3, + telnet_server_conn4]}]}]}] + end]. %%%----------------------------------------------------------------- %%% TEST EVENTS @@ -159,14 +208,44 @@ events_to_check(timetrap,_Config) -> all_cases(Suite,Config) -> {module,_} = code:load_abs(filename:join(?config(data_dir,Config), Suite)), - TCs = Suite:all(), + GroupsAndTCs = Suite:all(), + + Terms = + lists:flatmap( + fun({group,G}) -> + {value,{G,Props,GTCs}} = + lists:keysearch(G,1,Suite:groups()), + GTCs1 = case lists:member(parallel,Props) of + true -> + %%! TEMPORARY WORKAROUND FOR PROBLEM + %%! WITH ct_test_support NOT HANDLING + %%! VERIFICATION OF PARALLEL GROUPS + %%! CORRECTLY! + []; + false -> + [[{?eh,tc_start,{Suite,GTC}}, + {?eh,tc_done,{Suite,GTC,ok}}] || + GTC <- GTCs] + end, + [{?eh,tc_start,{Suite,{init_per_group,G,Props}}}, + {?eh,tc_done,{Suite,{init_per_group,G,Props},ok}} | + GTCs1] ++ + [{?eh,tc_start,{Suite,{end_per_group,G,Props}}}, + {?eh,tc_done,{Suite,{end_per_group,G,Props},ok}}]; + (TC) -> + [{?eh,tc_done,{Suite,TC,ok}}] + end, GroupsAndTCs), + code:purge(Suite), code:delete(Suite), + FlatTerms = lists:flatten(Terms), + + ct:log("Verifying with terms:~n~p", [FlatTerms]), + OneTest = - [{?eh,start_logging,{'DEF','RUNDIR'}}] ++ - [{?eh,tc_done,{Suite,TC,ok}} || TC <- TCs] ++ - [{?eh,stop_logging,[]}], + [{?eh,start_logging,{'DEF','RUNDIR'}} | + FlatTerms] ++ [{?eh,stop_logging,[]}], %% 2 tests (ct:run_test + script_start) is default OneTest ++ OneTest. diff --git a/lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_basic_SUITE.erl b/lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_basic_SUITE.erl index 914b95f9cf..80616af064 100644 --- a/lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_basic_SUITE.erl +++ b/lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_basic_SUITE.erl @@ -5,45 +5,101 @@ -include_lib("common_test/include/ct.hrl"). +-define(no_of_sessions, 4). +-define(conn_name(N), (list_to_atom("telnet_server_conn"++integer_to_list(N)))). +-define(get_n(Cfg), (proplists:get_value(n, Cfg))). + %%-------------------------------------------------------------------- %% TEST SERVER CALLBACK FUNCTIONS %%-------------------------------------------------------------------- +suite() -> [ + {require,ct_conn_log}, + {ct_hooks, [{cth_conn_log,[]}]} + ]. + +operations() -> + [start_stop, send_and_get, expect, already_closed, + cmd, sendf, close_wrong_type]. + +mult_case(_Case, 0) -> + []; +mult_case(Case, N) -> + [list_to_atom(atom_to_list(Case)++integer_to_list(N)) | + mult_case(Case, N-1)]. + +groups() -> + [{single_connection,[],operations()}, + {multiple_connections,[parallel], + lists:reverse(mult_case(sessions,?no_of_sessions))}]. + +all() -> + [{group,single_connection}, + {group,multiple_connections}]. + init_per_suite(Config) -> + ct:pal("Will use these log hook options: ~p", + [ct:get_config(ct_conn_log,[])]), Config. end_per_suite(_Config) -> ok. +init_per_group(Group, Config) -> + if Group == single_connection -> + ct:require(?conn_name(1),{unix,[telnet]}); + true -> + ok + end, + [{n,1} | Config]. -suite() -> [{require,telnet_temp,{unix,[telnet]}}]. +end_per_group(_GroupName, Config) -> + Config. -all() -> - [start_stop, send_and_get, expect, already_closed, - cmd, sendf, close_wrong_type]. +init_per_testcase(Case, Config) when (Case == sessions1) or + (Case == sessions2) or + (Case == sessions3) or + (Case == sessions4) -> + N = lists:last(atom_to_list(Case))-48, + ct:log("Using connection ~w for session ~w on ~w", + [?conn_name(N),N,self()]), + ct:require(?conn_name(N),{unix,[telnet]}), + [{n,N} | proplists:delete(n,Config)]; +init_per_testcase(Case, Config) -> + ct:log("Testcase ~w using connection ~w", + [Case,?conn_name(?get_n(Config))]), + Config. -groups() -> - []. +end_per_testcase(_Case, _) -> + ok. -init_per_group(_GroupName, Config) -> - Config. +%%%----------------------------------------------------------------- +%%% TEST CASES -end_per_group(_GroupName, Config) -> - Config. +sessions(Config) -> + [apply(?MODULE,Op,[Config]) || Op <- operations()], + ok. + +sessions1(Config) -> sessions(Config). +sessions2(Config) -> sessions(Config). +sessions3(Config) -> sessions(Config). +sessions4(Config) -> sessions(Config). -start_stop(_Config) -> - {ok, Handle} = ct_telnet:open(telnet_temp), +start_stop(Config) -> + ct:log("Opening ~w...", [?conn_name(?get_n(Config))]), + {ok, Handle} = ct_telnet:open(?conn_name(?get_n(Config))), ok = ct_telnet:close(Handle), ok. -send_and_get(_) -> - {ok, Handle} = ct_telnet:open(telnet_temp), + +send_and_get(Config) -> + {ok, Handle} = ct_telnet:open(?conn_name(?get_n(Config))), ok = ct_telnet:send(Handle, "ayt"), {ok, _Data} = ct_telnet:get_data(Handle), ok = ct_telnet:close(Handle), ok. -expect(_) -> - {ok, Handle} = ct_telnet:open(telnet_temp), +expect(Config) -> + {ok, Handle} = ct_telnet:open(?conn_name(?get_n(Config))), ok = ct_telnet:send(Handle, "echo ayt"), ok = case ct_telnet:expect(Handle, ["ayt"]) of {ok, _} -> @@ -54,21 +110,21 @@ expect(_) -> ok = ct_telnet:close(Handle), ok. -already_closed(_) -> - {ok, Handle} = ct_telnet:open(telnet_temp), +already_closed(Config) -> + {ok, Handle} = ct_telnet:open(?conn_name(?get_n(Config))), ok = ct_telnet:close(Handle), {error, already_closed} = ct_telnet:close(Handle), ok. -cmd(_) -> - {ok, Handle} = ct_telnet:open(telnet_temp), +cmd(Config) -> + {ok, Handle} = ct_telnet:open(?conn_name(?get_n(Config))), {ok, _} = ct_telnet:cmd(Handle, "display"), {ok, _} = ct_telnet:cmdf(Handle, "~s ~s", ["set", "bsasdel"]), ok = ct_telnet:close(Handle), ok. -sendf(_) -> - {ok, Handle} = ct_telnet:open(telnet_temp), +sendf(Config) -> + {ok, Handle} = ct_telnet:open(?conn_name(?get_n(Config))), ok = ct_telnet:sendf(Handle, "~s", ["ayt"]), ok = ct_telnet:close(Handle), ok. @@ -76,3 +132,8 @@ sendf(_) -> close_wrong_type(_) -> {error, _} = ct_telnet:close(whatever), ok. + +%%%----------------------------------------------------------------- +%%% HELP FUNCS + + diff --git a/lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_own_server_SUITE.erl b/lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_own_server_SUITE.erl index 3f7c0d68bf..8d142e85a8 100644 --- a/lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_own_server_SUITE.erl +++ b/lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_own_server_SUITE.erl @@ -8,14 +8,12 @@ %% TEST SERVER CALLBACK FUNCTIONS %%-------------------------------------------------------------------- -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - - -suite() -> [{require,erl_telnet_server,{unix,[telnet]}}]. +suite() -> + [ + {require,telnet_server_conn1,{unix,[telnet]}}, + {require,ct_conn_log}, + {ct_hooks, [{cth_conn_log,[]}]} + ]. all() -> [expect, @@ -35,6 +33,14 @@ all() -> groups() -> []. +init_per_suite(Config) -> + ct:pal("Will use these log hook options: ~p", + [ct:get_config(ct_conn_log,[])]), + Config. + +end_per_suite(_Config) -> + ok. + init_per_group(_GroupName, Config) -> Config. @@ -43,7 +49,7 @@ end_per_group(_GroupName, Config) -> %% Simple expect expect(_) -> - {ok, Handle} = ct_telnet:open(erl_telnet_server), + {ok, Handle} = ct_telnet:open(telnet_server_conn1), ok = ct_telnet:send(Handle, "echo ayt"), {ok,["ayt"]} = ct_telnet:expect(Handle, ["ayt"]), ok = ct_telnet:close(Handle), @@ -51,7 +57,7 @@ expect(_) -> %% Expect with repeat option expect_repeat(_) -> - {ok, Handle} = ct_telnet:open(erl_telnet_server), + {ok, Handle} = ct_telnet:open(telnet_server_conn1), ok = ct_telnet:send(Handle, "echo_ml xy xy"), {ok,[["xy"],["xy"]],done} = ct_telnet:expect(Handle, ["xy"],[{repeat,2}]), ok = ct_telnet:close(Handle), @@ -59,7 +65,7 @@ expect_repeat(_) -> %% Expect with sequence option expect_sequence(_) -> - {ok, Handle} = ct_telnet:open(erl_telnet_server), + {ok, Handle} = ct_telnet:open(telnet_server_conn1), ok = ct_telnet:send(Handle, "echo_ml ab cd ef"), {ok,[["ab"],["cd"],["ef"]]} = ct_telnet:expect(Handle, [["ab"],["cd"],["ef"]], @@ -70,7 +76,7 @@ expect_sequence(_) -> %% Check that expect returns when a prompt is found, even if pattern %% is not matched. expect_error_prompt(_) -> - {ok, Handle} = ct_telnet:open(erl_telnet_server), + {ok, Handle} = ct_telnet:open(telnet_server_conn1), ok = ct_telnet:send(Handle, "echo xxx> yyy"), {error,{prompt,"> "}} = ct_telnet:expect(Handle, ["yyy"]), ok = ct_telnet:close(Handle), @@ -80,7 +86,7 @@ expect_error_prompt(_) -> %% expected pattern is received - as long as not newline or prompt is %% received it will not match. expect_error_timeout(_) -> - {ok, Handle} = ct_telnet:open(erl_telnet_server), + {ok, Handle} = ct_telnet:open(telnet_server_conn1), ok = ct_telnet:send(Handle, "echo_no_prompt xxx"), {error,timeout} = ct_telnet:expect(Handle, ["xxx"], [{timeout,1000}]), ok = ct_telnet:close(Handle), @@ -89,7 +95,7 @@ expect_error_timeout(_) -> %% expect with ignore_prompt option should not return even if a prompt %% is found. The pattern after the prompt (here "> ") can be matched. ignore_prompt(_) -> - {ok, Handle} = ct_telnet:open(erl_telnet_server), + {ok, Handle} = ct_telnet:open(telnet_server_conn1), ok = ct_telnet:send(Handle, "echo xxx> yyy"), {ok,["yyy"]} = ct_telnet:expect(Handle, ["yyy"], [ignore_prompt]), ok = ct_telnet:close(Handle), @@ -97,7 +103,7 @@ ignore_prompt(_) -> %% expect with ignore_prompt and repeat options. ignore_prompt_repeat(_) -> - {ok, Handle} = ct_telnet:open(erl_telnet_server), + {ok, Handle} = ct_telnet:open(telnet_server_conn1), ok = ct_telnet:send(Handle, "echo_ml yyy> yyy>"), {ok,[["yyy"],["yyy"]],done} = ct_telnet:expect(Handle, ["yyy"], [{repeat,2}, @@ -107,7 +113,7 @@ ignore_prompt_repeat(_) -> %% expect with ignore_prompt and sequence options. ignore_prompt_sequence(_) -> - {ok, Handle} = ct_telnet:open(erl_telnet_server), + {ok, Handle} = ct_telnet:open(telnet_server_conn1), ok = ct_telnet:send(Handle, "echo_ml xxx> yyy> zzz> "), {ok,[["xxx"],["yyy"],["zzz"]]} = ct_telnet:expect(Handle, [["xxx"],["yyy"],["zzz"]], @@ -121,7 +127,7 @@ ignore_prompt_sequence(_) -> %% As for expect without the ignore_prompt option, it a newline or a %% prompt is required in order for the pattern to match. ignore_prompt_timeout(_) -> - {ok, Handle} = ct_telnet:open(erl_telnet_server), + {ok, Handle} = ct_telnet:open(telnet_server_conn1), ok = ct_telnet:send(Handle, "echo xxx"), {error,timeout} = ct_telnet:expect(Handle, ["yyy"], [ignore_prompt, {timeout,1000}]), @@ -140,7 +146,7 @@ ignore_prompt_timeout(_) -> %% no_prompt_check option shall match pattern both when prompt is sent %% and when it is not. no_prompt_check(_) -> - {ok, Handle} = ct_telnet:open(erl_telnet_server), + {ok, Handle} = ct_telnet:open(telnet_server_conn1), ok = ct_telnet:send(Handle, "echo xxx"), {ok,["xxx"]} = ct_telnet:expect(Handle, ["xxx"], [no_prompt_check]), ok = ct_telnet:send(Handle, "echo_no_prompt yyy"), @@ -150,7 +156,7 @@ no_prompt_check(_) -> %% no_prompt_check and repeat options no_prompt_check_repeat(_) -> - {ok, Handle} = ct_telnet:open(erl_telnet_server), + {ok, Handle} = ct_telnet:open(telnet_server_conn1), ok = ct_telnet:send(Handle, "echo_ml xxx xxx"), {ok,[["xxx"],["xxx"]],done} = ct_telnet:expect(Handle,["xxx"], [{repeat,2}, @@ -164,7 +170,7 @@ no_prompt_check_repeat(_) -> %% no_prompt_check and sequence options no_prompt_check_sequence(_) -> - {ok, Handle} = ct_telnet:open(erl_telnet_server), + {ok, Handle} = ct_telnet:open(telnet_server_conn1), ok = ct_telnet:send(Handle, "echo_ml_no_prompt ab cd ef"), {ok,[["ab"],["cd"],["ef"]]} = ct_telnet:expect(Handle, [["ab"],["cd"],["ef"]], @@ -176,7 +182,7 @@ no_prompt_check_sequence(_) -> %% Check that expect returns after idle timeout when no_prompt_check %% option is used. no_prompt_check_timeout(_) -> - {ok, Handle} = ct_telnet:open(erl_telnet_server), + {ok, Handle} = ct_telnet:open(telnet_server_conn1), ok = ct_telnet:send(Handle, "echo xxx"), {error,timeout} = ct_telnet:expect(Handle, ["yyy"], [no_prompt_check, {timeout,1000}]), diff --git a/lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_timetrap_SUITE.erl b/lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_timetrap_SUITE.erl index f274fb9112..c45a4f0984 100644 --- a/lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_timetrap_SUITE.erl +++ b/lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_timetrap_SUITE.erl @@ -4,7 +4,7 @@ -include_lib("common_test/include/ct.hrl"). --define(name,erl_telnet_server). +-define(name, telnet_server_conn1). %%-------------------------------------------------------------------- %% TEST SERVER CALLBACK FUNCTIONS @@ -17,6 +17,8 @@ end_per_suite(_Config) -> ok. suite() -> [{require,?name,{unix,[telnet]}}, + {require,ct_conn_log}, + {ct_hooks, [{cth_conn_log,[]}]}, {timetrap,{seconds,7}}]. all() -> diff --git a/lib/common_test/test/telnet_server.erl b/lib/common_test/test/telnet_server.erl index 31884aa182..1760100d8e 100644 --- a/lib/common_test/test/telnet_server.erl +++ b/lib/common_test/test/telnet_server.erl @@ -64,18 +64,19 @@ accept(#state{listen=LSock}=State) -> {Acceptor,Sock} when is_port(Sock) -> case init_client(State#state{client=Sock}) of stopped -> - io:format("telnet_server stopped\n"), + io:format("[telnet_server] telnet_server stopped\n"), ok; R -> - io:format("connection to client closed with reason ~p~n",[R]), + io:format("[telnet_server] connection to client" + "closed with reason ~p~n",[R]), accept(State) end; {Acceptor,closed} -> - io:format("listen socket closed unexpectedly, " + io:format("[telnet_server] listen socket closed unexpectedly, " "terminating telnet_server\n"), ok; stop -> - io:format("telnet_server stopped\n"), + io:format("[telnet_server] telnet_server stopped\n"), ok end. @@ -188,7 +189,7 @@ do_handle_data(_Data,State) -> check_user(User,State) -> case lists:keyfind(User,1,State#state.users) of {User,Pwd} -> - dbg("user ok\n"), + dbg("user ok\n"), send("Password: ",State), {ok,State#state{authorized={user,Pwd}}}; false -> @@ -223,6 +224,6 @@ get_line([],_) -> false. dbg(_F) -> - io:format(_F). + dbg(_F,[]). dbg(_F,_A) -> - io:format(_F,_A). + io:format("[telnet_server] "++_F,_A). diff --git a/lib/compiler/src/beam_a.erl b/lib/compiler/src/beam_a.erl index c590c5e35b..3dfa67a771 100644 --- a/lib/compiler/src/beam_a.erl +++ b/lib/compiler/src/beam_a.erl @@ -88,6 +88,10 @@ rename_instr({bs_private_append=I,F,Sz,U,Src,Flags,Dst}) -> {bs_init,F,{I,U,Flags},none,[Sz,Src],Dst}; rename_instr(bs_init_writable=I) -> {bs_init,{f,0},I,1,[{x,0}],{x,0}}; +rename_instr({put_map_assoc,Fail,S,D,R,L}) -> + {put_map,Fail,assoc,S,D,R,L}; +rename_instr({put_map_exact,Fail,S,D,R,L}) -> + {put_map,Fail,exact,S,D,R,L}; rename_instr({select_val=I,Reg,Fail,{list,List}}) -> {select,I,Reg,Fail,List}; rename_instr({select_tuple_arity=I,Reg,Fail,{list,List}}) -> diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl index 402fbe2e2e..3723cc19e1 100644 --- a/lib/compiler/src/beam_block.erl +++ b/lib/compiler/src/beam_block.erl @@ -152,6 +152,10 @@ collect({get_tuple_element,S,I,D}) -> {set,[D],[S],{get_tuple_element,I}}; collect({set_tuple_element,S,D,I}) -> {set,[],[S,D],{set_tuple_element,I}}; collect({get_list,S,D1,D2}) -> {set,[D1,D2],[S],get_list}; collect(remove_message) -> {set,[],[],remove_message}; +collect({put_map,F,Op,S,D,R,{list,Puts}}) -> + {set,[D],[S|Puts],{alloc,R,{put_map,Op,F}}}; +collect({get_map_element,F,S,K,D}) -> + {set,[D],[S],{get_map_element,K,F}}; collect({'catch',R,L}) -> {set,[R],[],{'catch',L}}; collect(fclearerror) -> {set,[],[],fclearerror}; collect({fcheckerror,{f,0}}) -> {set,[],[],fcheckerror}; @@ -236,6 +240,7 @@ move_allocates_2(Alloc, [], Acc) -> alloc_may_pass({set,_,_,{alloc,_,_}}) -> false; alloc_may_pass({set,_,_,{set_tuple_element,_}}) -> false; +alloc_may_pass({set,_,_,{get_map_element,_,_}}) -> false; alloc_may_pass({set,_,_,put_list}) -> false; alloc_may_pass({set,_,_,put}) -> false; alloc_may_pass({set,_,_,_}) -> true. @@ -383,6 +388,7 @@ gen_init(Fs, Regs, Y, Acc) -> init_yreg([{set,_,_,{bif,_,_}}|_], Reg) -> Reg; init_yreg([{set,_,_,{alloc,_,{gc_bif,_,_}}}|_], Reg) -> Reg; +init_yreg([{set,_,_,{alloc,_,{put_map,_,_}}}|_], Reg) -> Reg; init_yreg([{set,Ds,_,_}|Is], Reg) -> init_yreg(Is, add_yregs(Ds, Reg)); init_yreg(_Is, Reg) -> Reg. diff --git a/lib/compiler/src/beam_clean.erl b/lib/compiler/src/beam_clean.erl index 9d89e21a4e..55f985ad0e 100644 --- a/lib/compiler/src/beam_clean.erl +++ b/lib/compiler/src/beam_clean.erl @@ -234,6 +234,36 @@ replace([{bs_init,{f,Lbl},Info,Live,Ss,Dst}|Is], Acc, D) when Lbl =/= 0 -> replace(Is, [{bs_init,{f,label(Lbl, D)},Info,Live,Ss,Dst}|Acc], D); replace([{bs_put,{f,Lbl},Info,Ss}|Is], Acc, D) when Lbl =/= 0 -> replace(Is, [{bs_put,{f,label(Lbl, D)},Info,Ss}|Acc], D); +replace([{bs_init2,{f,Lbl},Sz,Words,R,F,Dst}|Is], Acc, D) when Lbl =/= 0 -> + replace(Is, [{bs_init2,{f,label(Lbl, D)},Sz,Words,R,F,Dst}|Acc], D); +replace([{bs_init_bits,{f,Lbl},Sz,Words,R,F,Dst}|Is], Acc, D) when Lbl =/= 0 -> + replace(Is, [{bs_init_bits,{f,label(Lbl, D)},Sz,Words,R,F,Dst}|Acc], D); +replace([{bs_put_integer,{f,Lbl},Bits,Unit,Fl,Val}|Is], Acc, D) when Lbl =/= 0 -> + replace(Is, [{bs_put_integer,{f,label(Lbl, D)},Bits,Unit,Fl,Val}|Acc], D); +replace([{bs_put_utf8=I,{f,Lbl},Fl,Val}|Is], Acc, D) when Lbl =/= 0 -> + replace(Is, [{I,{f,label(Lbl, D)},Fl,Val}|Acc], D); +replace([{bs_put_utf16=I,{f,Lbl},Fl,Val}|Is], Acc, D) when Lbl =/= 0 -> + replace(Is, [{I,{f,label(Lbl, D)},Fl,Val}|Acc], D); +replace([{bs_put_utf32=I,{f,Lbl},Fl,Val}|Is], Acc, D) when Lbl =/= 0 -> + replace(Is, [{I,{f,label(Lbl, D)},Fl,Val}|Acc], D); +replace([{bs_put_binary,{f,Lbl},Bits,Unit,Fl,Val}|Is], Acc, D) when Lbl =/= 0 -> + replace(Is, [{bs_put_binary,{f,label(Lbl, D)},Bits,Unit,Fl,Val}|Acc], D); +replace([{bs_put_float,{f,Lbl},Bits,Unit,Fl,Val}|Is], Acc, D) when Lbl =/= 0 -> + replace(Is, [{bs_put_float,{f,label(Lbl, D)},Bits,Unit,Fl,Val}|Acc], D); +replace([{bs_add,{f,Lbl},Src,Dst}|Is], Acc, D) when Lbl =/= 0 -> + replace(Is, [{bs_add,{f,label(Lbl, D)},Src,Dst}|Acc], D); +replace([{bs_append,{f,Lbl},_,_,_,_,_,_,_}=I0|Is], Acc, D) when Lbl =/= 0 -> + I = setelement(2, I0, {f,label(Lbl, D)}), + replace(Is, [I|Acc], D); +replace([{bs_utf8_size=I,{f,Lbl},Src,Dst}|Is], Acc, D) when Lbl =/= 0 -> + replace(Is, [{I,{f,label(Lbl, D)},Src,Dst}|Acc], D); +replace([{bs_utf16_size=I,{f,Lbl},Src,Dst}|Is], Acc, D) when Lbl =/= 0 -> + replace(Is, [{I,{f,label(Lbl, D)},Src,Dst}|Acc], D); +replace([{put_map=I,{f,Lbl},Op,Src,Dst,Live,List}|Is], Acc, D) + when Lbl =/= 0 -> + replace(Is, [{I,{f,label(Lbl, D)},Op,Src,Dst,Live,List}|Acc], D); +replace([{get_map_element=I,{f,Lbl},Src,Key,Dst}|Is], Acc, D) when Lbl =/= 0 -> + replace(Is, [{I,{f,label(Lbl, D)},Src,Key,Dst}|Acc], D); replace([I|Is], Acc, D) -> replace(Is, [I|Acc], D); replace([], Acc, _) -> Acc. diff --git a/lib/compiler/src/beam_disasm.erl b/lib/compiler/src/beam_disasm.erl index 1a8bbcee22..e0d0d0fd1d 100644 --- a/lib/compiler/src/beam_disasm.erl +++ b/lib/compiler/src/beam_disasm.erl @@ -365,6 +365,10 @@ disasm_instr(B, Bs, Atoms, Literals) -> disasm_select_inst(select_val, Bs, Atoms, Literals); select_tuple_arity -> disasm_select_inst(select_tuple_arity, Bs, Atoms, Literals); + put_map_assoc -> + disasm_map_inst(put_map_assoc, Bs, Atoms, Literals); + put_map_exact -> + disasm_map_inst(put_map_exact, Bs, Atoms, Literals); _ -> try decode_n_args(Arity, Bs, Atoms, Literals) of {Args, RestBs} -> @@ -395,6 +399,17 @@ disasm_select_inst(Inst, Bs, Atoms, Literals) -> {List, RestBs} = decode_n_args(Len, Bs4, Atoms, Literals), {{Inst, [X,F,{Z,U,List}]}, RestBs}. +disasm_map_inst(Inst, Bs0, Atoms, Literals) -> + {F, Bs1} = decode_arg(Bs0, Atoms, Literals), + {S, Bs2} = decode_arg(Bs1, Atoms, Literals), + {X, Bs3} = decode_arg(Bs2, Atoms, Literals), + {N, Bs4} = decode_arg(Bs3, Atoms, Literals), + {Z, Bs5} = decode_arg(Bs4, Atoms, Literals), + {U, Bs6} = decode_arg(Bs5, Atoms, Literals), + {u, Len} = U, + {List, RestBs} = decode_n_args(Len, Bs6, Atoms, Literals), + {{Inst, [F,S,X,N,{Z,U,List}]}, RestBs}. + %%----------------------------------------------------------------------- %% decode_arg([Byte]) -> {Arg, [Byte]} %% @@ -421,7 +436,7 @@ decode_arg([B|Bs]) -> decode_arg([B|Bs0], Atoms, Literals) -> Tag = decode_tag(B band 2#111), - ?NO_DEBUG('Tag = ~p, B = ~p, Bs = ~p~n', [Tag, B, Bs]), + ?NO_DEBUG('Tag = ~p, B = ~p, Bs = ~p~n', [Tag, B, Bs0]), case Tag of z -> decode_z_tagged(Tag, B, Bs0, Literals); @@ -1119,6 +1134,27 @@ resolve_inst({line,[Index]},_,_,_) -> {line,resolve_arg(Index)}; %% +%% R17A. +%% +resolve_inst({put_map_assoc,Args},_,_,_) -> + [FLbl,Src,Dst,{u,N},{{z,1},{u,_Len},List0}] = Args, + List = resolve_args(List0), + {put_map_assoc,FLbl,Src,Dst,N,{list,List}}; + +resolve_inst({put_map_exact,Args},_,_,_) -> + [FLbl,Src,Dst,{u,N},{{z,1},{u,_Len},List0}] = Args, + List = resolve_args(List0), + {put_map_exact,FLbl,Src,Dst,N,{list,List}}; + +resolve_inst({is_map,Args0},_,_,_) -> + [FLbl|Args] = resolve_args(Args0), + {test, is_map, FLbl, Args}; + +resolve_inst({get_map_element,Args},_,_,_) -> + [FLbl,Src,Key,Dst] = resolve_args(Args), + {get_map_element,FLbl,Src,Key,Dst}; + +%% %% Catches instructions that are not yet handled. %% resolve_inst(X,_,_,_) -> ?exit({resolve_inst,X}). diff --git a/lib/compiler/src/beam_flatten.erl b/lib/compiler/src/beam_flatten.erl index 5603a677e8..534bc6d954 100644 --- a/lib/compiler/src/beam_flatten.erl +++ b/lib/compiler/src/beam_flatten.erl @@ -61,6 +61,10 @@ norm({set,[],[S],put}) -> {put,S}; norm({set,[D],[S],{get_tuple_element,I}}) -> {get_tuple_element,S,I,D}; norm({set,[],[S,D],{set_tuple_element,I}}) -> {set_tuple_element,S,D,I}; norm({set,[D1,D2],[S],get_list}) -> {get_list,S,D1,D2}; +norm({set,[D],[S|Puts],{alloc,R,{put_map,Op,F}}}) -> + {put_map,F,Op,S,D,R,{list,Puts}}; +norm({set,[D],[S],{get_map_element,K,F}}) -> + {get_map_element,F,S,K,D}; norm({set,[],[],remove_message}) -> remove_message; norm({set,[],[],fclearerror}) -> fclearerror; norm({set,[],[],fcheckerror}) -> {fcheckerror,{f,0}}. diff --git a/lib/compiler/src/beam_jump.erl b/lib/compiler/src/beam_jump.erl index d57fb80ac2..1f720b94c3 100644 --- a/lib/compiler/src/beam_jump.erl +++ b/lib/compiler/src/beam_jump.erl @@ -527,6 +527,10 @@ ulbl({bs_init,Lbl,_,_,_,_}, Used) -> mark_used(Lbl, Used); ulbl({bs_put,Lbl,_,_}, Used) -> mark_used(Lbl, Used); +ulbl({put_map,Lbl,_Op,_Src,_Dst,_Live,_List}, Used) -> + mark_used(Lbl, Used); +ulbl({get_map_element,Lbl,_Src,_Key,_Dst}, Used) -> + mark_used(Lbl, Used); ulbl(_, Used) -> Used. mark_used({f,0}, Used) -> Used; diff --git a/lib/compiler/src/beam_split.erl b/lib/compiler/src/beam_split.erl index cacaaebffe..638a4826ea 100644 --- a/lib/compiler/src/beam_split.erl +++ b/lib/compiler/src/beam_split.erl @@ -49,6 +49,13 @@ split_block([{set,[R],As,{bif,N,{f,Lbl}=Fail}}|Is], Bl, Acc) when Lbl =/= 0 -> split_block([{set,[R],As,{alloc,Live,{gc_bif,N,{f,Lbl}=Fail}}}|Is], Bl, Acc) when Lbl =/= 0 -> split_block(Is, [], [{gc_bif,N,Fail,Live,As,R}|make_block(Bl, Acc)]); +split_block([{set,[D],[S|Puts],{alloc,R,{put_map,Op,{f,Lbl}=Fail}}}|Is], + Bl, Acc) when Lbl =/= 0 -> + split_block(Is, [], [{put_map,Fail,Op,S,D,R,{list,Puts}}| + make_block(Bl, Acc)]); +split_block([{set,[D],[S],{get_map_element,K,{f,Lbl}=Fail}}|Is], Bl, Acc) + when Lbl =/= 0 -> + split_block(Is, [], [{get_map_element,Fail,S,K,D}|make_block(Bl, Acc)]); split_block([{set,[R],[],{'catch',L}}|Is], Bl, Acc) -> split_block(Is, [], [{'catch',R,L}|make_block(Bl, Acc)]); split_block([{set,[],[],{line,_}=Line}|Is], Bl, Acc) -> diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl index 36f3200d11..a3f16cfa8f 100644 --- a/lib/compiler/src/beam_utils.erl +++ b/lib/compiler/src/beam_utils.erl @@ -152,6 +152,7 @@ bif_to_test(is_function, [_]=Ops, Fail) -> {test,is_function,Fail,Ops}; bif_to_test(is_function, [_,_]=Ops, Fail) -> {test,is_function2,Fail,Ops}; bif_to_test(is_integer, [_]=Ops, Fail) -> {test,is_integer,Fail,Ops}; bif_to_test(is_list, [_]=Ops, Fail) -> {test,is_list,Fail,Ops}; +bif_to_test(is_map, [_]=Ops, Fail) -> {test,is_map,Fail,Ops}; bif_to_test(is_number, [_]=Ops, Fail) -> {test,is_number,Fail,Ops}; bif_to_test(is_pid, [_]=Ops, Fail) -> {test,is_pid,Fail,Ops}; bif_to_test(is_port, [_]=Ops, Fail) -> {test,is_port,Fail,Ops}; diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index 48f5135aca..97f84da08f 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -865,9 +865,29 @@ valfun_4({bs_final,{f,Fail},Dst}, Vst0) -> valfun_4({bs_final2,Src,Dst}, Vst0) -> assert_term(Src, Vst0), set_type_reg(binary, Dst, Vst0); +%% Map instructions. +valfun_4({put_map_assoc,{f,Fail},Src,Dst,Live,{list,List}}, Vst) -> + verify_put_map(Fail, Src, Dst, Live, List, Vst); +valfun_4({put_map_exact,{f,Fail},Src,Dst,Live,{list,List}}, Vst) -> + verify_put_map(Fail, Src, Dst, Live, List, Vst); +valfun_4({get_map_element,{f,Fail},Src,Key,Dst}, Vst0) -> + assert_term(Src, Vst0), + assert_term(Key, Vst0), + Vst = branch_state(Fail, Vst0), + set_type_reg(term, Dst, Vst); valfun_4(_, _) -> error(unknown_instruction). +verify_put_map(Fail, Src, Dst, Live, List, Vst0) -> + verify_live(Live, Vst0), + verify_y_init(Vst0), + [assert_term(Term, Vst0) || Term <- List], + assert_term(Src, Vst0), + Vst1 = heap_alloc(0, Vst0), + Vst2 = branch_state(Fail, Vst1), + Vst = prune_x_regs(Live, Vst2), + set_type_reg(term, Dst, Vst). + %% %% Common code for validating bs_get* instructions. %% diff --git a/lib/compiler/src/beam_z.erl b/lib/compiler/src/beam_z.erl index 8c6b0c916d..9953a48710 100644 --- a/lib/compiler/src/beam_z.erl +++ b/lib/compiler/src/beam_z.erl @@ -74,6 +74,10 @@ undo_rename({bs_init,F,{I,Extra,U,Flags},Live,[Sz,Src],Dst}) -> {I,F,Sz,Extra,Live,U,Src,Flags,Dst}; undo_rename({bs_init,_,bs_init_writable=I,_,_,_}) -> I; +undo_rename({put_map,Fail,assoc,S,D,R,L}) -> + {put_map_assoc,Fail,S,D,R,L}; +undo_rename({put_map,Fail,exact,S,D,R,L}) -> + {put_map_exact,Fail,S,D,R,L}; undo_rename({select,I,Reg,Fail,List}) -> {I,Reg,Fail,{list,List}}; undo_rename(I) -> I. diff --git a/lib/compiler/src/cerl.erl b/lib/compiler/src/cerl.erl index 4b74d60e9f..60a8559950 100644 --- a/lib/compiler/src/cerl.erl +++ b/lib/compiler/src/cerl.erl @@ -120,7 +120,16 @@ update_c_bitstr/5, update_c_bitstr/6, ann_c_bitstr/5, ann_c_bitstr/6, is_c_bitstr/1, bitstr_val/1, bitstr_size/1, bitstr_bitsize/1, bitstr_unit/1, bitstr_type/1, - bitstr_flags/1]). + bitstr_flags/1, + + %% keep map exports here for now + map_es/1, + update_c_map/2, + ann_c_map/2, + map_pair_op/1,map_pair_key/1,map_pair_val/1, + update_c_map_pair/4, + ann_c_map_pair/4 + ]). -export_type([c_binary/0, c_call/0, c_clause/0, c_cons/0, c_fun/0, c_literal/0, c_module/0, c_tuple/0, c_values/0, c_var/0, cerl/0, var_name/0]). @@ -145,6 +154,8 @@ -type c_let() :: #c_let{}. -type c_letrec() :: #c_letrec{}. -type c_literal() :: #c_literal{}. +-type c_map() :: #c_map{}. +-type c_map_pair() :: #c_map_pair{}. -type c_module() :: #c_module{}. -type c_primop() :: #c_primop{}. -type c_receive() :: #c_receive{}. @@ -155,9 +166,10 @@ -type c_var() :: #c_var{}. -type cerl() :: c_alias() | c_apply() | c_binary() | c_bitstr() - | c_call() | c_case() | c_catch() | c_clause() | c_cons() + | c_call() | c_case() | c_catch() | c_clause() | c_cons() | c_fun() | c_let() | c_letrec() | c_literal() - | c_module() | c_primop() | c_receive() | c_seq() + | c_map() | c_map_pair() + | c_module() | c_primop() | c_receive() | c_seq() | c_try() | c_tuple() | c_values() | c_var(). %% ===================================================================== @@ -250,8 +262,8 @@ -type ctype() :: 'alias' | 'apply' | 'binary' | 'bitrst' | 'call' | 'case' | 'catch' | 'clause' | 'cons' | 'fun' | 'let' | 'letrec' - | 'literal' | 'module' | 'primop' | 'receive' | 'seq' | 'try' - | 'tuple' | 'values' | 'var'. + | 'literal' | 'map' | 'module' | 'primop' | 'receive' | 'seq' + | 'try' | 'tuple' | 'values' | 'var'. -spec type(cerl()) -> ctype(). @@ -268,6 +280,8 @@ type(#c_fun{}) -> 'fun'; type(#c_let{}) -> 'let'; type(#c_letrec{}) -> letrec; type(#c_literal{}) -> literal; +type(#c_map{}) -> map; +type(#c_map_pair{}) -> map_pair; type(#c_module{}) -> module; type(#c_primop{}) -> primop; type(#c_receive{}) -> 'receive'; @@ -1558,6 +1572,34 @@ ann_make_list(_, [], Node) -> %% --------------------------------------------------------------------- +%% maps + +-spec map_es(c_map()) -> [cerl()]. + +map_es(#c_map{es = Es}) -> + Es. + +ann_c_map(As, Es) -> + #c_map{es = Es, anno = As }. + +update_c_map(Old, Es) -> + #c_map{es = Es, anno = get_ann(Old)}. + +map_pair_key(#c_map_pair{key=K}) -> K. +map_pair_val(#c_map_pair{val=V}) -> V. +map_pair_op(#c_map_pair{op=Op}) -> Op. + +-spec ann_c_map_pair([term()], cerl(), cerl(), cerl()) -> + c_map_pair(). + +ann_c_map_pair(As,Op,K,V) -> + #c_map_pair{op=Op, key = K, val=V, anno = As}. + +update_c_map_pair(Old,Op,K,V) -> + #c_map_pair{op=Op, key=K, val=V, anno = get_ann(Old)}. + + +%% --------------------------------------------------------------------- %% @spec c_tuple(Elements::[cerl()]) -> cerl() %% @@ -2945,6 +2987,10 @@ pat_vars(Node, Vs) -> pat_vars(cons_hd(Node), pat_vars(cons_tl(Node), Vs)); tuple -> pat_list_vars(tuple_es(Node), Vs); + map -> + pat_list_vars(map_es(Node), Vs); + map_pair -> + pat_list_vars([map_pair_op(Node),map_pair_key(Node),map_pair_val(Node)],Vs); binary -> pat_list_vars(binary_segments(Node), Vs); bitstr -> @@ -3803,7 +3849,6 @@ data_type(#c_cons{}) -> data_type(#c_tuple{}) -> tuple. - %% @spec data_es(Node::cerl()) -> [cerl()] %% %% @doc Returns the list of subtrees of a data constructor node. If @@ -3835,7 +3880,6 @@ data_es(#c_cons{hd = H, tl = T}) -> data_es(#c_tuple{es = Es}) -> Es. - %% @spec data_arity(Node::cerl()) -> integer() %% %% @doc Returns the number of subtrees of a data constructor @@ -3892,7 +3936,6 @@ ann_make_data(As, {atomic, V}, []) -> #c_literal{val = V, anno = As}; ann_make_data(As, cons, [H, T]) -> ann_c_cons(As, H, T); ann_make_data(As, tuple, Es) -> ann_c_tuple(As, Es). - %% @spec update_data(Old::cerl(), Type::dtype(), %% Elements::[cerl()]) -> cerl() %% @see make_data/2 @@ -4022,6 +4065,10 @@ subtrees(T) -> [[cons_hd(T)], [cons_tl(T)]]; tuple -> [tuple_es(T)]; + map -> + [map_es(T)]; + map_pair -> + [[map_pair_op(T)],[map_pair_key(T)],[map_pair_val(T)]]; 'let' -> [let_vars(T), [let_arg(T)], [let_body(T)]]; seq -> diff --git a/lib/compiler/src/cerl_inline.erl b/lib/compiler/src/cerl_inline.erl index c6de63c69f..3837b57750 100644 --- a/lib/compiler/src/cerl_inline.erl +++ b/lib/compiler/src/cerl_inline.erl @@ -63,7 +63,11 @@ receive_clauses/1, receive_timeout/1, seq_arg/1, seq_body/1, set_ann/2, try_arg/1, try_body/1, try_vars/1, try_evars/1, try_handler/1, tuple_es/1, tuple_arity/1, - type/1, values_es/1, var_name/1]). + type/1, values_es/1, var_name/1, + map_es/1, update_c_map/2, + update_c_map_pair/4, + map_pair_op/1, map_pair_key/1, map_pair_val/1 + ]). -import(lists, [foldl/3, foldr/3, mapfoldl/3, reverse/1]). @@ -128,6 +132,8 @@ weight(call) -> 3; % Assume remote-calls as efficient as `apply'. weight(primop) -> 2; % Assume more efficient than `apply'. weight(binary) -> 4; % Initialisation base cost. weight(bitstr) -> 3; % Coding/decoding a value; like a primop. +weight(map) -> 4; % Initialisation base cost. +weight(map_pair) -> 3; % Coding/decoding a value; like a primop. weight(module) -> 1. % Like a letrec with a constant body %% These "reference" structures are used for variables and function @@ -333,6 +339,8 @@ i(E, Ctxt, Ren, Env, S0) -> i_catch(E, Ctxt, Ren, Env, S); binary -> i_binary(E, Ren, Env, S); + map -> + i_map(E, Ctxt, Ren, Env, S); module -> i_module(E, Ctxt, Ren, Env, S) end @@ -1324,6 +1332,25 @@ i_bitstr(E, Ren, Env, S) -> S3 = count_size(weight(bitstr), S2), {update_c_bitstr(E, Val, Size, Unit, Type, Flags), S3}. +i_map(E, Ctx, Ren, Env, S) -> + %% Visit the segments for value. + {Es, S1} = mapfoldl(fun (E, S) -> + i_map_pair(E, Ctx, Ren, Env, S) + end, + S, map_es(E)), + S2 = count_size(weight(map), S1), + {update_c_map(E, Es), S2}. + +i_map_pair(E, Ctx, Ren, Env, S) -> + %% It is not necessary to visit the Op and Key fields, + %% since these are always literals. + {Val, S1} = i(map_pair_val(E), Ctx, Ren, Env, S), + Op = map_pair_op(E), + Key = map_pair_key(E), + S2 = count_size(weight(map_pair), S1), + {update_c_map_pair(E, Op, Key, Val), S2}. + + %% This is a simplified version of `i_pattern', for lists of parameter %% variables only. It does not modify the state. @@ -1383,6 +1410,14 @@ i_pattern(E, Ren, Env, Ren0, Env0, S) -> S, binary_segments(E)), S2 = count_size(weight(binary), S1), {update_c_binary(E, Es), S2}; + map -> + {Es, S1} = mapfoldl(fun (E, S) -> + i_map_pair_pattern(E, Ren, Env, + Ren0, Env0, S) + end, + S, map_es(E)), + S2 = count_size(weight(map), S1), + {update_c_map(E, Es), S2}; _ -> case is_literal(E) of true -> @@ -1416,6 +1451,15 @@ i_bitstr_pattern(E, Ren, Env, Ren0, Env0, S) -> S3 = count_size(weight(bitstr), S2), {update_c_bitstr(E, Val, Size, Unit, Type, Flags), S3}. +i_map_pair_pattern(E, Ren, Env, Ren0, Env0, S) -> + %% It is not necessary to visit the Op it is always a literal. + %% Same goes for Key + {Val, S1} = i_pattern(map_pair_val(E), Ren, Env, Ren0, Env0, S), + Op = map_pair_op(E), %% should be 'exact' literal + Key = map_pair_key(E), + S2 = count_size(weight(map_pair), S1), + {update_c_map_pair(E, Op, Key, Val), S2}. + %% --------------------------------------------------------------------- %% Other central inlining functions diff --git a/lib/compiler/src/cerl_trees.erl b/lib/compiler/src/cerl_trees.erl index 1e3755025f..2542841eef 100644 --- a/lib/compiler/src/cerl_trees.erl +++ b/lib/compiler/src/cerl_trees.erl @@ -55,7 +55,15 @@ update_c_let/4, update_c_letrec/3, update_c_module/5, update_c_primop/3, update_c_receive/4, update_c_seq/3, update_c_try/6, update_c_tuple/2, update_c_tuple_skel/2, - update_c_values/2, values_es/1, var_name/1]). + update_c_values/2, values_es/1, var_name/1, + + map_es/1, + ann_c_map/2, + update_c_map/2, + map_pair_key/1,map_pair_val/1,map_pair_op/1, + ann_c_map_pair/4, + update_c_map_pair/4 + ]). %% --------------------------------------------------------------------- @@ -129,6 +137,12 @@ map_1(F, T) -> map(F, cons_tl(T))); tuple -> update_c_tuple_skel(T, map_list(F, tuple_es(T))); + map -> + update_c_map(T, map_list(F, map_es(T))); + map_pair -> + update_c_map_pair(T, map(F, map_pair_op(T)), + map(F, map_pair_key(T)), + map(F, map_pair_val(T))); 'let' -> update_c_let(T, map_list(F, let_vars(T)), map(F, let_arg(T)), @@ -235,6 +249,14 @@ fold_1(F, S, T) -> fold(F, fold(F, S, cons_hd(T)), cons_tl(T)); tuple -> fold_list(F, S, tuple_es(T)); + map -> + fold_list(F, S, map_es(T)); + map_pair -> + fold(F, + fold(F, + fold(F, S, map_pair_op(T)), + map_pair_key(T)), + map_pair_val(T)); 'let' -> fold(F, fold(F, fold_list(F, S, let_vars(T)), let_arg(T)), @@ -349,6 +371,14 @@ mapfold(F, S0, T) -> tuple -> {Ts, S1} = mapfold_list(F, S0, tuple_es(T)), F(update_c_tuple_skel(T, Ts), S1); + map -> + {Ts, S1} = mapfold_list(F, S0, map_es(T)), + F(update_c_map(T, Ts), S1); + map_pair -> + {Op, S1} = mapfold(F, S0, map_pair_op(T)), + {Key, S2} = mapfold(F, S1, map_pair_key(T)), + {Val, S3} = mapfold(F, S2, map_pair_val(T)), + F(update_c_map_pair(T,Op,Key,Val), S3); 'let' -> {Vs, S1} = mapfold_list(F, S0, let_vars(T)), {A, S2} = mapfold(F, S1, let_arg(T)), @@ -488,6 +518,10 @@ variables(T, S) -> variables(cons_tl(T), S)); tuple -> vars_in_list(tuple_es(T), S); + map -> + vars_in_list(map_es(T), S); + map_pair -> + vars_in_list([map_pair_op(T),map_pair_key(T), map_pair_val(T)], S); 'let' -> Vs = variables(let_body(T), S), Vs1 = var_list_names(let_vars(T)), @@ -688,6 +722,16 @@ label(T, N, Env) -> {Ts, N1} = label_list(tuple_es(T), N, Env), {As, N2} = label_ann(T, N1), {ann_c_tuple_skel(As, Ts), N2}; + map -> + {Ts, N1} = label_list(map_es(T), N, Env), + {As, N2} = label_ann(T, N1), + {ann_c_map(As, Ts), N2}; + map_pair -> + {Op, N1} = label(map_pair_op(T), N, Env), + {Val, N2} = label(map_pair_key(T), N1, Env), + {Key, N3} = label(map_pair_val(T), N2, Env), + {As, N4} = label_ann(T, N3), + {ann_c_map_pair(As,Op,Key,Val), N4}; 'let' -> {A, N1} = label(let_arg(T), N, Env), {Vs, N2, Env1} = label_vars(let_vars(T), N1, Env), diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index 3db7ffc4d2..0bb4de6f17 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -230,12 +230,25 @@ format_error({undef_parse_transform,M}) -> format_error({core_transform,M,R}) -> io_lib:format("error in core transform '~s': ~tp", [M, R]); format_error({crash,Pass,Reason}) -> - io_lib:format("internal error in ~p;\ncrash reason: ~tp", [Pass,Reason]); + io_lib:format("internal error in ~p;\ncrash reason: ~ts", [Pass,format_error_reason(Reason)]); format_error({bad_return,Pass,Reason}) -> - io_lib:format("internal error in ~p;\nbad return value: ~tp", [Pass,Reason]); + io_lib:format("internal error in ~p;\nbad return value: ~ts", [Pass,format_error_reason(Reason)]); format_error({module_name,Mod,Filename}) -> - io_lib:format("Module name '~s' does not match file name '~ts'", - [Mod,Filename]). + io_lib:format("Module name '~s' does not match file name '~ts'", [Mod,Filename]). + +format_error_reason({Reason, Stack}) when is_list(Stack) -> + StackFun = fun + (escript, run, 2) -> true; + (escript, start, 1) -> true; + (init, start_it, 1) -> true; + (init, start_em, 1) -> true; + (_Mod, _Fun, _Arity) -> false + end, + FormatFun = fun (Term, _) -> io_lib:format("~tp", [Term]) end, + [io_lib:format("~tp", [Reason]),"\n\n", + lib:format_stacktrace(1, erlang:get_stacktrace(), StackFun, FormatFun)]; +format_error_reason(Reason) -> + io_lib:format("~tp", [Reason]). %% The compile state record. -record(compile, {filename="" :: file:filename(), diff --git a/lib/compiler/src/core_lib.erl b/lib/compiler/src/core_lib.erl index 824be9ff7f..f506901099 100644 --- a/lib/compiler/src/core_lib.erl +++ b/lib/compiler/src/core_lib.erl @@ -105,6 +105,10 @@ vu_expr(V, #c_cons{hd=H,tl=T}) -> vu_expr(V, H) orelse vu_expr(V, T); vu_expr(V, #c_tuple{es=Es}) -> vu_expr_list(V, Es); +vu_expr(V, #c_map{es=Es}) -> + vu_expr_list(V, Es); +vu_expr(V, #c_map_pair{key=Key,val=Val}) -> + vu_expr_list(V, [Key,Val]); vu_expr(V, #c_binary{segments=Ss}) -> vu_seg_list(V, Ss); vu_expr(V, #c_fun{vars=Vs,body=B}) -> diff --git a/lib/compiler/src/core_lint.erl b/lib/compiler/src/core_lint.erl index 67d37ff1fc..36165245a6 100644 --- a/lib/compiler/src/core_lint.erl +++ b/lib/compiler/src/core_lint.erl @@ -254,6 +254,10 @@ gexpr(#c_cons{hd=H,tl=T}, Def, _Rt, St) -> gexpr_list([H,T], Def, St); gexpr(#c_tuple{es=Es}, Def, _Rt, St) -> gexpr_list(Es, Def, St); +gexpr(#c_map{es=Es}, Def, _Rt, St) -> + gexpr_list(Es, Def, St); +gexpr(#c_map_pair{key=K,val=V}, Def, _Rt, St) -> + gexpr_list([K,V], Def, St); gexpr(#c_binary{segments=Ss}, Def, _Rt, St) -> gbitstr_list(Ss, Def, St); gexpr(#c_seq{arg=Arg,body=B}, Def, Rt, St0) -> @@ -278,6 +282,7 @@ gexpr(#c_case{arg=Arg,clauses=Cs}, Def, Rt, St0) -> St1 = gbody(Arg, Def, PatCount, St0), clauses(Cs, Def, PatCount, Rt, St1); gexpr(_Core, _, _, St) -> + %%io:fwrite("clint gexpr: ~p~n", [_Core]), add_error({illegal_guard,St#lint.func}, St). %% gexpr_list([Expr], Defined, State) -> State. @@ -303,6 +308,10 @@ expr(#c_cons{hd=H,tl=T}, Def, _Rt, St) -> expr_list([H,T], Def, St); expr(#c_tuple{es=Es}, Def, _Rt, St) -> expr_list(Es, Def, St); +expr(#c_map{es=Es}, Def, _Rt, St) -> + expr_list(Es, Def, St); +expr(#c_map_pair{key=K,val=V},Def,_Rt,St) -> + expr_list([K,V],Def,St); expr(#c_binary{segments=Ss}, Def, _Rt, St) -> bitstr_list(Ss, Def, St); expr(#c_fun{vars=Vs,body=B}, Def, Rt, St0) -> @@ -355,7 +364,7 @@ expr(#c_try{arg=A,vars=Vs,body=B,evars=Evs,handler=H}, Def, Rt, St0) -> {Ens,St5} = variable_list(Evs, St4), body(H, union(Ens, Def), Rt, St5); expr(_Other, _, _, St) -> - %%io:fwrite("clint: ~p~n", [_Other]), + %%io:fwrite("clint expr: ~p~n", [_Other]), add_error({illegal_expr,St#lint.func}, St). %% expr_list([Expr], Defined, State) -> State. @@ -454,13 +463,19 @@ pattern(#c_cons{hd=H,tl=T}, Def, Ps, St) -> pattern_list([H,T], Def, Ps, St); pattern(#c_tuple{es=Es}, Def, Ps, St) -> pattern_list(Es, Def, Ps, St); +pattern(#c_map{es=Es}, Def, Ps, St) -> + pattern_list(Es, Def, Ps, St); +pattern(#c_map_pair{op=#c_literal{val=exact},key=K,val=V},Def,Ps,St) -> + pattern_list([K,V],Def,Ps,St); pattern(#c_binary{segments=Ss}, Def, Ps, St0) -> St = pat_bin_tail_check(Ss, St0), pat_bin(Ss, Def, Ps, St); pattern(#c_alias{var=V,pat=P}, Def, Ps, St0) -> {Vvs,St1} = variable(V, Ps, St0), pattern(P, Def, union(Vvs, Ps), St1); -pattern(_, _, Ps, St) -> {Ps,add_error({not_pattern,St#lint.func}, St)}. +pattern(_Other, _, Ps, St) -> + %%io:fwrite("clint pattern: ~p~n", [_Other]), + {Ps,add_error({not_pattern,St#lint.func}, St)}. pat_var(N, _Def, Ps, St) -> case is_element(N, Ps) of diff --git a/lib/compiler/src/core_parse.hrl b/lib/compiler/src/core_parse.hrl index 0b8f4d8895..d54715ef59 100644 --- a/lib/compiler/src/core_parse.hrl +++ b/lib/compiler/src/core_parse.hrl @@ -96,3 +96,12 @@ -record(c_values, {anno=[], es}). % es :: [Tree] -record(c_var, {anno=[], name :: cerl:var_name()}). + +-record(c_map_pair, {anno=[], + op :: #c_literal{val::'assoc'} | #c_literal{val::'exact'}, + key, + val}). + +-record(c_map, {anno=[], + var=#c_literal{val=[]} :: #c_var{} | #c_literal{}, + es :: [#c_map_pair{}]}). diff --git a/lib/compiler/src/core_parse.yrl b/lib/compiler/src/core_parse.yrl index 4e98a8c2da..b8db0f683a 100644 --- a/lib/compiler/src/core_parse.yrl +++ b/lib/compiler/src/core_parse.yrl @@ -21,6 +21,8 @@ %% Have explicit productions for annotated phrases named anno_XXX. %% This just does an XXX and adds the annotation. +Expect 1. + Nonterminals module_definition module_export module_attribute module_defs @@ -44,6 +46,9 @@ receive_expr timeout try_expr sequence catch_expr variable clause clause_pattern +map_expr map_pairs map_pair map_pair_assoc map_pair_exact +map_pattern map_pair_patterns map_pair_pattern + annotation anno_fun anno_expression anno_expressions anno_variable anno_variables anno_pattern anno_patterns anno_function_name @@ -53,7 +58,7 @@ Terminals %% Separators -'(' ')' '{' '}' '[' ']' '|' ',' '->' '=' '/' '<' '>' ':' '-|' '#' +'(' ')' '{' '}' '[' ']' '|' ',' '->' '=' '/' '<' '>' ':' '-|' '#' '~' '::' %% Keywords (atoms are assumed to always be single-quoted). @@ -166,6 +171,7 @@ anno_patterns -> anno_pattern : ['$1']. other_pattern -> atomic_pattern : '$1'. other_pattern -> tuple_pattern : '$1'. +other_pattern -> map_pattern : '$1'. other_pattern -> cons_pattern : '$1'. other_pattern -> binary_pattern : '$1'. other_pattern -> anno_variable '=' anno_pattern : @@ -176,6 +182,16 @@ atomic_pattern -> atomic_literal : '$1'. tuple_pattern -> '{' '}' : c_tuple([]). tuple_pattern -> '{' anno_patterns '}' : c_tuple('$2'). +map_pattern -> '~' '{' '}' '~' : #c_map{es=[]}. +map_pattern -> '~' '{' map_pair_patterns '}' '~' : + #c_map{es=lists:sort('$3')}. + +map_pair_patterns -> map_pair_pattern : ['$1']. +map_pair_patterns -> map_pair_pattern ',' map_pair_patterns : ['$1' | '$3']. + +map_pair_pattern -> '~' '<' anno_pattern ',' anno_pattern '>' : + #c_map_pair{op=#c_literal{val=exact},key='$3',val='$5'}. + cons_pattern -> '[' anno_pattern tail_pattern : #c_cons{hd='$2',tl='$3'}. @@ -240,6 +256,7 @@ single_expression -> primop_expr : '$1'. single_expression -> try_expr : '$1'. single_expression -> sequence : '$1'. single_expression -> catch_expr : '$1'. +single_expression -> map_expr : '$1'. literal -> atomic_literal : '$1'. literal -> tuple_literal : '$1'. @@ -267,6 +284,22 @@ tail_literal -> ',' literal tail_literal : #c_cons{hd='$2',tl='$3'}. tuple -> '{' '}' : c_tuple([]). tuple -> '{' anno_expressions '}' : c_tuple('$2'). +map_expr -> '~' '{' '}' '~' : #c_map{es=[]}. +map_expr -> '~' '{' map_pairs '}' '~' : #c_map{es='$3'}. +map_expr -> variable '~' '{' '}' '~' : #c_map{var='$1',es=[]}. +map_expr -> variable '~' '{' map_pairs '}' '~' : #c_map{var='$1',es='$4'}. + +map_pairs -> map_pair : ['$1']. +map_pairs -> map_pair ',' map_pairs : ['$1' | '$3']. + +map_pair -> map_pair_assoc : '$1'. +map_pair -> map_pair_exact : '$1'. + +map_pair_assoc -> '::' '<' anno_expression ',' anno_expression'>' : + #c_map_pair{op=#c_literal{val=assoc},key='$3',val='$5'}. +map_pair_exact -> '~' '<' anno_expression ',' anno_expression'>' : + #c_map_pair{op=#c_literal{val=exact},key='$3',val='$5'}. + cons -> '[' anno_expression tail : c_cons('$2', '$3'). tail -> ']' : #c_literal{val=[]}. @@ -381,3 +414,5 @@ Erlang code. tok_val(T) -> element(3, T). tok_line(T) -> element(2, T). + +%% vim: syntax=erlang diff --git a/lib/compiler/src/core_pp.erl b/lib/compiler/src/core_pp.erl index 1f91a52be3..faa26ec6df 100644 --- a/lib/compiler/src/core_pp.erl +++ b/lib/compiler/src/core_pp.erl @@ -161,6 +161,27 @@ format_1(#c_tuple{es=Es}, Ctxt) -> format_hseq(Es, ",", add_indent(Ctxt, 1), fun format/2), $} ]; +format_1(#c_map{var=#c_var{}=Var,es=Es}, Ctxt) -> + [format_1(Var, Ctxt), + "~{", + format_hseq(Es, ",", add_indent(Ctxt, 1), fun format/2), + "}~" + ]; +format_1(#c_map{es=Es}, Ctxt) -> + ["~{", + format_hseq(Es, ",", add_indent(Ctxt, 1), fun format/2), + "}~" + ]; +format_1(#c_map_pair{op=#c_literal{val=assoc},key=K,val=V}, Ctxt) -> + ["::<", + format_hseq([K,V], ",", add_indent(Ctxt, 1), fun format/2), + ">" + ]; +format_1(#c_map_pair{op=#c_literal{val=exact},key=K,val=V}, Ctxt) -> + ["~<", + format_hseq([K,V], ",", add_indent(Ctxt, 1), fun format/2), + ">" + ]; format_1(#c_cons{hd=H,tl=T}, Ctxt) -> Txt = ["["|format(H, add_indent(Ctxt, 1))], [Txt|format_list_tail(T, add_indent(Ctxt, width(Txt, Ctxt)))]; diff --git a/lib/compiler/src/core_scan.erl b/lib/compiler/src/core_scan.erl index a4fe920258..b7799b373a 100644 --- a/lib/compiler/src/core_scan.erl +++ b/lib/compiler/src/core_scan.erl @@ -271,6 +271,8 @@ scan1("->" ++ Cs, Toks, Pos) -> scan1(Cs, [{'->',Pos}|Toks], Pos); scan1("-|" ++ Cs, Toks, Pos) -> scan1(Cs, [{'-|',Pos}|Toks], Pos); +scan1("::" ++ Cs, Toks, Pos) -> + scan1(Cs, [{'::',Pos}|Toks], Pos); scan1([C|Cs], Toks, Pos) -> %Punctuation character P = list_to_atom([C]), scan1(Cs, [{P,Pos}|Toks], Pos); diff --git a/lib/compiler/src/genop.tab b/lib/compiler/src/genop.tab index ebc9b1c85b..79b467f949 100755 --- a/lib/compiler/src/genop.tab +++ b/lib/compiler/src/genop.tab @@ -528,3 +528,11 @@ BEAM_FORMAT_NUMBER=0 # R15A 153: line/1 + +# R16 + +154: put_map_assoc/5 +155: put_map_exact/5 +156: is_map/2 +157: has_map_field/3 +158: get_map_element/4 diff --git a/lib/compiler/src/sys_core_dsetel.erl b/lib/compiler/src/sys_core_dsetel.erl index f6696992b9..60d83763f8 100644 --- a/lib/compiler/src/sys_core_dsetel.erl +++ b/lib/compiler/src/sys_core_dsetel.erl @@ -102,6 +102,13 @@ visit(Env, #c_literal{}=R) -> visit(Env0, #c_tuple{es=Es0}=R) -> {Es1,Env1} = visit_list(Env0, Es0), {R#c_tuple{es=Es1}, Env1}; +visit(Env0, #c_map{es=Es0}=R) -> + {Es1,Env1} = visit_list(Env0, Es0), + {R#c_map{es=Es1}, Env1}; +visit(Env0, #c_map_pair{key=K0,val=V0}=R) -> + {K,Env1} = visit(Env0, K0), + {V,Env2} = visit(Env1, V0), + {R#c_map_pair{key=K,val=V}, Env2}; visit(Env0, #c_cons{hd=H0,tl=T0}=R) -> {H1,Env1} = visit(Env0, H0), {T1,Env2} = visit(Env1, T0), @@ -212,6 +219,11 @@ visit_pat(Env0, #c_var{name=V}, Vs) -> {[V|Vs], dict:store(V, 0, Env0)}; visit_pat(Env0, #c_tuple{es=Es}, Vs) -> visit_pats(Es, Env0, Vs); +visit_pat(Env0, #c_map{es=Es}, Vs) -> + visit_pats(Es, Env0, Vs); +visit_pat(Env0, #c_map_pair{op=#c_literal{val=exact},key=V,val=K}, Vs0) -> + {Vs1, Env1} = visit_pat(Env0, V, Vs0), + visit_pat(Env1, K, Vs1); visit_pat(Env0, #c_cons{hd=H,tl=T}, Vs0) -> {Vs1, Env1} = visit_pat(Env0, H, Vs0), visit_pat(Env1, T, Vs1); diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index a388960312..1cdbac5693 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -246,6 +246,16 @@ expr(#c_tuple{anno=Anno,es=Es0}=Tuple, Ctxt, Sub) -> value -> ann_c_tuple(Anno, Es) end; +expr(#c_map{var=V0,es=Es0}=Map, Ctxt, Sub) -> + Es = pair_list(Es0, Ctxt, Sub), + case Ctxt of + effect -> + add_warning(Map, useless_building), + expr(make_effect_seq(Es, Sub), Ctxt, Sub); + value -> + V = expr(V0, Ctxt, Sub), + Map#c_map{var=V,es=Es} + end; expr(#c_binary{segments=Ss}=Bin0, Ctxt, Sub) -> %% Warn for useless building, but always build the binary %% anyway to preserve a possible exception. @@ -408,6 +418,16 @@ expr(#c_try{anno=A,arg=E0,vars=Vs0,body=B0,evars=Evs0,handler=H0}=Try, _, Sub0) expr_list(Es, Ctxt, Sub) -> [expr(E, Ctxt, Sub) || E <- Es]. +pair_list(Es, Ctxt, Sub) -> + [pair(E, Ctxt, Sub) || E <- Es]. + +pair(#c_map_pair{key=K,val=V}, effect, Sub) -> + make_effect_seq([K,V], Sub); +pair(#c_map_pair{key=K0,val=V0}=Pair, value=Ctxt, Sub) -> + K = expr(K0, Ctxt, Sub), + V = expr(V0, Ctxt, Sub), + Pair#c_map_pair{key=K,val=V}. + bitstr_list(Es, Sub) -> [bitstr(E, Sub) || E <- Es]. @@ -677,7 +697,7 @@ useless_call(effect, #c_call{anno=Anno, useless_call(_, _) -> no. %% make_effect_seq([Expr], Sub) -> #c_seq{}|void() -%% Convert a list of epressions evaluated in effect context to a chain of +%% Convert a list of expressions evaluated in effect context to a chain of %% #c_seq{}. The body in the innermost #c_seq{} will be void(). %% Anything that will not have any effect will be thrown away. @@ -1500,6 +1520,9 @@ pattern(#c_cons{anno=Anno,hd=H0,tl=T0}, Isub, Osub0) -> pattern(#c_tuple{anno=Anno,es=Es0}, Isub, Osub0) -> {Es1,Osub1} = pattern_list(Es0, Isub, Osub0), {ann_c_tuple(Anno, Es1),Osub1}; +pattern(#c_map{anno=Anno,es=Es0}=Map, Isub, Osub0) -> + {Es1,Osub1} = map_pair_pattern_list(Es0, Isub, Osub0), + {Map#c_map{anno=Anno,es=Es1},Osub1}; pattern(#c_binary{segments=V0}=Pat, Isub, Osub0) -> {V1,Osub1} = bin_pattern_list(V0, Isub, Osub0), {Pat#c_binary{segments=V1},Osub1}; @@ -1509,6 +1532,15 @@ pattern(#c_alias{var=V0,pat=P0}=Pat, Isub, Osub0) -> Osub = update_types(V1, [P1], Osub2), {Pat#c_alias{var=V1,pat=P1},Osub}. +map_pair_pattern_list(Ps0, Isub, Osub0) -> + {Ps,{_,Osub}} = mapfoldl(fun map_pair_pattern/2, {Isub,Osub0}, Ps0), + {Ps,Osub}. + +map_pair_pattern(#c_map_pair{op=#c_literal{val=exact},key=K0,val=V0}=Pair, {Isub,Osub0}) -> + {K,Osub1} = pattern(K0, Isub, Osub0), + {V,Osub} = pattern(V0, Isub, Osub1), + {Pair#c_map_pair{key=K,val=V},{Isub,Osub}}. + bin_pattern_list(Ps0, Isub, Osub0) -> {Ps,{_,Osub}} = mapfoldl(fun bin_pattern/2, {Isub,Osub0}, Ps0), {Ps,Osub}. @@ -2987,6 +3019,9 @@ format_error(result_ignored) -> "(suppress the warning by assigning the expression to the _ variable)"; format_error(useless_building) -> "a term is constructed, but never used"; +format_error({map_pair_key_overloaded,K}) -> + M = io_lib:format("the key ~p is used multiple times in map value association",[K]), + flatten(M); format_error(bin_opt_alias) -> "INFO: the '=' operator will prevent delayed sub binary optimization"; format_error(bin_partition) -> diff --git a/lib/compiler/src/sys_pre_expand.erl b/lib/compiler/src/sys_pre_expand.erl index 48d9c16718..9998043013 100644 --- a/lib/compiler/src/sys_pre_expand.erl +++ b/lib/compiler/src/sys_pre_expand.erl @@ -228,6 +228,13 @@ pattern({cons,Line,H,T}, St0) -> pattern({tuple,Line,Ps}, St0) -> {TPs,St1} = pattern_list(Ps, St0), {{tuple,Line,TPs},St1}; +pattern({map,Line,Ps}, St0) -> + {TPs,St1} = pattern_list(Ps, St0), + {{map,Line,TPs},St1}; +pattern({map_field_exact,Line,K0,V0}, St0) -> + {K,St1} = pattern(K0, St0), + {V,St2} = pattern(V0, St1), + {{map_field_exact,Line,K,V},St2}; %%pattern({struct,Line,Tag,Ps}, St0) -> %% {TPs,TPsvs,St1} = pattern_list(Ps, St0), %% {{tuple,Line,[{atom,Line,Tag}|TPs]},TPsvs,St1}; @@ -321,6 +328,20 @@ expr({tuple,Line,Es0}, St0) -> %%expr({struct,Line,Tag,Es0}, Vs, St0) -> %% {Es1,Esvs,Esus,St1} = expr_list(Es0, Vs, St0), %% {{tuple,Line,[{atom,Line,Tag}|Es1]},Esvs,Esus,St1}; +expr({map,Line,Es0}, St0) -> + {Es1,St1} = expr_list(Es0, St0), + {{map,Line,Es1},St1}; +expr({map,Line,Var,Es0}, St0) -> + {Es1,St1} = expr_list(Es0, St0), + {{map,Line,Var,Es1},St1}; +expr({map_field_assoc,Line,K0,V0}, St0) -> + {K,St1} = expr(K0, St0), + {V,St2} = expr(V0, St1), + {{map_field_assoc,Line,K,V},St2}; +expr({map_field_exact,Line,K0,V0}, St0) -> + {K,St1} = expr(K0, St0), + {V,St2} = expr(V0, St1), + {{map_field_exact,Line,K,V},St2}; expr({bin,Line,Es0}, St0) -> {Es1,St1} = expr_bin(Es0, St0), {{bin,Line,Es1},St1}; diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl index f534500671..c8735a76e8 100644 --- a/lib/compiler/src/v3_codegen.erl +++ b/lib/compiler/src/v3_codegen.erl @@ -210,6 +210,8 @@ need_heap_0([], H, Acc) -> need_heap_1(#l{ke={set,_,{binary,_}},i=I}, H) -> {need_heap_need(I, H),0}; +need_heap_1(#l{ke={set,_,{map,_,_}},i=I}, H) -> + {need_heap_need(I, H),0}; need_heap_1(#l{ke={set,_,Val}}, H) -> %% Just pass through adding to needed heap. {[],H + case Val of @@ -453,8 +455,11 @@ basic_block([Le|Les], Acc) -> end; no_block -> {reverse(Acc, [Le]),Les} end. + +%% sets that may garbage collect are not allowed in basic blocks. collect_block({set,_,{binary,_}}) -> no_block; +collect_block({set,_,{map,_,_}}) -> no_block; collect_block({set,_,_}) -> include; collect_block({call,{var,_}=Var,As,_Rs}) -> {block_end,As++[Var]}; collect_block({call,Func,As,_Rs}) -> {block_end,As++func_vars(Func)}; @@ -594,14 +599,13 @@ top_level_block(Keis, Bef, MaxRegs, _St) -> %% number to the outer catch, which is wrong. turn_yregs(0, Tp, _) -> Tp; -turn_yregs(El, Tp, MaxY) when element(1, element(El, Tp)) =:= yy -> - turn_yregs(El-1, setelement(El, Tp, {y,MaxY-element(2, element(El, Tp))}), MaxY); -turn_yregs(El, Tp, MaxY) when is_list(element(El, Tp)) -> - New = map(fun ({yy,YY}) -> {y,MaxY-YY}; - (Other) -> Other end, element(El, Tp)), - turn_yregs(El-1, setelement(El, Tp, New), MaxY); turn_yregs(El, Tp, MaxY) -> - turn_yregs(El-1, Tp, MaxY). + turn_yregs(El-1,setelement(El,Tp,turn_yreg(element(El,Tp),MaxY)),MaxY). + +turn_yreg({yy,YY},MaxY) -> {y,MaxY-YY}; +turn_yreg({list,Ls},MaxY) -> {list, turn_yreg(Ls,MaxY)}; +turn_yreg(Ts,MaxY) when is_list(Ts) -> [turn_yreg(T,MaxY)||T<-Ts]; +turn_yreg(Other,_MaxY) -> Other. %% select_cg(Sclause, V, TypeFail, ValueFail, StackReg, State) -> %% {Is,StackReg,State}. @@ -623,6 +627,8 @@ select_cg(#l{ke={type_clause,bin_int,S}}, {var,V}, Tf, _Vf, Bef, St) -> select_bin_segs(S, V, Tf, Bef, St); select_cg(#l{ke={type_clause,bin_end,[S]}}, {var,V}, Tf, _Vf, Bef, St) -> select_bin_end(S, V, Tf, Bef, St); +select_cg(#l{ke={type_clause,map,S}}, {var,V}, Tf, Vf, Bef, St) -> + select_map(S, V, Tf, Vf, Bef, St); select_cg(#l{ke={type_clause,Type,Scs}}, {var,V}, Tf, Vf, Bef, St0) -> {Vis,{Aft,St1}} = mapfoldl(fun (S, {Int,Sta}) -> @@ -637,6 +643,10 @@ select_val_cg(tuple, R, [Arity,{f,Lbl}], Tf, Vf, [{label,Lbl}|Sis]) -> [{test,is_tuple,{f,Tf},[R]},{test,test_arity,{f,Vf},[R,Arity]}|Sis]; select_val_cg(tuple, R, Vls, Tf, Vf, Sis) -> [{test,is_tuple,{f,Tf},[R]},{select_tuple_arity,R,{f,Vf},{list,Vls}}|Sis]; +select_val_cg(map, R, [_Val,{f,Lbl}], Fail, Fail, [{label,Lbl}|Sis]) -> + [{test,is_map,{f,Fail},[R]}|Sis]; +select_val_cg(map, R, [_Val,{f,Lbl}|_], Tf, _Vf, [{label,Lbl}|Sis]) -> + [{test,is_map,{f,Tf},[R]}|Sis]; select_val_cg(Type, R, [Val, {f,Lbl}], Fail, Fail, [{label,Lbl}|Sis]) -> [{test,is_eq_exact,{f,Fail},[R,{Type,Val}]}|Sis]; select_val_cg(Type, R, [Val, {f,Lbl}], Tf, Vf, [{label,Lbl}|Sis]) -> @@ -915,6 +925,36 @@ select_extract_tuple(Src, Vs, I, Vdb, Bef, St) -> {Es,{Aft,_}} = flatmapfoldl(F, {Bef,0}, Vs), {Es,Aft,St}. +select_map(Scs, V, Tf, Vf, Bef, St0) -> + Reg = fetch_var(V, Bef), + {Is,Aft,St1} = + match_fmf(fun(#l{ke={val_clause,{map,Es},B},i=I,vdb=Vdb}, Fail, St1) -> + select_map_val(V, Es, B, Fail, I, Vdb, Bef, St1) + end, Vf, St0, Scs), + {[{test,is_map,{f,Tf},[Reg]}|Is],Aft,St1}. + +select_map_val(V, Es, B, Fail, I, Vdb, Bef, St0) -> + {Eis,Int,St1} = select_extract_map(V, Es, Fail, I, Vdb, Bef, St0), + {Bis,Aft,St2} = match_cg(B, Fail, Int, St1), + {Eis++Bis,Aft,St2}. + +select_extract_map(Src, Vs, Fail, I, Vdb, Bef, St) -> + F = fun ({map_pair,Key,{var,V}}, Int0) -> + Rsrc = fetch_var(Src, Int0), + case vdb_find(V, Vdb) of + {V,_,L} when L =< I -> + {[{test,has_map_field,{f,Fail},[Rsrc,Key]}],Int0}; + _Other -> + Reg1 = put_reg(V, Int0#sr.reg), + Int1 = Int0#sr{reg=Reg1}, + {[{get_map_element,{f,Fail}, + Rsrc,Key,fetch_reg(V, Reg1)}], + Int1} + end + end, + {Es,Aft} = flatmapfoldl(F, Bef, Vs), + {Es,Aft,St}. + select_extract_cons(Src, [{var,Hd}, {var,Tl}], I, Vdb, Bef, St) -> {Es,Aft} = case {vdb_find(Hd, Vdb), vdb_find(Tl, Vdb)} of {{_,_,Lhd}, {_,_,Ltl}} when Lhd =< I, Ltl =< I -> @@ -1408,7 +1448,7 @@ catch_cg(C, {var,R}, Le, Vdb, Bef, St0) -> %% annotation must reflect this and make sure that the return %% variable is allocated first. %% -%% put_list for constructing a cons is an atomic instruction +%% put_list and put_map are atomic instructions, both of %% which can safely resuse one of the source registers as target. set_cg([{var,R}], {cons,Es}, Le, Vdb, Bef, St) -> @@ -1448,6 +1488,55 @@ set_cg([{var,R}], {binary,Segs}, Le, Vdb, Bef, %% Now generate the complete code for constructing the binary. Code = cg_binary(PutCode, Target, Temp, Fail, MaxRegs, Le#l.a), {Sis++Code,Aft,St}; +set_cg([{var,R}], {map,SrcMap,Es0}, Le, Vdb, Bef, + #cg{in_catch=InCatch,bfail=Bfail}=St) -> + Fail = {f,Bfail}, + {Sis,Int0} = + case InCatch of + true -> adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb); + false -> {[],Bef} + end, + Line = line(Le#l.a), + SrcReg = case SrcMap of + {var,SrcVar} -> fetch_var(SrcVar, Int0); + _ -> SrcMap + end, + {Assoc,Exact} = + try + cg_map_pairs(Es0) + catch + throw:badarg -> + {[],[{{float,0.0},{atom,badarg}}, + {{integer,0},{atom,badarg}}]} + end, + F = fun ({K,{var,V}}) -> [K,fetch_var(V, Int0)]; + ({K,E}) -> [K,E] + end, + AssocList = flatmap(F, Assoc), + ExactList = flatmap(F, Exact), + Live0 = max_reg(Bef#sr.reg), + Int1 = clear_dead(Int0, Le#l.i, Vdb), + Aft = Bef#sr{reg=put_reg(R, Int1#sr.reg)}, + Target = fetch_reg(R, Aft#sr.reg), + Code = [Line] ++ + case {AssocList,ExactList} of + {[_|_],[]} -> + [{put_map_assoc,Fail,SrcReg,Target,Live0,{list,AssocList}}]; + {[_|_],[_|_]} -> + Live = case Target of + {x,TargetX} when TargetX =:= Live0 -> + Live0 + 1; + _ -> + Live0 + end, + [{put_map_assoc,Fail,SrcReg,Target,Live0,{list,AssocList}}, + {put_map_exact,Fail,Target,Target,Live,{list,ExactList}}]; + {[],[_|_]} -> + [{put_map_exact,Fail,SrcReg,Target,Live0,{list,ExactList}}]; + {[],[]} -> + [{put_map_assoc,Fail,SrcReg,Target,Live0,{list,[]}}] + end, + {Sis++Code,Aft,St}; set_cg([{var,R}], Con, Le, Vdb, Bef, St) -> %% Find a place for the return register first. Int = Bef#sr{reg=put_reg(R, Bef#sr.reg)}, @@ -1460,6 +1549,71 @@ set_cg([{var,R}], Con, Le, Vdb, Bef, St) -> end, {Ais,clear_dead(Int, Le#l.i, Vdb),St}. +%% cg_map_pairs(MapPairs) -> {Assoc,Exact} +%% Assoc = Exact = [{K,V}] +%% +%% Remove multiple assignments to the same key, and return +%% one list key-value list with all keys that may or may not exist +%% (Assoc), and one with keys that must exist (Exact). +%% + +cg_map_pairs(Es0) -> + Es = cg_map_pairs_1(Es0, 0), + R0 = sofs:relation(Es), + R1 = sofs:relation_to_family(R0), + R2 = sofs:to_external(R1), + + %% R2 is now [{KeyValue,[{Order,Op,OriginalKey,Value}]}] + R3 = [begin + %% The value for the last pair determines the value. + {_,_,_,V} = lists:last(Vs), + {Op,{_,SortOrder}=K} = map_pair_op_and_key(Vs), + {Op,{SortOrder,K,V}} + end || {_,Vs} <- R2], + + %% R3 is now [{Op,{Key,Value}}] + R = termsort(R3), + + %% R4 is now sorted with all alloc first in the list, followed by + %% all exact. + {Assoc,Exact} = lists:partition(fun({Op,_}) -> Op =:= assoc end, R), + {[{K,V} || {_,{_,K,V}} <- Assoc], + [{K,V} || {_,{_,K,V}} <- Exact]}. + +cg_map_pairs_1([{map_pair_assoc,{_,Kv}=K,V}|T], Order) -> + [{Kv,{Order,assoc,K,V}}|cg_map_pairs_1(T, Order+1)]; +cg_map_pairs_1([{map_pair_exact,{_,Kv}=K,V}|T], Order) -> + [{Kv,{Order,exact,K,V}}|cg_map_pairs_1(T, Order+1)]; +cg_map_pairs_1([], _) -> []. + +%% map_pair_op_and_key({_,Op,K,_}) -> {Operator,Key} +%% Determine the operator and key to use. Throw a 'badarg' +%% exception if there are contradictory exact updates. + +map_pair_op_and_key(L) -> + case [K || {_,exact,K,_} <- L] of + [K] -> + %% There is a single ':=' operator. Use that key. + {exact,K}; + [K|T] -> + %% There is more than one ':=' operator. All of them + %% must have the same key. + case lists:all(fun(E) -> E =:= K end, T) of + true -> + {exact,K}; + false -> + %% Some keys are different, e.g. 1 and 1.0. + throw(badarg) + end; + [] -> + %% Only '=>' operators. Use the first key in the list. + [{_,assoc,K,_}|_] = L, + {assoc,K} + end. + +termsort(Ls) -> + lists:sort(fun(A,B) -> erts_internal:cmp_term(A,B) < 0 end, Ls). + %%% %%% Code generation for constructing binaries. %%% diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl index a5f31f3844..e30bfa729c 100644 --- a/lib/compiler/src/v3_core.erl +++ b/lib/compiler/src/v3_core.erl @@ -487,6 +487,17 @@ expr({tuple,L,Es0}, St0) -> {Es1,Eps,St1} = safe_list(Es0, St0), A = lineno_anno(L, St1), {ann_c_tuple(A, Es1),Eps,St1}; +expr({map,L,Es0}, St0) -> + % erl_lint should make sure only #{ K => V } are allowed + % in map construction. + {Es1,Eps,St1} = map_pair_list(Es0, St0), + A = lineno_anno(L, St1), + {#c_map{anno=A,es=Es1},Eps,St1}; +expr({map,L,M0,Es0}, St0) -> + {M1,Mps,St1} = safe(M0, St0), + {Es1,Eps,St2} = map_pair_list(Es0, St1), + A = lineno_anno(L, St2), + {#c_map{anno=A,var=M1,es=Es1},Mps++Eps,St2}; expr({bin,L,Es0}, St0) -> try expr_bin(Es0, lineno_anno(L, St0), St0) of {_,_,_}=Res -> Res @@ -695,6 +706,21 @@ make_bool_switch_guard(L, E, V, T, F) -> {clause,NegL,[V],[],[V]} ]}. +map_pair_list(Es, St) -> + foldr(fun + ({map_field_assoc,L,K0,V0}, {Ces,Esp,St0}) -> + {K,Ep0,St1} = safe(K0, St0), + {V,Ep1,St2} = safe(V0, St1), + A = lineno_anno(L, St2), + Pair = #c_map_pair{op=#c_literal{val=assoc},anno=A,key=K,val=V}, + {[Pair|Ces],Ep0 ++ Ep1 ++ Esp,St2}; + ({map_field_exact,L,K0,V0}, {Ces,Esp,St0}) -> + {K,Ep0,St1} = safe(K0, St0), + {V,Ep1,St2} = safe(V0, St1), + A = lineno_anno(L, St2), + Pair = #c_map_pair{op=#c_literal{val=exact},anno=A,key=K,val=V}, + {[Pair|Ces],Ep0 ++ Ep1 ++ Esp,St2} + end, {[],[],St}, Es). %% try_exception([ExcpClause], St) -> {[ExcpVar],Handler,St}. @@ -1478,6 +1504,26 @@ pattern({cons,L,H,T}, St) -> ann_c_cons(lineno_anno(L, St), pattern(H, St), pattern(T, St)); pattern({tuple,L,Ps}, St) -> ann_c_tuple(lineno_anno(L, St), pattern_list(Ps, St)); +pattern({map,L,Ps}, St) -> + #c_map{anno=lineno_anno(L, St), es=sort(pattern_list(Ps, St))}; +pattern({map_field_exact,L,K,V}, St) -> + %% FIXME: Better way to construct literals? or missing case + %% {Key,_,_} = expr(K, St), + Key = case K of + {bin,L,Es0} -> + case constant_bin(Es0) of + error -> + throw(badmatch); + Bin -> + #c_literal{anno=lineno_anno(L,St),val=Bin} + end; + _ -> + pattern(K,St) + end, + #c_map_pair{anno=lineno_anno(L, St), + op=#c_literal{val=exact}, + key=Key, + val=pattern(V, St)}; pattern({bin,L,Ps}, St) -> %% We don't create a #ibinary record here, since there is %% no need to hold any used/new annotations in a pattern. @@ -1823,6 +1869,12 @@ upattern(#c_cons{hd=H0,tl=T0}=Cons, Ks, St0) -> upattern(#c_tuple{es=Es0}=Tuple, Ks, St0) -> {Es1,Esg,Esv,Eus,St1} = upattern_list(Es0, Ks, St0), {Tuple#c_tuple{es=Es1},Esg,Esv,Eus,St1}; +upattern(#c_map{es=Es0}=Map, Ks, St0) -> + {Es1,Esg,Esv,Eus,St1} = upattern_list(Es0, Ks, St0), + {Map#c_map{es=Es1},Esg,Esv,Eus,St1}; +upattern(#c_map_pair{op=#c_literal{val=exact},val=V0}=MapPair, Ks, St0) -> + {V,Vg,Vv,Vu,St1} = upattern(V0, Ks, St0), + {MapPair#c_map_pair{val=V},Vg,Vv,Vu,St1}; upattern(#c_binary{segments=Es0}=Bin, Ks, St0) -> {Es1,Esg,Esv,Eus,St1} = upat_bin(Es0, Ks, St0), {Bin#c_binary{segments=Es1},Esg,Esv,Eus,St1}; @@ -2152,6 +2204,9 @@ is_simple(#c_literal{}) -> true; is_simple(#c_cons{hd=H,tl=T}) -> is_simple(H) andalso is_simple(T); is_simple(#c_tuple{es=Es}) -> is_simple_list(Es); +is_simple(#c_map{es=Es}) -> is_simple_list(Es); +is_simple(#c_map_pair{key=K,val=V}) -> + is_simple(K) andalso is_simple(V); is_simple(_) -> false. -spec is_simple_list([cerl:cerl()]) -> boolean(). diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl index 65f1251099..9a2b1605ad 100644 --- a/lib/compiler/src/v3_kernel.erl +++ b/lib/compiler/src/v3_kernel.erl @@ -272,6 +272,10 @@ expr(#c_cons{anno=A,hd=Ch,tl=Ct}, Sub, St0) -> expr(#c_tuple{anno=A,es=Ces}, Sub, St0) -> {Kes,Ep,St1} = atomic_list(Ces, Sub, St0), {#k_tuple{anno=A,es=Kes},Ep,St1}; +expr(#c_map{anno=A,var=Var0,es=Ces}, Sub, St0) -> + {Var,[],St1} = expr(Var0, Sub, St0), + {Kes,Ep,St2} = map_pairs(Ces, Sub, St1), + {#k_map{anno=A,var=Var,es=Kes},Ep,St2}; expr(#c_binary{anno=A,segments=Cv}, Sub, St0) -> try atomic_bin(Cv, Sub, St0) of {Kv,Ep,St1} -> @@ -493,6 +497,16 @@ translate_match_fail_1(Anno, As, Sub, #kern{ff=FF}) -> translate_fc(Args) -> [#c_literal{val=function_clause},make_list(Args)]. +%% FIXME: Not completed +map_pairs(Es, Sub, St) -> + foldr(fun + (#c_map_pair{op=#c_literal{val=Op},key=K0,val=V0}, {Kes,Esp,St0}) when + Op =:= assoc; Op =:= exact -> %% assert Op + {K,[],St1} = expr(K0, Sub, St0), + {V,Ep,St2} = atomic(V0, Sub, St1), + {[#k_map_pair{op=Op,key=K,val=V}|Kes],Ep ++ Esp,St2} + end, {[],[],St}, Es). + %% call_type(Module, Function, Arity) -> call | bif | apply | error. %% Classify the call. call_type(#c_literal{val=M}, #c_literal{val=F}, Ar) when is_atom(M), is_atom(F) -> @@ -648,6 +662,13 @@ pattern(#c_cons{anno=A,hd=Ch,tl=Ct}, Isub, Osub0, St0) -> pattern(#c_tuple{anno=A,es=Ces}, Isub, Osub0, St0) -> {Kes,Osub1,St1} = pattern_list(Ces, Isub, Osub0, St0), {#k_tuple{anno=A,es=Kes},Osub1,St1}; +pattern(#c_map{anno=A,es=Ces}, Isub, Osub0, St0) -> + {Kes,Osub1,St1} = pattern_list(Ces, Isub, Osub0, St0), + {#k_map{anno=A,es=Kes},Osub1,St1}; +pattern(#c_map_pair{op=#c_literal{val=exact},anno=A,key=Ck,val=Cv},Isub, Osub0, St0) -> + {Kk,Osub1,St1} = pattern(Ck, Isub, Osub0, St0), + {Kv,Osub2,St2} = pattern(Cv, Isub, Osub1, St1), + {#k_map_pair{anno=A,op=exact,key=Kk,val=Kv},Osub2,St2}; pattern(#c_binary{anno=A,segments=Cv}, Isub, Osub0, St0) -> {Kv,Osub1,St1} = pattern_bin(Cv, Isub, Osub0, St0), {#k_binary{anno=A,segs=Kv},Osub1,St1}; @@ -1015,7 +1036,8 @@ match_con_1([U|_Us] = L, Cs, Def, St0) -> %% Extract clauses for different constructors (types). %%ok = io:format("match_con ~p~n", [Cs]), Ttcs = select_types([k_binary], Cs) ++ select_bin_con(Cs) ++ - select_types([k_cons,k_tuple,k_atom,k_float,k_int,k_nil,k_literal], Cs), + select_types([k_cons,k_tuple,k_map,k_atom,k_float,k_int, + k_nil,k_literal], Cs), %%ok = io:format("ttcs = ~p~n", [Ttcs]), {Scs,St1} = mapfoldl(fun ({T,Tcs}, St) -> @@ -1251,10 +1273,9 @@ group_value(k_cons, Cs) -> [Cs]; %These are single valued group_value(k_nil, Cs) -> [Cs]; group_value(k_binary, Cs) -> [Cs]; group_value(k_bin_end, Cs) -> [Cs]; -group_value(k_bin_seg, Cs) -> - group_bin_seg(Cs); -group_value(k_bin_int, Cs) -> - [Cs]; +group_value(k_bin_seg, Cs) -> group_bin_seg(Cs); +group_value(k_bin_int, Cs) -> [Cs]; +group_value(k_map, Cs) -> group_map(Cs); group_value(_, Cs) -> %% group_value(Cs). Cd = foldl(fun (C, Gcs0) -> dict:append(clause_val(C), C, Gcs0) end, @@ -1267,6 +1288,12 @@ group_bin_seg([C1|Cs]) -> [[C1|More]|group_bin_seg(Rest)]; group_bin_seg([]) -> []. +group_map([C1|Cs]) -> + V1 = clause_val(C1), + {More,Rest} = splitwith(fun (C) -> clause_val(C) =:= V1 end, Cs), + [[C1|More]|group_map(Rest)]; +group_map([]) -> []. + %% Profiling shows that this quadratic implementation account for a big amount %% of the execution time if there are many values. % group_value([C|Cs]) -> @@ -1315,6 +1342,13 @@ get_match(#k_bin_int{}=BinInt, St0) -> get_match(#k_tuple{es=Es}, St0) -> {Mes,St1} = new_vars(length(Es), St0), {#k_tuple{es=Mes},Mes,St1}; +get_match(#k_map{es=Es0}, St0) -> + {Mes,St1} = new_vars(length(Es0), St0), + {Es,_} = mapfoldl(fun + (#k_map_pair{}=Pair, [V|Vs]) -> + {Pair#k_map_pair{val=V},Vs} + end, Mes, Es0), + {#k_map{es=Es},Mes,St1}; get_match(M, St) -> {M,[],St}. @@ -1331,7 +1365,12 @@ new_clauses(Cs0, U, St) -> [S,N|As]; #k_bin_int{next=N} -> [N|As]; - _Other -> As + #k_map{es=Es} -> + Vals = [V || + #k_map_pair{op=exact,val=V} <- Es], + Vals ++ As; + _Other -> + As end, Vs = arg_alias(Arg), Osub1 = foldl(fun (#k_var{name=V}, Acc) -> @@ -1406,6 +1445,7 @@ arg_con(Arg) -> #k_nil{} -> k_nil; #k_cons{} -> k_cons; #k_tuple{} -> k_tuple; + #k_map{} -> k_map; #k_binary{} -> k_binary; #k_bin_end{} -> k_bin_end; #k_bin_seg{} -> k_bin_seg; @@ -1426,7 +1466,15 @@ arg_val(Arg, C) -> {#k_var{name=get_vsub(V, Isub)},U,T,Fs}; _ -> {set_kanno(S, []),U,T,Fs} - end + end; + #k_map{es=Es} -> + Keys = [begin + #k_map_pair{op=exact,key=#k_literal{val=Key}} = Pair, + Key + end || Pair <- Es], + %% multiple keys may have the same name + %% do not use ordsets + lists:sort(Keys) end. %% ubody_used_vars(Expr, State) -> [UsedVar] @@ -1795,6 +1843,10 @@ lit_vars(#k_atom{}) -> []; lit_vars(#k_nil{}) -> []; lit_vars(#k_cons{hd=H,tl=T}) -> union(lit_vars(H), lit_vars(T)); +lit_vars(#k_map{var=Var,es=Es}) -> + lit_list_vars([Var|Es]); +lit_vars(#k_map_pair{key=K,val=V}) -> + union(lit_vars(K), lit_vars(V)); lit_vars(#k_binary{segs=V}) -> lit_vars(V); lit_vars(#k_bin_end{}) -> []; lit_vars(#k_bin_seg{size=Size,seg=S,next=N}) -> @@ -1830,7 +1882,11 @@ pat_vars(#k_bin_int{size=Size}) -> {U,[]}; pat_vars(#k_bin_end{}) -> {[],[]}; pat_vars(#k_tuple{es=Es}) -> - pat_list_vars(Es). + pat_list_vars(Es); +pat_vars(#k_map{es=Es}) -> + pat_list_vars(Es); +pat_vars(#k_map_pair{op=exact,val=V}) -> + pat_vars(V). pat_list_vars(Ps) -> foldl(fun (P, {Used0,New0}) -> diff --git a/lib/compiler/src/v3_kernel.hrl b/lib/compiler/src/v3_kernel.hrl index fb8baf398b..c7886a070d 100644 --- a/lib/compiler/src/v3_kernel.hrl +++ b/lib/compiler/src/v3_kernel.hrl @@ -38,6 +38,8 @@ -record(k_nil, {anno=[]}). -record(k_tuple, {anno=[],es}). +-record(k_map, {anno=[],var,es}). +-record(k_map_pair, {anno=[],op,key,val}). -record(k_cons, {anno=[],hd,tl}). -record(k_binary, {anno=[],segs}). -record(k_bin_seg, {anno=[],size,unit,type,flags,seg,next}). diff --git a/lib/compiler/src/v3_kernel_pp.erl b/lib/compiler/src/v3_kernel_pp.erl index e363a5387a..edbd3f74f8 100644 --- a/lib/compiler/src/v3_kernel_pp.erl +++ b/lib/compiler/src/v3_kernel_pp.erl @@ -104,6 +104,21 @@ format_1(#k_tuple{es=Es}, Ctxt) -> format_hseq(Es, ",", ctxt_bump_indent(Ctxt, 1), fun format/2), $} ]; +format_1(#k_map{var=#k_var{}=Var,es=Es}, Ctxt) -> + [$~,${, + format_hseq(Es, ",", ctxt_bump_indent(Ctxt, 1), fun format/2), + " | ",format_1(Var, Ctxt), + $},$~ + ]; +format_1(#k_map{es=Es}, Ctxt) -> + [$~,${, + format_hseq(Es, ",", ctxt_bump_indent(Ctxt, 1), fun format/2), + $},$~ + ]; +format_1(#k_map_pair{op=assoc,key=K,val=V}, Ctxt) -> + ["~<",format(K, Ctxt),",",format(V, Ctxt),">"]; +format_1(#k_map_pair{op=exact,key=K,val=V}, Ctxt) -> + ["::<",format(K, Ctxt),",",format(V, Ctxt),">"]; format_1(#k_binary{segs=S}, Ctxt) -> ["#<",format(S, ctxt_bump_indent(Ctxt, 2)),">#"]; format_1(#k_bin_seg{next=Next}=S, Ctxt) -> diff --git a/lib/compiler/src/v3_life.erl b/lib/compiler/src/v3_life.erl index 2cc3493570..ae928e955c 100644 --- a/lib/compiler/src/v3_life.erl +++ b/lib/compiler/src/v3_life.erl @@ -323,7 +323,9 @@ type(k_tuple) -> tuple; type(k_binary) -> binary; type(k_bin_seg) -> bin_seg; type(k_bin_int) -> bin_int; -type(k_bin_end) -> bin_end. +type(k_bin_end) -> bin_end; +type(k_map) -> map; +type(k_map_pair) -> map_pair. %% variable(Klit) -> Lit. %% var_list([Klit]) -> [Lit]. @@ -365,6 +367,12 @@ literal(#k_bin_end{}, Ctxt) -> {bin_end,Ctxt}; literal(#k_tuple{es=Es}, Ctxt) -> {tuple,literal_list(Es, Ctxt)}; +literal(#k_map{var=Var,es=Es}, Ctxt) -> + {map,literal(Var, Ctxt),literal_list(Es, Ctxt)}; +literal(#k_map_pair{op=assoc,key=K,val=V}, Ctxt) -> + {map_pair_assoc,literal(K, Ctxt),literal(V, Ctxt)}; +literal(#k_map_pair{op=exact,key=K,val=V}, Ctxt) -> + {map_pair_exact,literal(K, Ctxt),literal(V, Ctxt)}; literal(#k_literal{val=V}, _Ctxt) -> {literal,V}. @@ -393,7 +401,11 @@ literal2(#k_bin_int{size=S,unit=U,flags=Fs,val=Int,next=N}, Ctxt) -> literal2(#k_bin_end{}, Ctxt) -> {bin_end,Ctxt}; literal2(#k_tuple{es=Es}, Ctxt) -> - {tuple,literal_list2(Es, Ctxt)}. + {tuple,literal_list2(Es, Ctxt)}; +literal2(#k_map{es=Es}, Ctxt) -> + {map,literal_list2(Es, Ctxt)}; +literal2(#k_map_pair{key=K,val=V}, Ctxt) -> + {map_pair,literal2(K, Ctxt),literal2(V, Ctxt)}. literal_list2(Ks, Ctxt) -> [literal2(K, Ctxt) || K <- Ks]. diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl index 4ec75d015e..de35ebc7bd 100644 --- a/lib/compiler/test/compile_SUITE.erl +++ b/lib/compiler/test/compile_SUITE.erl @@ -415,11 +415,11 @@ encrypted_abstr(Config) when is_list(Config) -> ?line {Simple,Target} = files(Config, "encrypted_abstr"), Res = case has_crypto() of - no -> + false -> %% No crypto. ?line encrypted_abstr_no_crypto(Simple, Target), {comment,"The crypto application is missing or broken"}; - yes -> + true -> %% Simulate not having crypto by removing %% the crypto application from the path. ?line OldPath = code:get_path(), @@ -511,6 +511,7 @@ write_crypt_file(Contents0) -> ok = file:write_file(".erlang.crypt", Contents). encrypted_abstr_no_crypto(Simple, Target) -> + io:format("simpe: ~p~n", [Simple]), ?line TargetDir = filename:dirname(Target), ?line Key = "ablurf123BX#$;3", ?line error = compile:file(Simple, @@ -525,11 +526,11 @@ verify_abstract(Target) -> has_crypto() -> try crypto:start(), - crypto:info(), + <<_,_,_,_,_>> = crypto:rand_bytes(5), crypto:stop(), - yes + true catch - error:_ -> no + error:_ -> false end. install_crypto_key(Key) -> diff --git a/lib/compiler/test/core_SUITE.erl b/lib/compiler/test/core_SUITE.erl index a40dc32d59..1a521c3591 100644 --- a/lib/compiler/test/core_SUITE.erl +++ b/lib/compiler/test/core_SUITE.erl @@ -23,7 +23,8 @@ init_per_testcase/2,end_per_testcase/2, dehydrated_itracer/1,nested_tries/1, seq_in_guard/1,make_effect_seq/1,eval_is_boolean/1, - unsafe_case/1,nomatch_shadow/1,reversed_annos/1]). + unsafe_case/1,nomatch_shadow/1,reversed_annos/1, + map_core_test/1]). -include_lib("test_server/include/test_server.hrl"). @@ -48,7 +49,9 @@ all() -> groups() -> [{p,test_lib:parallel(), [dehydrated_itracer,nested_tries,seq_in_guard,make_effect_seq, - eval_is_boolean,unsafe_case,nomatch_shadow,reversed_annos]}]. + eval_is_boolean,unsafe_case,nomatch_shadow,reversed_annos, + map_core_test + ]}]. init_per_suite(Config) -> @@ -72,6 +75,7 @@ end_per_group(_GroupName, Config) -> ?comp(unsafe_case). ?comp(nomatch_shadow). ?comp(reversed_annos). +?comp(map_core_test). try_it(Mod, Conf) -> Src = filename:join(?config(data_dir, Conf), atom_to_list(Mod)), diff --git a/lib/compiler/test/core_SUITE_data/map_core_test.core b/lib/compiler/test/core_SUITE_data/map_core_test.core new file mode 100644 index 0000000000..7ece8a8bbd --- /dev/null +++ b/lib/compiler/test/core_SUITE_data/map_core_test.core @@ -0,0 +1,95 @@ +module 'map_core_test' ['map_core_test'/0, + 'module_info'/0, + 'module_info'/1] + attributes [] +'map_core_test'/0 = + %% Line 14 + fun () -> + let <_cor0> = + %% Line 15 + ~{::<'check','ok'>,::<1337,#{#<104>(8,1,'integer',['unsigned'|['big']]), + #<101>(8,1,'integer',['unsigned'|['big']]), + #<108>(8,1,'integer',['unsigned'|['big']]), + #<108>(8,1,'integer',['unsigned'|['big']]), + #<111>(8,1,'integer',['unsigned'|['big']])}#>,::<'val',0>}~ + in let <M> = + %% Line 15 + apply 'id'/1 + (_cor0) + in let <_cor2> = + %% Line 16 + apply 'id'/1 + ([1|[2|[3|[4|[5|[6]]]]]]) + in %% Line 16 + case apply 'call'/2 + (M, _cor2) of + <~{~<1337,#{#<104>(8,1,'integer',['unsigned'|['big']]), + #<101>(8,1,'integer',['unsigned'|['big']]), + #<108>(8,1,'integer',['unsigned'|['big']]), + #<108>(8,1,'integer',['unsigned'|['big']]), + #<111>(8,1,'integer',['unsigned'|['big']]), + #<32>(8,1,'integer',['unsigned'|['big']]), + #<49>(8,1,'integer',['unsigned'|['big']]), + #<32>(8,1,'integer',['unsigned'|['big']]), + #<50>(8,1,'integer',['unsigned'|['big']]), + #<32>(8,1,'integer',['unsigned'|['big']]), + #<51>(8,1,'integer',['unsigned'|['big']]), + #<32>(8,1,'integer',['unsigned'|['big']]), + #<52>(8,1,'integer',['unsigned'|['big']]), + #<32>(8,1,'integer',['unsigned'|['big']]), + #<53>(8,1,'integer',['unsigned'|['big']]), + #<32>(8,1,'integer',['unsigned'|['big']]), + #<54>(8,1,'integer',['unsigned'|['big']])}#>,~<'check','ok'>,~<'val',21>}~> when 'true' -> + %% Line 17 + 'ok' + ( <_cor3> when 'true' -> + primop 'match_fail' + ({'badmatch',_cor3}) + -| ['compiler_generated'] ) + end +'call'/2 = + %% Line 20 + fun (_cor1,_cor0) -> + case <_cor1,_cor0> of + <M = ~{~<1337,Bin>,~<'check',_cor8>,~<'val',Val>}~,[V|Vs]> when 'true' -> + let <_cor3> = + %% Line 21 + call 'erlang':'+' + (V, 48) + in let <_cor4> = + %% Line 21 + #{#<Bin>('all',8,'binary',['unsigned'|['big']]), + #<32>(8,1,'integer',['unsigned'|['big']]), + #<_cor3>(8,1,'integer',['unsigned'|['big']])}# + in let <_cor2> = + %% Line 21 + call 'erlang':'+' + (Val, V) + in let <_cor5> = + %% Line 21 + M~{~<1337,_cor4>,~<'val',_cor2>}~ + in %% Line 21 + apply 'call'/2 + (_cor5, Vs) + %% Line 22 + <M,[]> when 'true' -> + M + ( <_cor7,_cor6> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_cor7,_cor6}) + -| [{'function_name',{'call',2}}] ) + -| ['compiler_generated'] ) + end +'id'/1 = + %% Line 24 + fun (_cor0) -> + _cor0 +'module_info'/0 = + fun () -> + call 'erlang':'get_module_info' + ('map_core_test') +'module_info'/1 = + fun (_cor0) -> + call 'erlang':'get_module_info' + ('map_core_test', _cor0) +end
\ No newline at end of file diff --git a/lib/compiler/test/inline_SUITE.erl b/lib/compiler/test/inline_SUITE.erl index e5c2d4f73a..47851e680b 100644 --- a/lib/compiler/test/inline_SUITE.erl +++ b/lib/compiler/test/inline_SUITE.erl @@ -37,7 +37,7 @@ all() -> groups() -> [{p,test_lib:parallel(), [attribute,bsdecode,bsdes,barnes2,decode1,smith,fname, - itracer,pseudoknot,comma_splitter,lists,really_inlined,otp_7223, + itracer,pseudoknot,maps_inline_test,comma_splitter,lists,really_inlined,otp_7223, coverage]}]. init_per_suite(Config) -> @@ -85,6 +85,7 @@ attribute(Config) when is_list(Config) -> ?comp(pseudoknot). ?comp(comma_splitter). ?comp(fname). +?comp(maps_inline_test). try_inline(Mod, Config) -> Node = ?config(testing_node, Config), diff --git a/lib/compiler/test/inline_SUITE_data/maps_inline_test.erl b/lib/compiler/test/inline_SUITE_data/maps_inline_test.erl new file mode 100644 index 0000000000..d9762e2647 --- /dev/null +++ b/lib/compiler/test/inline_SUITE_data/maps_inline_test.erl @@ -0,0 +1,70 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2013. 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(maps_inline_test). + +-export([?MODULE/0]). + +?MODULE() -> + 21 = mval(#{val => 1}) + + mval(#{val => 2}) + + mval(#{val => 3}) + + mval(#{val => 4}) + + mval(#{val => 5}) + + mval(#{val => 6}), + + 21 = gval(#{id => 1}) + + gval(#{id => 2}) + + gval(#{id => 3}) + + gval(#{id => 4}) + + gval(#{id => 5}) + + gval(#{id => 6}), + + 21 = sval(#{id => 1}) + + sval(#{id => 2}) + + sval(#{id => 3}) + + sval(#{id => 4}) + + sval(#{id => 5}) + + sval(#{id => 6}), + + M = #{v => 1, m => #{v => 21, m => #{v => 7, m => 13}}}, + + 42 = decompose(M). + +% switch key orders +decompose(#{ m := M, v := V}) when is_map(M) -> + V + decompose(M); +decompose(#{ v := V, m := M}) -> V + M. + + +mval(#{val := V}) -> V. + +sval(#{id := 1}) -> 6; +sval(#{id := 2}) -> 5; +sval(#{id := 3}) -> 4; +sval(#{id := 4}) -> 3; +sval(#{id := 5}) -> 2; +sval(#{id := 6}) -> 1. + +gval(M) when is_map(M) andalso M =:= #{ id => 1} -> 1; +gval(M) when is_map(M) andalso M =:= #{ id => 2} -> 4; +gval(M) when is_map(M) andalso M =:= #{ id => 3} -> 2; +gval(M) when is_map(M) andalso M =:= #{ id => 4} -> 5; +gval(M) when is_map(M) andalso M =:= #{ id => 5} -> 3; +gval(M) when is_map(M) andalso M =:= #{ id => 6} -> 6. diff --git a/lib/dialyzer/src/dialyzer_cl.erl b/lib/dialyzer/src/dialyzer_cl.erl index a7be6e0d05..cda801bf6c 100644 --- a/lib/dialyzer/src/dialyzer_cl.erl +++ b/lib/dialyzer/src/dialyzer_cl.erl @@ -603,7 +603,7 @@ cl_loop(State, LogCache) -> Msg = failed_anal_msg(Reason, LogCache), cl_error(State, Msg); {'EXIT', BackendPid, Reason} when Reason =/= 'normal' -> - Msg = failed_anal_msg(io_lib:format("~P", [Reason, 12]), LogCache), + Msg = failed_anal_msg(io_lib:format("~p", [Reason]), LogCache), cl_error(State, Msg); _Other -> %% io:format("Received ~p\n", [_Other]), diff --git a/lib/dialyzer/src/dialyzer_dataflow.erl b/lib/dialyzer/src/dialyzer_dataflow.erl index 3591d5be8e..33fa107019 100644 --- a/lib/dialyzer/src/dialyzer_dataflow.erl +++ b/lib/dialyzer/src/dialyzer_dataflow.erl @@ -67,7 +67,9 @@ t_to_string/2, t_to_tlist/1, t_tuple/0, t_tuple/1, t_tuple_args/1, t_tuple_args/2, t_tuple_subtypes/2, - t_unit/0, t_unopaque/2]). + t_unit/0, t_unopaque/2, + t_map/1 + ]). %%-define(DEBUG, true). %%-define(DEBUG_PP, true). @@ -305,6 +307,10 @@ traverse(Tree, Map, State) -> handle_try(Tree, Map, State); tuple -> handle_tuple(Tree, Map, State); + map -> + handle_map(Tree, Map, State); + map_pair -> + handle_map_pair(Tree, Map, State); values -> Elements = cerl:values_es(Tree), {State1, Map1, EsType} = traverse_list(Elements, Map, State), @@ -657,7 +663,8 @@ is_opaque_type_test_problem(Fun, Args, ArgTypes, State) -> FN =:= is_float; FN =:= is_function; FN =:= is_integer; FN =:= is_list; FN =:= is_number; FN =:= is_pid; FN =:= is_port; - FN =:= is_reference; FN =:= is_tuple -> + FN =:= is_reference; FN =:= is_tuple; + FN =:= is_map -> type_test_opaque_arg(Args, ArgTypes, State#state.opaques); {erlang, FN, 2} when FN =:= is_function -> type_test_opaque_arg(Args, ArgTypes, State#state.opaques); @@ -1054,6 +1061,19 @@ handle_try(Tree, Map, State) -> %%---------------------------------------- +handle_map(Tree,Map,State) -> + Pairs = cerl:map_es(Tree), + {State1, Map1, TypePairs} = traverse_list(Pairs,Map,State), + {State1, Map1, t_map(TypePairs)}. + +handle_map_pair(Tree,Map,State) -> + Key = cerl:map_pair_key(Tree), + Val = cerl:map_pair_val(Tree), + {State1, Map1, [K,V]} = traverse_list([Key,Val],Map,State), + {State1, Map1, {K,V}}. + +%%---------------------------------------- + handle_tuple(Tree, Map, State) -> Elements = cerl:tuple_es(Tree), {State1, Map1, EsType} = traverse_list(Elements, Map, State), @@ -1431,6 +1451,8 @@ bind_pat_vars([Pat|PatLeft], [Type|TypeLeft], Acc, Map, State, Rev) -> bind_opaque_pats(Literal, Type, Pat, Map, State, Rev); false -> {Map, Literal} end; + map -> + {Map, t_map([])}; tuple -> Es = cerl:tuple_es(Pat), {TypedRecord, Prototype} = @@ -1641,6 +1663,8 @@ bind_guard(Guard, Map, Env, Eval, State) -> Es0 = cerl:tuple_es(Guard), {Map1, Es} = bind_guard_list(Es0, Map, Env, dont_know, State), {Map1, t_tuple(Es)}; + map -> + {Map, t_map([])}; 'let' -> Arg = cerl:let_arg(Guard), [Var] = cerl:let_vars(Guard), diff --git a/lib/dialyzer/src/dialyzer_dep.erl b/lib/dialyzer/src/dialyzer_dep.erl index 05f81399fb..a81ea1a98b 100644 --- a/lib/dialyzer/src/dialyzer_dep.erl +++ b/lib/dialyzer/src/dialyzer_dep.erl @@ -182,6 +182,15 @@ traverse(Tree, Out, State, CurrentFun) -> Args = cerl:tuple_es(Tree), {List, State1} = traverse_list(Args, Out, State, CurrentFun), {merge_outs(List), State1}; + map -> + Args = cerl:map_es(Tree), + {List, State1} = traverse_list(Args, Out, State, CurrentFun), + {merge_outs(List), State1}; + map_pair -> + Key = cerl:map_pair_key(Tree), + Val = cerl:map_pair_val(Tree), + {List, State1} = traverse_list([Key,Val], Out, State, CurrentFun), + {merge_outs(List), State1}; values -> traverse_list(cerl:values_es(Tree), Out, State, CurrentFun); var -> diff --git a/lib/dialyzer/src/dialyzer_typesig.erl b/lib/dialyzer/src/dialyzer_typesig.erl index db7875704a..b4b3d5a092 100644 --- a/lib/dialyzer/src/dialyzer_typesig.erl +++ b/lib/dialyzer/src/dialyzer_typesig.erl @@ -55,7 +55,9 @@ t_subst/2, t_timeout/0, t_tuple/0, t_tuple/1, t_var/1, t_var_name/1, - t_none/0, t_unit/0]). + t_none/0, t_unit/0, + t_map/1 + ]). -include("dialyzer.hrl"). @@ -470,6 +472,8 @@ traverse(Tree, DefinedVars, State) -> end; [] -> {State2, TupleType} end; + map -> + {State, t_map([])}; values -> %% We can get into trouble when unifying products that have the %% same element appearing several times. Handle these cases by @@ -1037,6 +1041,9 @@ get_safe_underapprox_1([Pat|Left], Acc, Map) -> {Ts, Map1} = get_safe_underapprox_1(Es, [], Map), Type = t_tuple(Ts), get_safe_underapprox_1(Left, [Type|Acc], Map1); + map -> + %% TODO: Can maybe do something here + throw(dont_know); values -> Es = cerl:values_es(Pat), {Ts, Map1} = get_safe_underapprox_1(Es, [], Map), diff --git a/lib/dialyzer/test/small_SUITE_data/src/maps1.erl b/lib/dialyzer/test/small_SUITE_data/src/maps1.erl new file mode 100644 index 0000000000..06ced5b69e --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/maps1.erl @@ -0,0 +1,41 @@ +%% +%% File: maps1.erl +%% Author: Björn-Egil Dahlberg +%% Created: 2014-01-17 +%% + +-module(maps1). + +-compile([export_all]). + + +-export([recv/3, decode/1]). + +%-record(can_pkt, {id, data :: binary(), timestamp}). + +-type can_pkt() :: #{ id => term(), data => binary(), timestamp => term() }. +-type channel() :: atom() | pid() | {atom(),_}. + +-spec recv(<<_:64,_:_*8>>, fun((can_pkt()) -> R), channel()) -> R. +recv(Packet, Fun, Chan) -> + #{id := Can_id, data := Can_data} = P = decode(Packet), + Fun(P). + +-spec decode(<<_:64,_:_*8>>) -> #{id => <<_:11>>,timestamp => char()}. +decode(<<_:12, Len:4, Timestamp:16, 0:3, Id:11/bitstring, 0:18, + Data:Len/binary, _/binary>>) -> + #{id => Id, data => Data, timestamp => Timestamp}. + + + +t1() -> + #{bar=>fun t2/0}. + +t2() -> ok. + +-type map_state() :: #{ id => integer(), val => term() }. + +-spec update(map_state(), term()) -> map_state(). + +update(#{ id := Id, val := Val } = M, X) when is_integer(Id) -> + M#{ val := [Val,X] }. diff --git a/lib/edoc/src/edoc_doclet.erl b/lib/edoc/src/edoc_doclet.erl index ce1e94a26a..5653b5894b 100644 --- a/lib/edoc/src/edoc_doclet.erl +++ b/lib/edoc/src/edoc_doclet.erl @@ -200,7 +200,7 @@ source({M, P, Name, Path}, Dir, Suffix, Env, Set, Private, Hidden, {Set, Error} end; R -> - report("skipping source file '~ts': ~W.", [File, R, 15]), + report("skipping source file '~ts': ~P.", [File, R, 15]), {Set, true} end. diff --git a/lib/edoc/src/edoc_layout.erl b/lib/edoc/src/edoc_layout.erl index 7bd0615f5c..e164ff060f 100644 --- a/lib/edoc/src/edoc_layout.erl +++ b/lib/edoc/src/edoc_layout.erl @@ -829,6 +829,10 @@ t_type([#xmlElement{name = list, content = Es}]) -> t_list(Es); t_type([#xmlElement{name = nonempty_list, content = Es}]) -> t_nonempty_list(Es); +t_type([#xmlElement{name = map, content = Es}]) -> + t_map(Es); +t_type([#xmlElement{name = map_field, content=Es}]) -> + t_map_field(Es); t_type([#xmlElement{name = tuple, content = Es}]) -> t_tuple(Es); t_type([#xmlElement{name = 'fun', content = Es}]) -> @@ -877,6 +881,12 @@ t_fun(Es) -> ["("] ++ seq(fun t_utype_elem/1, get_content(argtypes, Es), [") -> "] ++ t_utype(get_elem(type, Es))). +t_map(Es) -> + ["#{"] ++ seq(fun t_utype_elem/1, Es, ["}"]). + +t_map_field([K,V]) -> + [t_utype_elem(K) ++ " => " ++ t_utype_elem(V)]. + t_record(E, Es) -> Name = ["#"] ++ t_type(get_elem(atom, Es)), case get_elem(field, Es) of diff --git a/lib/edoc/src/edoc_lib.erl b/lib/edoc/src/edoc_lib.erl index ca9df2b632..c46338a2e1 100644 --- a/lib/edoc/src/edoc_lib.erl +++ b/lib/edoc/src/edoc_lib.erl @@ -1032,7 +1032,7 @@ run_plugin(Name, Key, Default, Fun, Opts) when is_atom(Name) -> {ok, Value} -> Value; R -> - report("error in ~ts '~w': ~W.", [Name, Module, R, 20]), + report("error in ~ts '~w': ~P.", [Name, Module, R, 20]), exit(error) end. diff --git a/lib/edoc/src/edoc_parser.yrl b/lib/edoc/src/edoc_parser.yrl index 7762f2da7d..c6f8a04775 100644 --- a/lib/edoc/src/edoc_parser.yrl +++ b/lib/edoc/src/edoc_parser.yrl @@ -29,13 +29,14 @@ Nonterminals start spec func_type utype_list utype_tuple utypes utype ptypes ptype nutype function_name where_defs defs defs2 def typedef etype throws qname ref aref mref lref pref var_list vars fields field +utype_map utype_map_fields utype_map_field futype_list bin_base_type bin_unit_type. Terminals atom float integer var an_var string start_spec start_typedef start_throws start_ref -'(' ')' ',' '.' '->' '{' '}' '[' ']' '|' '+' ':' '::' '=' '/' '//' '*' +'(' ')' ',' '.' '=>' '->' '{' '}' '[' ']' '|' '+' ':' '::' '=' '/' '//' '*' '#' 'where' '<<' '>>' '..' '...'. Rootsymbol start. @@ -69,6 +70,14 @@ utype_list -> '(' utypes ')' : {lists:reverse('$2'), tok_line('$1')}. futype_list -> utype_list : '$1'. futype_list -> '(' '...' ')' : {[#t_var{name = '...'}], tok_line('$1')}. +utype_map -> '#' '{' utype_map_fields '}' : lists:reverse('$3'). + +utype_map_fields -> '$empty' : []. +utype_map_fields -> utype_map_field : ['$1']. +utype_map_fields -> utype_map_fields ',' utype_map_field : ['$3' | '$1']. + +utype_map_field -> utype '=>' utype : #t_map_field{ k_type = '$1', v_type = '$3'}. + utype_tuple -> '{' utypes '}' : lists:reverse('$2'). %% Produced in reverse order. @@ -91,9 +100,10 @@ ptype -> var : #t_var{name = tok_val('$1')}. ptype -> atom : #t_atom{val = tok_val('$1')}. ptype -> integer: #t_integer{val = tok_val('$1')}. ptype -> integer '..' integer: #t_integer_range{from = tok_val('$1'), - to = tok_val('$3')}. + to = tok_val('$3')}. ptype -> float: #t_float{val = tok_val('$1')}. ptype -> utype_tuple : #t_tuple{types = '$1'}. +ptype -> utype_map : #t_map{types = '$1'}. ptype -> '[' ']' : #t_nil{}. ptype -> '[' utype ']' : #t_list{type = '$2'}. ptype -> '[' utype ',' '...' ']' : #t_nonempty_list{type = '$2'}. @@ -462,3 +472,5 @@ throw_error(parse_param, L) -> throw({error, L, "missing parameter name"}); throw_error({Where, E}, L) when is_list(Where) -> throw({error,L,{"unknown error parsing ~ts: ~P.",[Where,E,15]}}). + +%% vim: ft=erlang diff --git a/lib/edoc/src/edoc_scanner.erl b/lib/edoc/src/edoc_scanner.erl index 754fcef643..6ff97a134c 100644 --- a/lib/edoc/src/edoc_scanner.erl +++ b/lib/edoc/src/edoc_scanner.erl @@ -137,6 +137,8 @@ scan1([$"|Cs0], Toks, Pos) -> % String scan_error({illegal, string}, Pos) end; %% Punctuation characters and operators, first recognise multiples. +scan1([$=,$>|Cs], Toks, Pos) -> + scan1(Cs, [{'=>',Pos}|Toks], Pos); scan1([$<,$<|Cs], Toks, Pos) -> scan1(Cs, [{'<<',Pos}|Toks], Pos); scan1([$>,$>|Cs], Toks, Pos) -> diff --git a/lib/edoc/src/edoc_specs.erl b/lib/edoc/src/edoc_specs.erl index 5acf8ac0d5..466c9df951 100644 --- a/lib/edoc/src/edoc_specs.erl +++ b/lib/edoc/src/edoc_specs.erl @@ -358,6 +358,14 @@ d2e({type,_,tuple,any}) -> d2e({type,_,binary,[Base,Unit]}) -> #t_binary{base_size = element(3, Base), unit_size = element(3, Unit)}; +d2e({type,_,map,any}) -> + #t_map{ types = []}; +d2e({type,_,map,Es}) -> + #t_map{ types = d2e(Es) }; +d2e({type,_,map_field_assoc,K,V}) -> + #t_map_field{ k_type = d2e(K), v_type=d2e(V) }; +d2e({type,_,map_field_exact,K,V}) -> + #t_map_field{ k_type = d2e(K), v_type=d2e(V) }; d2e({type,_,tuple,Ts0}) -> Ts = d2e(Ts0), typevar_anno(#t_tuple{types = Ts}, Ts); @@ -476,6 +484,11 @@ xrecs(#t_fun{args = Args0, range = Range0}=T, P) -> Args = xrecs(Args0, P), Range = xrecs(Range0, P), T#t_fun{args = Args, range = Range}; +xrecs(#t_map{ types = Ts0 }=T,P) -> + Ts = xrecs(Ts0, P), + T#t_map{ types = Ts }; +xrecs(#t_map_field{ k_type=Kt, v_type=Vt}=T, P) -> + T#t_map_field{ k_type=xrecs(Kt,P), v_type=xrecs(Vt,P)}; xrecs(#t_tuple{types = Types0}=T, P) -> Types = xrecs(Types0, P), T#t_tuple{types = Types}; diff --git a/lib/edoc/src/edoc_tags.erl b/lib/edoc/src/edoc_tags.erl index eb41f1922a..74702102f0 100644 --- a/lib/edoc/src/edoc_tags.erl +++ b/lib/edoc/src/edoc_tags.erl @@ -460,6 +460,8 @@ check_type(#t_var{}, P, Ls, Ts) -> check_types3(Ts, P, Ls); check_type(#t_fun{args = Args, range = Range}, P, Ls, Ts) -> check_type(Range, P, Ls, Args++Ts); +check_type(#t_map{}, P, Ls, Ts) -> + check_types3(Ts, P, Ls); check_type(#t_tuple{types = Types}, P, Ls, Ts) -> check_types3(Types ++Ts, P, Ls); check_type(#t_list{type = Type}, P, Ls, Ts) -> diff --git a/lib/edoc/src/edoc_types.erl b/lib/edoc/src/edoc_types.erl index 60c6cecb97..af8f1230fb 100644 --- a/lib/edoc/src/edoc_types.erl +++ b/lib/edoc/src/edoc_types.erl @@ -141,6 +141,10 @@ to_xml(#t_type{name = N, args = As}, Env) -> to_xml(#t_fun{args = As, range = T}, Env) -> {'fun', [{argtypes, map(fun wrap_utype/2, As, Env)}, wrap_utype(T, Env)]}; +to_xml(#t_map{ types = Ts}, Env) -> + {map, map(fun wrap_utype/2, Ts, Env)}; +to_xml(#t_map_field{ k_type=K, v_type=V}, Env) -> + {map_field, [wrap_utype(K,Env), wrap_utype(V, Env)]}; to_xml(#t_tuple{types = Ts}, Env) -> {tuple, map(fun wrap_utype/2, Ts, Env)}; to_xml(#t_list{type = T}, Env) -> diff --git a/lib/edoc/src/edoc_types.hrl b/lib/edoc/src/edoc_types.hrl index 05c61d70ff..7fec10d936 100644 --- a/lib/edoc/src/edoc_types.hrl +++ b/lib/edoc/src/edoc_types.hrl @@ -155,3 +155,7 @@ %% @type t_paren() = #t_paren{a = list(), type = type()} -record(t_paren, {a=[], type}). % parentheses + +-record(t_map, {a=[], types=[]}). +-record(t_map_field, {a=[], k_type, v_type}). + diff --git a/lib/edoc/test/edoc_SUITE.erl b/lib/edoc/test/edoc_SUITE.erl index 5b95c35756..b649971e99 100644 --- a/lib/edoc/test/edoc_SUITE.erl +++ b/lib/edoc/test/edoc_SUITE.erl @@ -22,12 +22,12 @@ init_per_group/2,end_per_group/2]). %% Test cases --export([build_std/1]). +-export([build_std/1,build_map_module/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [build_std]. + [build_std,build_map_module]. groups() -> []. @@ -45,25 +45,28 @@ end_per_group(_GroupName, Config) -> Config. -build_std(suite) -> - []; -build_std(doc) -> - ["Build some documentation using standard EDoc layout"]; +build_std(suite) -> []; +build_std(doc) -> ["Build some documentation using standard EDoc layout"]; build_std(Config) when is_list(Config) -> + DataDir = ?config(data_dir, Config), + Overview1 = filename:join(DataDir, "overview.edoc"), + Overview2 = filename:join(DataDir, "overview.syntax_tools"), + PrivDir = ?config(priv_dir, Config), - ?line DataDir = ?config(data_dir, Config), - ?line Overview1 = filename:join(DataDir, "overview.edoc"), - ?line Overview2 = filename:join(DataDir, "overview.syntax_tools"), - ?line PrivDir = ?config(priv_dir, Config), + ok = edoc:application(edoc, [{overview, Overview1}, + {def, {vsn,"TEST"}}, + {dir, PrivDir}]), - ?line ok = edoc:application(edoc, [{overview, Overview1}, - {def, {vsn,"TEST"}}, - {dir, PrivDir}]), + ok = edoc:application(syntax_tools, [{overview, Overview2}, + {def, {vsn,"TEST"}}, + {dir, PrivDir}]), - ?line ok = edoc:application(syntax_tools, [{overview, Overview2}, - {def, {vsn,"TEST"}}, - {dir, PrivDir}]), - - ?line ok = edoc:application(xmerl, [{dir, PrivDir}]), + ok = edoc:application(xmerl, [{dir, PrivDir}]), + ok. +build_map_module(Config) when is_list(Config) -> + DataDir = ?config(data_dir, Config), + PrivDir = ?config(priv_dir, Config), + Filename = filename:join(DataDir, "map_module.erl"), + ok = edoc:file(Filename, [{dir, PrivDir}]), ok. diff --git a/lib/edoc/test/edoc_SUITE_data/map_module.erl b/lib/edoc/test/edoc_SUITE_data/map_module.erl new file mode 100644 index 0000000000..94ee7e6f26 --- /dev/null +++ b/lib/edoc/test/edoc_SUITE_data/map_module.erl @@ -0,0 +1,27 @@ +-module(map_module). + +-export([foo1/1,foo2/3]). + +%% @type wazzup() = integer() +%% @type some_type() = map() +%% @type some_other_type() = {a, #{ list() => term()}} + +-type some_type() :: map(). +-type some_other_type() :: {'a', #{ list() => term()} }. +-type wazzup() :: integer(). + +-spec foo1(Map :: #{ 'a' => integer(), 'b' => term()}) -> term(). + +%% @doc Gets value from map. + +foo1(#{ a:= 1, b := V}) -> V. + +%% @spec foo2(some_type(), Type2 :: some_other_type(), map()) -> Value +%% @doc Gets value from map. + +-spec foo2( + Type1 :: some_type(), + Type2 :: some_other_type(), + Map :: #{ get => 'value', 'value' => binary()}) -> binary(). + +foo2(Type1, {a,#{ "a" := _}}, #{get := value, value := B}) when is_map(Type1) -> B. diff --git a/lib/erl_docgen/src/docgen_otp_specs.erl b/lib/erl_docgen/src/docgen_otp_specs.erl index 3929e66515..3240edd68e 100644 --- a/lib/erl_docgen/src/docgen_otp_specs.erl +++ b/lib/erl_docgen/src/docgen_otp_specs.erl @@ -388,6 +388,8 @@ t_type([#xmlElement{name = nonempty_list, content = Es}]) -> t_nonempty_list(Es); t_type([#xmlElement{name = tuple, content = Es}]) -> t_tuple(Es); +t_type([#xmlElement{name = map}]) -> + t_map(); t_type([#xmlElement{name = 'fun', content = Es}]) -> ["fun("] ++ t_fun(Es) ++ [")"]; t_type([E = #xmlElement{name = record, content = Es}]) -> @@ -430,6 +432,9 @@ t_nonempty_list(Es) -> t_tuple(Es) -> ["{"] ++ seq(fun t_utype_elem/1, Es, ["}"]). +t_map() -> + ["#{}"]. + t_fun(Es) -> ["("] ++ seq(fun t_utype_elem/1, get_content(argtypes, Es), [") -> "] ++ t_utype(get_elem(type, Es))). diff --git a/lib/hipe/cerl/cerl_prettypr.erl b/lib/hipe/cerl/cerl_prettypr.erl index fba9a48cda..22f5b8945a 100644 --- a/lib/hipe/cerl/cerl_prettypr.erl +++ b/lib/hipe/cerl/cerl_prettypr.erl @@ -62,7 +62,9 @@ receive_action/1, receive_clauses/1, receive_timeout/1, seq_arg/1, seq_body/1, string_lit/1, try_arg/1, try_body/1, try_vars/1, try_evars/1, try_handler/1, - tuple_es/1, type/1, values_es/1, var_name/1]). + tuple_es/1, type/1, values_es/1, var_name/1, + map_es/1, map_pair_key/1, map_pair_val/1, map_pair_op/1 + ]). -define(PAPER, 76). -define(RIBBON, 45). @@ -424,6 +426,10 @@ lay_1(Node, Ctxt) -> lay_cons(Node, Ctxt); tuple -> lay_tuple(Node, Ctxt); + map -> + lay_map(Node, Ctxt); + map_pair -> + lay_map_pair(Node, Ctxt); 'let' -> lay_let(Node, Ctxt); seq -> @@ -589,6 +595,23 @@ lay_tuple(Node, Ctxt) -> Ctxt, fun lay/2)), floating(text("}")))). +lay_map(Node, Ctxt) -> + beside(floating(text("~{")), + beside(par(seq(map_es(Node), floating(text(",")), + Ctxt, fun lay/2)), + floating(text("}~")))). + +lay_map_pair(Node, Ctxt) -> + K = map_pair_key(Node), + V = map_pair_val(Node), + OpTxt = case concrete(map_pair_op(Node)) of + assoc -> "::<"; + exact -> "~<" + end, + beside(floating(text(OpTxt)), + beside(lay(K,Ctxt),beside(floating(text(",")), beside(lay(V,Ctxt), + floating(text(">")))))). + lay_let(Node, Ctxt) -> V = lay_value_list(let_vars(Node), Ctxt), D1 = par([follow(text("let"), diff --git a/lib/hipe/cerl/erl_bif_types.erl b/lib/hipe/cerl/erl_bif_types.erl index 32a502e212..8b610ac893 100644 --- a/lib/hipe/cerl/erl_bif_types.erl +++ b/lib/hipe/cerl/erl_bif_types.erl @@ -114,7 +114,9 @@ t_tuple/1, t_tuple_args/2, t_tuple_size/2, - t_tuple_subtypes/2 + t_tuple_subtypes/2, + t_is_map/2, + t_map/0 ]). -ifdef(DO_ERL_BIF_TYPES_TEST). @@ -654,6 +656,11 @@ type(erlang, is_list, 1, Xs, Opaques) -> check_guard(X, Fun2, t_maybe_improper_list(), Opaques) end, strict(erlang, is_list, 1, Xs, Fun, Opaques); +type(erlang, is_map, 1, Xs, Opaques) -> + Fun = fun (X) -> + check_guard(X, fun (Y) -> t_is_map(Y, Opaques) end, + t_map(), Opaques) end, + strict(erlang, is_map, 1, Xs, Fun, Opaques); type(erlang, is_number, 1, Xs, Opaques) -> Fun = fun (X) -> check_guard(X, fun (Y) -> t_is_number(Y, Opaques) end, @@ -756,6 +763,9 @@ type(erlang, is_tuple, 1, Xs, Opaques) -> %% Guard bif, needs to be here. type(erlang, length, 1, Xs, Opaques) -> strict(erlang, length, 1, Xs, fun (_) -> t_non_neg_fixnum() end, Opaques); +%% Guard bif, needs to be here. +type(erlang, map_size, 1, Xs, Opaques) -> + strict(erlang, map_size, 1, Xs, fun (_) -> t_non_neg_integer() end, Opaques); type(erlang, make_tuple, 2, Xs, Opaques) -> strict(erlang, make_tuple, 2, Xs, fun ([Int, _]) -> @@ -2297,6 +2307,8 @@ arg_types(erlang, is_integer, 1) -> [t_any()]; arg_types(erlang, is_list, 1) -> [t_any()]; +arg_types(erlang, is_map, 1) -> + [t_any()]; arg_types(erlang, is_number, 1) -> [t_any()]; arg_types(erlang, is_pid, 1) -> @@ -2314,6 +2326,9 @@ arg_types(erlang, is_tuple, 1) -> %% Guard bif, needs to be here. arg_types(erlang, length, 1) -> [t_list()]; +%% Guard bif, needs to be here. +arg_types(erlang, map_size, 1) -> + [t_map()]; arg_types(erlang, make_tuple, 2) -> [t_non_neg_fixnum(), t_any()]; % the value 0 is OK as first argument arg_types(erlang, make_tuple, 3) -> diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index cfa72d85b7..af34e355bb 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -208,7 +208,11 @@ lift_list_to_pos_empty/1, is_opaque_type/2, is_erl_type/1, - atom_to_string/1 + atom_to_string/1, + + t_is_map/2, + t_map/1, + t_map/0 ]). %%-define(DO_ERL_TYPES_TEST, true). @@ -266,6 +270,7 @@ -define(function_tag, function). -define(identifier_tag, identifier). -define(list_tag, list). +-define(map_tag, map). -define(matchstate_tag, matchstate). -define(nil_tag, nil). -define(number_tag, number). @@ -278,7 +283,7 @@ -define(var_tag, var). -type tag() :: ?atom_tag | ?binary_tag | ?function_tag | ?identifier_tag - | ?list_tag | ?matchstate_tag | ?nil_tag | ?number_tag + | ?list_tag | ?map_tag | ?matchstate_tag | ?nil_tag | ?number_tag | ?opaque_tag | ?product_tag | ?remote_tag | ?tuple_tag | ?tuple_set_tag | ?union_tag | ?var_tag. @@ -338,6 +343,7 @@ -define(nonempty_list(Types, Term),?list(Types, Term, ?nonempty_qual)). -define(number(Set, Qualifier), #c{tag=?number_tag, elements=Set, qualifier=Qualifier}). +-define(map(Pairs), #c{tag=?map_tag, elements=Pairs}). -define(opaque(Optypes), #c{tag=?opaque_tag, elements=Optypes}). -define(product(Types), #c{tag=?product_tag, elements=Types}). -define(remote(RemTypes), #c{tag=?remote_tag, elements=RemTypes}). @@ -361,18 +367,19 @@ %% Unions %% --define(union(List), #c{tag=?union_tag, elements=[_,_,_,_,_,_,_,_,_,_]=List}). - --define(atom_union(T), ?union([T,?none,?none,?none,?none,?none,?none,?none,?none,?none])). --define(bitstr_union(T), ?union([?none,T,?none,?none,?none,?none,?none,?none,?none,?none])). --define(function_union(T), ?union([?none,?none,T,?none,?none,?none,?none,?none,?none,?none])). --define(identifier_union(T), ?union([?none,?none,?none,T,?none,?none,?none,?none,?none,?none])). --define(list_union(T), ?union([?none,?none,?none,?none,T,?none,?none,?none,?none,?none])). --define(number_union(T), ?union([?none,?none,?none,?none,?none,T,?none,?none,?none,?none])). --define(tuple_union(T), ?union([?none,?none,?none,?none,?none,?none,T,?none,?none,?none])). --define(matchstate_union(T), ?union([?none,?none,?none,?none,?none,?none,?none,T,?none,?none])). --define(opaque_union(T), ?union([?none,?none,?none,?none,?none,?none,?none,?none,T,?none])). --define(remote_union(T), ?union([?none,?none,?none,?none,?none,?none,?none,?none,?none,T])). +-define(union(List), #c{tag=?union_tag, elements=[_,_,_,_,_,_,_,_,_,_,_]=List}). + +-define(atom_union(T), ?union([T,?none,?none,?none,?none,?none,?none,?none,?none,?none,?none])). +-define(bitstr_union(T), ?union([?none,T,?none,?none,?none,?none,?none,?none,?none,?none,?none])). +-define(function_union(T), ?union([?none,?none,T,?none,?none,?none,?none,?none,?none,?none,?none])). +-define(identifier_union(T), ?union([?none,?none,?none,T,?none,?none,?none,?none,?none,?none,?none])). +-define(list_union(T), ?union([?none,?none,?none,?none,T,?none,?none,?none,?none,?none,?none])). +-define(number_union(T), ?union([?none,?none,?none,?none,?none,T,?none,?none,?none,?none,?none])). +-define(tuple_union(T), ?union([?none,?none,?none,?none,?none,?none,T,?none,?none,?none,?none])). +-define(matchstate_union(T), ?union([?none,?none,?none,?none,?none,?none,?none,T,?none,?none,?none])). +-define(opaque_union(T), ?union([?none,?none,?none,?none,?none,?none,?none,?none,T,?none,?none])). +-define(remote_union(T), ?union([?none,?none,?none,?none,?none,?none,?none,?none,?none,T,?none])). +-define(map_union(T), ?union([?none,?none,?none,?none,?none,?none,?none,?none,?none,?none,T])). -define(integer_union(T), ?number_union(T)). -define(float_union(T), ?number_union(T)). -define(nil_union(T), ?list_union(T)). @@ -482,6 +489,9 @@ t_contains_opaque(?int_range(_From, _To), _Opaques) -> false; t_contains_opaque(?int_set(_Set), _Opaques) -> false; t_contains_opaque(?list(Type, Tail, _), Opaques) -> t_contains_opaque(Type, Opaques) orelse t_contains_opaque(Tail, Opaques); +t_contains_opaque(?map(Pairs), Opaques) -> + list_contains_opaque([V||{_,V}<-Pairs], Opaques) orelse + list_contains_opaque([K||{K,_}<-Pairs], Opaques); t_contains_opaque(?matchstate(_P, _Slots), _Opaques) -> false; t_contains_opaque(?nil, _Opaques) -> false; t_contains_opaque(?number(_Set, _Tag), _Opaques) -> false; @@ -655,9 +665,9 @@ list_decorate(List, L, Opaques) -> union_decorate(U1, U2, Opaques) -> Union = union_decorate(U1, U2, Opaques, 0, []), - [A,B,F,I,L,N,T,M,_,_R] = U1, - [_,_,_,_,_,_,_,_,Opaque,_] = U2, - List = [A,B,F,I,L,N,T,M], + [A,B,F,I,L,N,T,M,_,_R,Map] = U1, + [_,_,_,_,_,_,_,_,Opaque,_,_] = U2, + List = [A,B,F,I,L,N,T,M,Map], DecList = [Dec || E <- List, not t_is_none(Dec = decorate(E, Opaque, Opaques))], @@ -1695,6 +1705,29 @@ lift_list_to_pos_empty(?list(Content, Termination, _)) -> ?list(Content, Termination, ?unknown_qual). %%----------------------------------------------------------------------------- +%% Maps +%% + +-spec t_map() -> erl_type(). + +t_map() -> + ?map([]). + +-spec t_map([{erl_type(),erl_type()}]) -> erl_type(). + +t_map(_) -> + ?map([]). + +-spec t_is_map(erl_type(), opaques()) -> boolean(). + +t_is_map(Type, Opaques) -> + do_opaque(Type, Opaques, fun is_map1/1). + +is_map1(?map(_)) -> true; +is_map1(_) -> false. + + +%%----------------------------------------------------------------------------- %% Tuples %% @@ -2517,6 +2550,7 @@ force_union(T = ?nil) -> ?list_union(T); force_union(T = ?number(_,_)) -> ?number_union(T); force_union(T = ?opaque(_)) -> ?opaque_union(T); force_union(T = ?remote(_)) -> ?remote_union(T); +force_union(T = ?map(_)) -> ?map_union(T); force_union(T = ?tuple(_, _, _)) -> ?tuple_union(T); force_union(T = ?tuple_set(_)) -> ?tuple_union(T); force_union(T = ?matchstate(_, _)) -> ?matchstate_union(T); @@ -2553,6 +2587,7 @@ t_elements(?number(_, _) = T) -> end; t_elements(?opaque(_) = T) -> do_elements(T); +t_elements(?map(_) = T) -> [T]; t_elements(?tuple(_, _, _) = T) -> [T]; t_elements(?tuple_set(_) = TS) -> case t_tuple_subtypes(TS) of @@ -2914,9 +2949,9 @@ inf_tuples_in_sets2(_, [], Acc, _Opaques) -> lists:reverse(Acc). inf_union(U1, U2, Opaques) -> OpaqueFun = fun(Union1, Union2, InfFun) -> - [_,_,_,_,_,_,_,_,Opaque,_] = Union1, - [A,B,F,I,L,N,T,M,_,_R] = Union2, - List = [A,B,F,I,L,N,T,M], + [_,_,_,_,_,_,_,_,Opaque,_,_] = Union1, + [A,B,F,I,L,N,T,M,_,_R,Map] = Union2, + List = [A,B,F,I,L,N,T,M,Map], inf_union_collect(List, Opaque, InfFun, [], []) end, O1 = OpaqueFun(U1, U2, fun(E, Opaque) -> t_inf(Opaque, E, Opaques) end), @@ -3182,11 +3217,11 @@ unify_union1(?union(List), T1, T2) -> end. unify_union(List) -> - [A,B,F,I,L,N,T,M,O,R] = List, + [A,B,F,I,L,N,T,M,O,R,Map] = List, if O =:= ?none -> no; true -> S = t_opaque_structure(O), - {yes, t_sup([A,B,F,I,L,N,T,M,S,R])} + {yes, t_sup([A,B,F,I,L,N,T,M,S,R,Map])} end. -spec is_opaque_type(erl_type(), [erl_type()]) -> boolean(). @@ -3537,10 +3572,10 @@ t_subtract_lists([], [], Acc) -> -spec subtract_union([erl_type(),...], [erl_type(),...]) -> erl_type(). subtract_union(U1, U2) -> - [A1,B1,F1,I1,L1,N1,T1,M1,O1,R1] = U1, - [A2,B2,F2,I2,L2,N2,T2,M2,O2,R2] = U2, - List1 = [A1,B1,F1,I1,L1,N1,T1,M1,?none,R1], - List2 = [A2,B2,F2,I2,L2,N2,T2,M2,?none,R2], + [A1,B1,F1,I1,L1,N1,T1,M1,O1,R1,Map1] = U1, + [A2,B2,F2,I2,L2,N2,T2,M2,O2,R2,Map2] = U2, + List1 = [A1,B1,F1,I1,L1,N1,T1,M1,?none,R1,Map1], + List2 = [A2,B2,F2,I2,L2,N2,T2,M2,?none,R2,Map2], Sub1 = subtract_union(List1, List2, 0, []), O = if O1 =:= ?none -> O1; true -> t_subtract(O1, ?union(U2)) @@ -3656,7 +3691,7 @@ t_unopaque(?product(Types), Opaques) -> ?product([t_unopaque(T, Opaques) || T <- Types]); t_unopaque(?function(Domain, Range), Opaques) -> ?function(t_unopaque(Domain, Opaques), t_unopaque(Range, Opaques)); -t_unopaque(?union([A,B,F,I,L,N,T,M,O,R]), Opaques) -> +t_unopaque(?union([A,B,F,I,L,N,T,M,O,R,Map]), Opaques) -> UL = t_unopaque(L, Opaques), UT = t_unopaque(T, Opaques), UF = t_unopaque(F, Opaques), @@ -3664,7 +3699,7 @@ t_unopaque(?union([A,B,F,I,L,N,T,M,O,R]), Opaques) -> ?opaque(_) = O1 -> {O1, []}; Type -> {?none, [Type]} end, - t_sup([?union([A,B,UF,I,UL,N,UT,M,OF,R])|UO]); + t_sup([?union([A,B,UF,I,UL,N,UT,M,OF,R,Map])|UO]); t_unopaque(T, _) -> T. @@ -3941,6 +3976,8 @@ t_to_string(?remote(Set), RecDict) -> || #remote{mod = Mod, name = Name, args = Args} <- set_to_list(Set)], " | "); +t_to_string(?map(Pairs), RecDict) -> + "#{" ++ map_pairs_to_string(Pairs,RecDict) ++ "}"; t_to_string(?tuple(?any, ?any, ?any), _RecDict) -> "tuple()"; t_to_string(?tuple(Elements, _Arity, ?any), RecDict) -> "{" ++ comma_sequence(Elements, RecDict) ++ "}"; @@ -3960,6 +3997,13 @@ t_to_string(?var(Id), _RecDict) when is_atom(Id) -> t_to_string(?var(Id), _RecDict) when is_integer(Id) -> flat_format("var(~w)", [Id]). + +map_pairs_to_string([],_) -> []; +map_pairs_to_string(Pairs,RecDict) -> + StrPairs = [{t_to_string(K,RecDict),t_to_string(V,RecDict)}||{K,V}<-Pairs], + string:join([K ++ "=>" ++ V||{K,V}<-StrPairs], ", "). + + record_to_string(Tag, [_|Fields], FieldNames, RecDict) -> FieldStrings = record_fields_to_string(Fields, FieldNames, RecDict, []), "#" ++ atom_to_string(Tag) ++ "{" ++ string:join(FieldStrings, ",") ++ "}". @@ -4153,6 +4197,8 @@ t_from_form({type, _L, list, []}, _TypeNames, _RecDict, _VarDict) -> t_from_form({type, _L, list, [Type]}, TypeNames, RecDict, VarDict) -> {T, R} = t_from_form(Type, TypeNames, RecDict, VarDict), {t_list(T), R}; +t_from_form({type, _L, map, _}, _TypeNames, _RecDict, _VarDict) -> + {t_map([]), []}; t_from_form({type, _L, mfa, []}, _TypeNames, _RecDict, _VarDict) -> {t_mfa(), []}; t_from_form({type, _L, module, []}, _TypeNames, _RecDict, _VarDict) -> @@ -4437,6 +4483,8 @@ t_form_to_string({type, _L, iodata, []}) -> "iodata()"; t_form_to_string({type, _L, iolist, []}) -> "iolist()"; t_form_to_string({type, _L, list, [Type]}) -> "[" ++ t_form_to_string(Type) ++ "]"; +t_form_to_string({type, _L, map, _}) -> + "#{}"; t_form_to_string({type, _L, mfa, []}) -> "mfa()"; t_form_to_string({type, _L, module, []}) -> "module()"; t_form_to_string({type, _L, node, []}) -> "node()"; @@ -4566,13 +4614,13 @@ do_opaque(?opaque(_) = Type, Opaques, Pred) -> false -> Pred(Type) end; do_opaque(?union(List) = Type, Opaques, Pred) -> - [A,B,F,I,L,N,T,M,O,R] = List, + [A,B,F,I,L,N,T,M,O,R,Map] = List, if O =:= ?none -> Pred(Type); true -> case Opaques =:= 'universe' orelse is_opaque_type(O, Opaques) of true -> S = t_opaque_structure(O), - do_opaque(t_sup([A,B,F,I,L,N,T,M,S,R]), Opaques, Pred); + do_opaque(t_sup([A,B,F,I,L,N,T,M,S,R,Map]), Opaques, Pred); false -> Pred(Type) end end; diff --git a/lib/kernel/doc/src/file.xml b/lib/kernel/doc/src/file.xml index 0a4dd3ba47..7b8d2940c1 100644 --- a/lib/kernel/doc/src/file.xml +++ b/lib/kernel/doc/src/file.xml @@ -37,54 +37,48 @@ the file operations. See the command line flag <c>+A</c> in <seealso marker="erts:erl">erl(1)</seealso>.</p> - <p>The Erlang VM supports file names in Unicode to a limited - extent. Depending on how the VM is started (with the parameter - <c>+fnu</c> or <c>+fnl</c>), file names given can contain - characters > 255 and the VM system will convert file names - back and forth to the native file name encoding.</p> + <p>With regard to file name encoding, the Erlang VM can operate in + two modes. The current mode can be queried using the <seealso + marker="#native_name_encoding">native_name_encoding/0</seealso> + function. It returns either <c>latin1</c> or <c>utf8</c>.</p> - <p>The default behavior for Unicode character translation depends - on to what extent the underlying OS/filesystem enforces consistent - naming. On OSes where all file names are ensured to be in one or - another encoding, Unicode is the default (currently this holds for - Windows and MacOSX). On OSes with completely transparent file - naming (i.e. all Unixes except MacOSX), ISO-latin-1 file naming is - the default. The reason for the ISO-latin-1 default is that - file names are not guaranteed to be possible to interpret according to - the Unicode encoding expected (i.e. UTF-8), and file names that - cannot be decoded will only be accessible by using "raw - file names", in other word file names given as binaries.</p> - - <p>As file names are traditionally not binaries in Erlang, - applications that need to handle raw file names need to be - converted, why the Unicode mode for file names is not default on - systems having completely transparent file naming.</p> + <p>In the <c>latin1</c> mode, the Erlang VM does not change the + encoding of file names. In the <c>utf8</c> mode, file names can + contain Unicode characters greater than 255 and the VM will + convert file names back and forth to the native file name encoding + (usually UTF-8, but UTF-16 on Windows).</p> - <p>Raw file names is a new feature in OTP R14B01, which allows the - user to supply completely uninterpreted file names to the - underlying OS/filesystem. They are supplied as binaries, where it - is up to the user to supply a correct encoding for the - environment. The function <c>file:native_name_encoding()</c> can - be used to check what encoding the VM is working in. If the - function returns <c>latin1</c> file names are not in any way - converted to Unicode, if it is <c>utf8</c>, raw file names should - be encoded as UTF-8 if they are to follow the convention of the VM - (and usually the convention of the OS as well). Using raw - file names is useful if you have a filesystem with inconsistent - file naming, where some files are named in UTF-8 encoding while - others are not. A file:list_dir on such mixed file name systems - when the VM is in Unicode file name mode might return file names as - raw binaries as they cannot be interpreted as Unicode - file names. Raw file names can also be used to give UTF-8 encoded - file names even though the VM is not started in Unicode file name - translation mode.</p> + <p>The default mode depends on the operating system. Windows and + MacOS X enforce consistent file name encoding and therefore the + VM uses the <c>utf8</c> mode.</p> + + <p>On operating systems with transparent naming (i.e. all Unix + systems except MacOS X), the default will be <c>utf8</c> if the + terminal supports UTF-8, otherwise <c>latin1</c>. The default may + be overridden using the <c>+fnl</c> (to force <c>latin1</c> mode) + or <c>+fnu</c> (to force <c>utf8</c> mode) when starting <seealso + marker="erts:erl">erl</seealso>.</p> + + <p>On operating systems with transparent naming, files could be + inconsistently named, i.e. some files are encoded in UTF-8 while + others are encoded in (for example) iso-latin1. To be able to + handle file systems with inconsistent naming when running in the + <c>utf8</c> mode, the concept of "raw file names" has been + introduced.</p> + + <p>A raw file name is a file name given as a binary. The Erlang VM + will perform no translation of a file name given as a binary on + systems with transparent naming.</p> + + <p>When running in the <c>utf8</c> mode, the + <c>file:list_dir/1</c> and <c>file:read_link/1</c> functions will + never return raw file names. Use the <seealso + marker="#list_dir_all">list_dir_all/1</seealso> and <seealso + marker="#read_link_all">read_link_all/1</seealso> functions to + return all file names including raw file names.</p> + + <p>Also see <seealso marker="stdlib:unicode_usage#notes-about-raw-filenames">Notes about raw file names</seealso>.</p> - <p>Note that on Windows, <c>file:native_name_encoding()</c> - returns <c>utf8</c> per default, which is the format for raw - file names even on Windows, although the underlying OS specific - code works in a limited version of little endian UTF16. As far as - the Erlang programmer is concerned, Windows native Unicode format - is UTF-8...</p> </description> <datatypes> @@ -535,8 +529,8 @@ <name name="list_dir_all" arity="1"/> <fsummary>List all files in a directory</fsummary> <desc> - <p>Lists all the files in a directory, including files with - "raw" names. + <p><marker id="list_dir_all"/>Lists all the files in a directory, + including files with "raw" names. Returns <c>{ok, <anno>Filenames</anno>}</c> if successful. Otherwise, it returns <c>{error, <anno>Reason</anno>}</c>. <c><anno>Filenames</anno></c> is a list of @@ -653,11 +647,14 @@ </func> <func> <name name="native_name_encoding" arity="0"/> - <fsummary>Return the VM's configured filename encoding.</fsummary> + <fsummary>Return the VM's configured filename encoding</fsummary> <desc> - <p>This function returns the configured default file name encoding to use for raw file names. Generally an application supplying file names raw (as binaries), should obey the character encoding returned by this function.</p> - <p>By default, the VM uses ISO-latin-1 file name encoding on filesystems and/or OSes that use completely transparent file naming. This includes all Unix versions except MacOSX, where the vfs layer enforces UTF-8 file naming. By giving the experimental option <c>+fnu</c> when starting Erlang, UTF-8 translation of file names can be turned on even for those systems. If Unicode file name translation is in effect, the system behaves as usual as long as file names conform to the encoding, but will return file names that are not properly encoded in UTF-8 as raw file names (i.e. binaries).</p> - <p>On Windows, this function also returns <c>utf8</c> by default. The OS uses a pure Unicode naming scheme and file names are always possible to interpret as valid Unicode. The fact that the underlying Windows OS actually encodes file names using little endian UTF-16 can be ignored by the Erlang programmer. Windows and MacOSX are the only operating systems where the VM operates in Unicode file name mode by default.</p> + <p><marker id="native_name_encoding"/>This function returns + the file name encoding mode. If it is <c>latin1</c>, the + system does no translation of file names. If it is + <c>utf8</c>, file names will be converted back and forth to + the native file name encoding (usually UTF-8, but UTF-16 on + Windows).</p> </desc> </func> <func> @@ -1450,7 +1447,8 @@ <name name="read_link" arity="1"/> <fsummary>See what a link is pointing to</fsummary> <desc> - <p>This function returns <c>{ok, <anno>Filename</anno>}</c> if + <p><marker id="read_link_all"/>This function returns + <c>{ok, <anno>Filename</anno>}</c> if <c><anno>Name</anno></c> refers to a symbolic link that is not a "raw" file name, or <c>{error, <anno>Reason</anno>}</c> otherwise. @@ -1746,16 +1744,16 @@ <item>The chunk size used by the erlang fallback to send data. If using the fallback, this should be set to a value which comfortably fits in the systems memory. Default is 20 MB.</item> + <tag><c>use_threads</c></tag> + <item>Instruct the emulator to use the async thread pool for the + sendfile system call. This could be usefull if the OS you are running + on does not properly support non-blocking sendfile calls. Do note that + using async threads potentially makes your system volnerable to slow + client attacks. If set to true and no async threads are available, + the sendfile call will return <c>{error,einval}</c>. + Introduced in 17.0. Default is false.</item> </taglist> </p> - <p>On operating systems with thread support, it is recommended to use - async threads. See the command line flag - <c>+A</c> in <seealso marker="erts:erl">erl(1)</seealso>. If it is not - possible to use async threads for sendfile, it is recommended to use - a relatively small value for the send buffer on the socket. Otherwise - the Erlang VM might loose some of its soft realtime guarantees. - Which size to use depends on the OS/hardware and the requirements - of the application.</p> </desc> </func> <func> diff --git a/lib/kernel/src/file.erl b/lib/kernel/src/file.erl index b5152018e0..23cf74f80f 100644 --- a/lib/kernel/src/file.erl +++ b/lib/kernel/src/file.erl @@ -111,7 +111,8 @@ -type date_time() :: calendar:datetime(). -type posix_file_advise() :: 'normal' | 'sequential' | 'random' | 'no_reuse' | 'will_need' | 'dont_need'. --type sendfile_option() :: {chunk_size, non_neg_integer()}. +-type sendfile_option() :: {chunk_size, non_neg_integer()} + | {use_threads, boolean()}. -type file_info_option() :: {'time', 'local'} | {'time', 'universal'} | {'time', 'posix'}. %%% BIFs @@ -1229,8 +1230,7 @@ change_time(Name, {{AY, AM, AD}, {AH, AMin, ASec}}=Atime, sendfile(File, _Sock, _Offet, _Bytes, _Opts) when is_pid(File) -> {error, badarg}; sendfile(File, Sock, Offset, Bytes, []) -> - sendfile(File, Sock, Offset, Bytes, ?MAX_CHUNK_SIZE, [], [], - false, false, false); + sendfile(File, Sock, Offset, Bytes, ?MAX_CHUNK_SIZE, [], [], []); sendfile(File, Sock, Offset, Bytes, Opts) -> ChunkSize0 = proplists:get_value(chunk_size, Opts, ?MAX_CHUNK_SIZE), ChunkSize = if ChunkSize0 > ?MAX_CHUNK_SIZE -> @@ -1240,8 +1240,7 @@ sendfile(File, Sock, Offset, Bytes, Opts) -> %% Support for headers, trailers and options has been removed because the %% Darwin and BSD API for using it does not play nice with %% non-blocking sockets. See unix_efile.c for more info. - sendfile(File, Sock, Offset, Bytes, ChunkSize, [], [], - false,false,false). + sendfile(File, Sock, Offset, Bytes, ChunkSize, [], [], Opts). %% sendfile/2 -spec sendfile(Filename, Socket) -> @@ -1261,17 +1260,17 @@ sendfile(Filename, Sock) -> %% Internal sendfile functions sendfile(#file_descriptor{ module = Mod } = Fd, Sock, Offset, Bytes, - ChunkSize, Headers, Trailers, Nodiskio, MNowait, Sync) + ChunkSize, Headers, Trailers, Opts) when is_port(Sock) -> case Mod:sendfile(Fd, Sock, Offset, Bytes, ChunkSize, Headers, Trailers, - Nodiskio, MNowait, Sync) of + Opts) of {error, enotsup} -> sendfile_fallback(Fd, Sock, Offset, Bytes, ChunkSize, Headers, Trailers); Else -> Else end; -sendfile(_,_,_,_,_,_,_,_,_,_) -> +sendfile(_,_,_,_,_,_,_,_) -> {error, badarg}. %%% diff --git a/lib/kernel/test/sendfile_SUITE.erl b/lib/kernel/test/sendfile_SUITE.erl index 24884bada5..2c741232c4 100644 --- a/lib/kernel/test/sendfile_SUITE.erl +++ b/lib/kernel/test/sendfile_SUITE.erl @@ -24,7 +24,14 @@ -compile(export_all). -all() -> +all() -> [{group,async_threads}, + {group,no_async_threads}]. + +groups() -> + [{async_threads,[],tcs()}, + {no_async_threads,[],tcs()}]. + +tcs() -> [t_sendfile_small ,t_sendfile_big_all ,t_sendfile_big_size @@ -64,6 +71,14 @@ init_per_suite(Config) -> end_per_suite(Config) -> file:delete(proplists:get_value(big_file, Config)). +init_per_group(async_threads,Config) -> + [{sendfile_opts,[{use_threads,true}]}|Config]; +init_per_group(no_async_threads,Config) -> + [{sendfile_opts,[{use_threads,false}]}|Config]. + +end_per_group(_,_Config) -> + ok. + init_per_testcase(TC,Config) when TC == t_sendfile_recvduring; TC == t_sendfile_sendduring -> Filename = proplists:get_value(small_file, Config), @@ -72,7 +87,7 @@ init_per_testcase(TC,Config) when TC == t_sendfile_recvduring; {_Size, Data} = sendfile_file_info(Filename), {ok,D} = file:open(Filename, [raw,binary,read]), prim_file:sendfile(D, Sock, 0, 0, 0, - [],[],false,false,false), + [],[],[]), Data end, @@ -93,6 +108,7 @@ t_sendfile_small(Config) when is_list(Config) -> Send = fun(Sock) -> {Size, Data} = sendfile_file_info(Filename), + %% Here we make sure to test the sendfile/2 api {ok, Size} = file:sendfile(Filename, Sock), Data end, @@ -102,6 +118,7 @@ t_sendfile_small(Config) when is_list(Config) -> t_sendfile_many_small(Config) when is_list(Config) -> Filename = proplists:get_value(small_file, Config), FileOpts = proplists:get_value(file_opts, Config, []), + SendfileOpts = proplists:get_value(sendfile_opts, Config), error_logger:add_report_handler(?MODULE,[self()]), @@ -110,7 +127,7 @@ t_sendfile_many_small(Config) when is_list(Config) -> N = 10000, {ok,D} = file:open(Filename,[read|FileOpts]), [begin - {ok,Size} = file:sendfile(D,Sock,0,0,[]) + {ok,Size} = file:sendfile(D,Sock,0,0,SendfileOpts) end || _I <- lists:seq(1,N)], file:close(D), Size*N @@ -128,11 +145,12 @@ t_sendfile_many_small(Config) when is_list(Config) -> t_sendfile_big_all(Config) when is_list(Config) -> Filename = proplists:get_value(big_file, Config), + SendfileOpts = proplists:get_value(sendfile_opts, Config), Send = fun(Sock) -> {ok, #file_info{size = Size}} = file:read_file_info(Filename), - {ok, Size} = file:sendfile(Filename, Sock), + {ok, Size} = sendfile(Filename, Sock, SendfileOpts), Size end, @@ -141,12 +159,13 @@ t_sendfile_big_all(Config) when is_list(Config) -> t_sendfile_big_size(Config) -> Filename = proplists:get_value(big_file, Config), FileOpts = proplists:get_value(file_opts, Config, []), + SendfileOpts = proplists:get_value(sendfile_opts, Config), SendAll = fun(Sock) -> {ok, #file_info{size = Size}} = file:read_file_info(Filename), {ok,D} = file:open(Filename,[read|FileOpts]), - {ok, Size} = file:sendfile(D, Sock,0,Size,[]), + {ok, Size} = file:sendfile(D, Sock,0,Size,SendfileOpts), Size end, @@ -155,12 +174,13 @@ t_sendfile_big_size(Config) -> t_sendfile_partial(Config) -> Filename = proplists:get_value(small_file, Config), FileOpts = proplists:get_value(file_opts, Config, []), + SendfileOpts = proplists:get_value(sendfile_opts, Config), SendSingle = fun(Sock) -> {_Size, <<Data:5/binary,_/binary>>} = sendfile_file_info(Filename), {ok,D} = file:open(Filename,[read|FileOpts]), - {ok,5} = file:sendfile(D,Sock,0,5,[]), + {ok,5} = file:sendfile(D,Sock,0,5,SendfileOpts), file:close(D), Data end, @@ -171,14 +191,14 @@ t_sendfile_partial(Config) -> {ok,D} = file:open(Filename,[read|FileOpts]), {ok, <<FData/binary>>} = file:read(D,5), FSend = fun(Sock) -> - {ok,5} = file:sendfile(D,Sock,0,5,[]), + {ok,5} = file:sendfile(D,Sock,0,5,SendfileOpts), FData end, ok = sendfile_send(FSend), SSend = fun(Sock) -> - {ok,3} = file:sendfile(D,Sock,5,3,[]), + {ok,3} = file:sendfile(D,Sock,5,3,SendfileOpts), SData end, @@ -191,12 +211,13 @@ t_sendfile_partial(Config) -> t_sendfile_offset(Config) -> Filename = proplists:get_value(small_file, Config), FileOpts = proplists:get_value(file_opts, Config, []), + SendfileOpts = proplists:get_value(sendfile_opts, Config), Send = fun(Sock) -> {_Size, <<_:5/binary,Data:3/binary,_/binary>> = AllData} = sendfile_file_info(Filename), {ok,D} = file:open(Filename,[read|FileOpts]), - {ok,3} = file:sendfile(D,Sock,5,3,[]), + {ok,3} = file:sendfile(D,Sock,5,3,SendfileOpts), {ok, AllData} = file:read(D,100), file:close(D), Data @@ -206,10 +227,11 @@ t_sendfile_offset(Config) -> t_sendfile_sendafter(Config) -> Filename = proplists:get_value(small_file, Config), + SendfileOpts = proplists:get_value(sendfile_opts, Config), Send = fun(Sock) -> {Size, Data} = sendfile_file_info(Filename), - {ok, Size} = file:sendfile(Filename, Sock), + {ok, Size} = sendfile(Filename, Sock, SendfileOpts), ok = gen_tcp:send(Sock, <<2>>), <<Data/binary,2>> end, @@ -218,10 +240,11 @@ t_sendfile_sendafter(Config) -> t_sendfile_recvafter(Config) -> Filename = proplists:get_value(small_file, Config), + SendfileOpts = proplists:get_value(sendfile_opts, Config), Send = fun(Sock) -> {Size, Data} = sendfile_file_info(Filename), - {ok, Size} = file:sendfile(Filename, Sock), + {ok, Size} = sendfile(Filename, Sock, SendfileOpts), ok = gen_tcp:send(Sock, <<1>>), {ok,<<1>>} = gen_tcp:recv(Sock, 1), <<Data/binary,1>> @@ -250,6 +273,7 @@ t_sendfile_recvafter_remoteclose(Config) -> t_sendfile_sendduring(Config) -> Filename = proplists:get_value(big_file, Config), + SendfileOpts = proplists:get_value(sendfile_opts, Config), Send = fun(Sock) -> {ok, #file_info{size = Size}} = @@ -258,7 +282,7 @@ t_sendfile_sendduring(Config) -> timer:sleep(50), ok = gen_tcp:send(Sock, <<2>>) end), - {ok, Size} = file:sendfile(Filename, Sock), + {ok, Size} = sendfile(Filename, Sock, SendfileOpts), Size+1 end, @@ -266,6 +290,7 @@ t_sendfile_sendduring(Config) -> t_sendfile_recvduring(Config) -> Filename = proplists:get_value(big_file, Config), + SendfileOpts = proplists:get_value(sendfile_opts, Config), Send = fun(Sock) -> {ok, #file_info{size = Size}} = @@ -275,7 +300,7 @@ t_sendfile_recvduring(Config) -> ok = gen_tcp:send(Sock, <<1>>), {ok,<<1>>} = gen_tcp:recv(Sock, 1) end), - {ok, Size} = file:sendfile(Filename, Sock), + {ok, Size} = sendfile(Filename, Sock, SendfileOpts), timer:sleep(1000), Size+1 end, @@ -284,6 +309,7 @@ t_sendfile_recvduring(Config) -> t_sendfile_closeduring(Config) -> Filename = proplists:get_value(big_file, Config), + SendfileOpts = proplists:get_value(sendfile_opts, Config), Send = fun(Sock,SFServPid) -> spawn_link(fun() -> @@ -292,13 +318,14 @@ t_sendfile_closeduring(Config) -> end), case erlang:system_info(thread_pool_size) of 0 -> - {error, closed} = file:sendfile(Filename, Sock); + {error, closed} = sendfile(Filename, Sock, + SendfileOpts); _Else -> %% This can return how much has been sent or %% {error,closed} depending on OS. %% How much is sent impossible to know as %% the socket was closed mid sendfile - case file:sendfile(Filename, Sock) of + case sendfile(Filename, Sock, SendfileOpts) of {error, closed} -> ok; {ok, Size} when is_integer(Size) -> @@ -312,6 +339,7 @@ t_sendfile_closeduring(Config) -> t_sendfile_crashduring(Config) -> Filename = proplists:get_value(big_file, Config), + SendfileOpts = proplists:get_value(sendfile_opts, Config), error_logger:add_report_handler(?MODULE,[self()]), @@ -320,7 +348,7 @@ t_sendfile_crashduring(Config) -> timer:sleep(50), exit(die) end), - {error, closed} = file:sendfile(Filename, Sock), + {error, closed} = sendfile(Filename, Sock, SendfileOpts), -1 end, process_flag(trap_exit,true), @@ -415,6 +443,16 @@ sendfile_file_info(File) -> {ok, Data} = file:read_file(File), {Size, Data}. +sendfile(Filename,Sock,Opts) -> + case file:open(Filename, [read, raw, binary]) of + {error, Reason} -> + {error, Reason}; + {ok, Fd} -> + Res = file:sendfile(Fd, Sock, 0, 0, Opts), + _ = file:close(Fd), + Res + end. + %% Error handler diff --git a/lib/megaco/src/binary/depend.mk b/lib/megaco/src/binary/depend.mk index b9b86d3183..4225bc69dc 100644 --- a/lib/megaco/src/binary/depend.mk +++ b/lib/megaco/src/binary/depend.mk @@ -28,7 +28,7 @@ # This means that the ASN.1 runtime library will be inlined. # -ASN1_CT_OPTS += +noobj +ASN1_CT_OPTS += +noobj +legacy_erlang_types ifeq ($(MEGACO_INLINE_ASN1_RT),true) # We need atleast version 1.4.6 of the ANS.1 application ASN1_CT_OPTS += +inline diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl index 68784a175e..a7361755e5 100644 --- a/lib/ssl/test/ssl_to_openssl_SUITE.erl +++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl @@ -248,7 +248,7 @@ basic_erlang_server_openssl_client(Config) when is_list(Config) -> Port = ssl_test_lib:inet_port(Server), Cmd = "openssl s_client -port " ++ integer_to_list(Port) ++ - " -host localhost", + " -host localhost" ++ workaround_openssl_s_clinent(), ct:log("openssl cmd: ~p~n", [Cmd]), @@ -1383,3 +1383,20 @@ supports_sslv2(Port) -> true end. +workaround_openssl_s_clinent() -> + %% http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=683159 + %% https://bugs.archlinux.org/task/33919 + %% Bug seems to manifests it self if TLS version is not + %% explicitly specified + case os:cmd("openssl version") of + "OpenSSL 1.0.1c" ++ _ -> + " -no_tls1_2 "; + "OpenSSL 1.0.1d" ++ _ -> + " -no_tls1_2 "; + "OpenSSL 1.0.1e" ++ _ -> + " -no_tls1_2 "; + "OpenSSL 1.0.1f" ++ _ -> + " -no_tls1_2 "; + _ -> + "" + end. diff --git a/lib/stdlib/doc/src/unicode_usage.xml b/lib/stdlib/doc/src/unicode_usage.xml index 33cd70e0b7..ee7dd128f1 100644 --- a/lib/stdlib/doc/src/unicode_usage.xml +++ b/lib/stdlib/doc/src/unicode_usage.xml @@ -52,8 +52,8 @@ for UTF-8 and more support for Unicode character sets in the I/O-system.</p> - <p>In R17, the encoding default for Erlang source files will be - switched to UTF-8 and in R18 Erlang will support atoms in the full + <p>In 17.0, the encoding default for Erlang source files was + switched to UTF-8 and in 18.0 Erlang will support atoms in the full Unicode range, meaning full Unicode function and module names</p> @@ -290,7 +290,7 @@ <item>Having the source code in UTF-8 also allows you to write string literals containing Unicode characters with code points > 255, although atoms, module names and function names will be - restricted to the ISO-Latin-1 range until the R18 release. Binary + restricted to the ISO-Latin-1 range until the 18.0 release. Binary literals where you use the <c>/utf8</c> type, can also be expressed using Unicode characters > 255. Having module names using characters other than 7-bit ASCII can cause trouble on @@ -385,7 +385,7 @@ external_charlist() = maybe_improper_list(char() | using characters from the ISO-latin-1 character set and atoms are restricted to the same ISO-latin-1 range. These restrictions in the language are of course independent of the encoding of the source - file. Erlang/OTP R18 is expected to handle functions named in + file. Erlang/OTP 18.0 is expected to handle functions named in Unicode as well as Unicode atoms.</p> <section> <title>Bit-syntax</title> @@ -662,11 +662,14 @@ Eshell V5.10.1 (abort with ^G) containing characters having code points between 128 and 255 may be named either as plain ISO-latin-1 or using UTF-8 encoding. As no consistency is enforced, the Erlang VM can do no consistent - translation of all file names. If the VM would automatically - select encoding based on heuristics, one could get unexpected - behavior on these systems. By default, Erlang starts in "latin1" - file name mode on such systems, meaning bytewise encoding in file - names. This allows for list representation of all file names in + translation of all file names.</p> + + <p>By default on such systems, Erlang starts in <c>utf8</c> file + name mode if the terminal supports UTF-8, otherwise in + <c>latin1</c> mode.</p> + + <p>In the <c>latin1</c> mode, file names are bytewise endcoded. + This allows for list representation of all file names in the system, but, for example, a file named "Östersund.txt", will appear in <c>file:list_dir/1</c> as either "Östersund.txt" (if the file name was encoded in bytewise ISO-Latin-1 by the program @@ -752,7 +755,7 @@ Eshell V5.10.1 (abort with ^G) <section> <title>Notes About Raw File Names</title> - + <marker id="notes-about-raw-filenames"/> <p>Raw file names were introduced together with Unicode file name support in erts-5.8.2 (OTP R14B01). The reason "raw file names" was introduced in the system was to be able to @@ -1014,7 +1017,8 @@ ok allowed. This setting should correspond to the actual terminal you are using.</p> <p>The environment can also affect file name interpretation, if - Erlang is started with the <c>+fna</c> flag.</p> + Erlang is started with the <c>+fna</c> flag (which is default from + Erlang/OTP 17.0).</p> <p>You can check the setting of this by calling <c>io:getopts()</c>, which will give you an option list containing <c>{encoding,unicode}</c> or @@ -1046,8 +1050,7 @@ ok > 255.</p> <p><c>+fnl</c> means bytewise interpretation of file names, which was the usual way to represent ISO-Latin-1 file names before - UTF-8 file naming got widespread. This is the default on all - Unix-like operating systems except MacOS X.</p> + UTF-8 file naming got widespread.</p> <p><c>+fnu</c> means that file names are encoded in UTF-8, which is nowadays the common scheme (although not enforced).</p> <p><c>+fna</c> means that you automatically select between @@ -1055,8 +1058,8 @@ ok <c>LC_CTYPE</c> environment variables. This is optimistic heuristics indeed, nothing enforces a user to have a terminal with the same encoding as the file system, but usually, this is - the case. This might be the default behavior in a future - release.</p> + the case. This is the default on all Unix-like operating + systems except MacOS X.</p> <p>The file name translation mode can be read with the <c>file:native_name_encoding/0</c> function, which returns @@ -1068,7 +1071,7 @@ ok <p>This function returns the default encoding for Erlang source files (if no encoding comment is present) in the currently running release. For R16 this returns <c>latin1</c> (meaning - bytewise encoding). In R17 and forward it is expected to return + bytewise encoding). In 17.0 and forward it returns <c>utf8</c>.</p> <p>The encoding of each file can be specified using comments as described in diff --git a/lib/stdlib/examples/erl_id_trans.erl b/lib/stdlib/examples/erl_id_trans.erl index 2c842fafc7..5fcb74310e 100644 --- a/lib/stdlib/examples/erl_id_trans.erl +++ b/lib/stdlib/examples/erl_id_trans.erl @@ -144,6 +144,13 @@ pattern({cons,Line,H0,T0}) -> pattern({tuple,Line,Ps0}) -> Ps1 = pattern_list(Ps0), {tuple,Line,Ps1}; +pattern({map,Line,Ps0}) -> + Ps1 = pattern_list(Ps0), + {map,Line,Ps1}; +pattern({map_field_exact,Line,K,V}) -> + Ke = pattern(K), + Ve = pattern(V), + {map_field_exact,Line,Ke,Ve}; %%pattern({struct,Line,Tag,Ps0}) -> %% Ps1 = pattern_list(Ps0), %% {struct,Line,Tag,Ps1}; @@ -251,6 +258,20 @@ gexpr({float,Line,F}) -> {float,Line,F}; gexpr({atom,Line,A}) -> {atom,Line,A}; gexpr({string,Line,S}) -> {string,Line,S}; gexpr({nil,Line}) -> {nil,Line}; +gexpr({map,Line,Map0,Es0}) -> + [Map1|Es1] = gexpr_list([Map0|Es0]), + {map,Line,Map1,Es1}; +gexpr({map,Line,Es0}) -> + Es1 = gexpr_list(Es0), + {map,Line,Es1}; +gexpr({map_field_assoc,Line,K,V}) -> + Ke = gexpr(K), + Ve = gexpr(V), + {map_field_assoc,Line,Ke,Ve}; +gexpr({map_field_exact,Line,K,V}) -> + Ke = gexpr(K), + Ve = gexpr(V), + {map_field_exact,Line,Ke,Ve}; gexpr({cons,Line,H0,T0}) -> H1 = gexpr(H0), T1 = gexpr(T0), %They see the same variables @@ -356,6 +377,20 @@ expr({bc,Line,E0,Qs0}) -> expr({tuple,Line,Es0}) -> Es1 = expr_list(Es0), {tuple,Line,Es1}; +expr({map,Line,Map0,Es0}) -> + [Map1|Es1] = exprs([Map0|Es0]), + {map,Line,Map1,Es1}; +expr({map,Line,Es0}) -> + Es1 = exprs(Es0), + {map,Line,Es1}; +expr({map_field_assoc,Line,K,V}) -> + Ke = expr(K), + Ve = expr(V), + {map_field_assoc,Line,Ke,Ve}; +expr({map_field_exact,Line,K,V}) -> + Ke = expr(K), + Ve = expr(V), + {map_field_exact,Line,Ke,Ve}; %%expr({struct,Line,Tag,Es0}) -> %% Es1 = pattern_list(Es0), %% {struct,Line,Tag,Es1}; diff --git a/lib/stdlib/src/Makefile b/lib/stdlib/src/Makefile index f3387d669b..9ab2cd4134 100644 --- a/lib/stdlib/src/Makefile +++ b/lib/stdlib/src/Makefile @@ -91,6 +91,7 @@ MODULES= \ lib \ lists \ log_mf_h \ + maps \ math \ ms_transform \ otp_internal \ diff --git a/lib/stdlib/src/erl_eval.erl b/lib/stdlib/src/erl_eval.erl index 18d8148b15..5f96795d92 100644 --- a/lib/stdlib/src/erl_eval.erl +++ b/lib/stdlib/src/erl_eval.erl @@ -239,6 +239,29 @@ expr({record,_,Name,_}, _Bs, _Lf, _Ef, _RBs) -> erlang:raise(error, {undef_record,Name}, stacktrace()); expr({record,_,_,Name,_}, _Bs, _Lf, _Ef, _RBs) -> erlang:raise(error, {undef_record,Name}, stacktrace()); + +%% map +expr({map_field_assoc,_,EK, EV}, Bs0, Lf, Ef, RBs) -> + {value,K,Bs1} = expr(EK, Bs0, Lf, Ef, none), + {value,V,Bs2} = expr(EV, Bs0, Lf, Ef, none), + ret_expr({map_assoc,K,V}, merge_bindings(Bs1,Bs2), RBs); +expr({map_field_exact,_,EK, EV}, Bs0, Lf, Ef, RBs) -> + {value,K,Bs1} = expr(EK, Bs0, Lf, Ef, none), + {value,V,Bs2} = expr(EV, Bs0, Lf, Ef, none), + ret_expr({map_exact,K,V}, merge_bindings(Bs1,Bs2), RBs); +expr({map,_, Binding,Es}, Bs0, Lf, Ef, RBs) -> + {value, Map0, Bs1} = expr(Binding, Bs0, Lf, Ef, RBs), + {Vs,Bs} = expr_list(Es, Bs1, Lf, Ef), + ret_expr(lists:foldl(fun + ({map_assoc,K,V}, Mi) -> maps:put(K,V,Mi); + ({map_exact,K,V}, Mi) -> maps:update(K,V,Mi) + end, Map0, Vs), Bs, RBs); +expr({map,_,Es}, Bs0, Lf, Ef, RBs) -> + {Vs,Bs} = expr_list(Es, Bs0, Lf, Ef), + ret_expr(lists:foldl(fun + ({map_assoc,K,V}, Mi) -> maps:put(K,V,Mi) + end, maps:new(), Vs), Bs, RBs); + expr({block,_,Es}, Bs, Lf, Ef, RBs) -> exprs(Es, Bs, Lf, Ef, RBs); expr({'if',_,Cs}, Bs, Lf, Ef, RBs) -> @@ -994,6 +1017,7 @@ type_test(port) -> is_port; type_test(function) -> is_function; type_test(binary) -> is_binary; type_test(record) -> is_record; +type_test(map) -> is_map; type_test(Test) -> Test. @@ -1075,6 +1099,9 @@ match1({tuple,_,Elts}, Tuple, Bs, BBs) match_tuple(Elts, Tuple, 1, Bs, BBs); match1({tuple,_,_}, _, _Bs, _BBs) -> throw(nomatch); +match1({map,_,Fs}, Map, Bs, BBs) -> + match_map(Fs, Map, Bs, BBs); + match1({bin, _, Fs}, <<_/bitstring>>=B, Bs0, BBs) -> eval_bits:match_bits(Fs, B, Bs0, BBs, match_fun(BBs), @@ -1118,6 +1145,18 @@ match_tuple([E|Es], Tuple, I, Bs0, BBs) -> match_tuple([], _, _, Bs, _BBs) -> {match,Bs}. +match_map([{map_field_exact, _, K, V}|Fs], Map, Bs0, BBs) -> + Vm = try + {value, Ke, _} = expr(K, new_bindings()), + maps:get(Ke,Map) + catch error:_ -> + throw(nomatch) + end, + {match, Bs} = match1(V, Vm, Bs0, BBs), + match_map(Fs, Map, Bs, BBs); +match_map([], _, Bs, _) -> + {match, Bs}. + %% match_list(PatternList, TermList, Bindings) -> %% {match,NewBindings} | nomatch %% Try to match a list of patterns against a list of terms with the diff --git a/lib/stdlib/src/erl_expand_records.erl b/lib/stdlib/src/erl_expand_records.erl index 776b433613..4741bef6b9 100644 --- a/lib/stdlib/src/erl_expand_records.erl +++ b/lib/stdlib/src/erl_expand_records.erl @@ -132,6 +132,12 @@ pattern({cons,Line,H,T}, St0) -> pattern({tuple,Line,Ps}, St0) -> {TPs,St1} = pattern_list(Ps, St0), {{tuple,Line,TPs},St1}; +pattern({map,Line,Ps}, St0) -> + {TPs,St1} = pattern_list(Ps, St0), + {{map,Line,TPs},St1}; +pattern({map_field_exact,Line,Key,V0}, St0) -> + {V,St1} = pattern(V0, St0), + {{map_field_exact,Line,Key,V},St1}; %%pattern({struct,Line,Tag,Ps}, St0) -> %% {TPs,TPsvs,St1} = pattern_list(Ps, St0), %% {{struct,Line,Tag,TPs},TPsvs,St1}; @@ -301,6 +307,20 @@ expr({bc,Line,E0,Qs0}, St0) -> expr({tuple,Line,Es0}, St0) -> {Es1,St1} = expr_list(Es0, St0), {{tuple,Line,Es1},St1}; +expr({map,Line,Es0}, St0) -> + {Es1,St1} = expr_list(Es0, St0), + {{map,Line,Es1},St1}; +expr({map,Line,Var,Es0}, St0) -> + {Es1,St1} = expr_list(Es0, St0), + {{map,Line,Var,Es1},St1}; +expr({map_field_assoc,Line,K0,V0}, St0) -> + {K,St1} = expr(K0, St0), + {V,St2} = expr(V0, St1), + {{map_field_assoc,Line,K,V},St2}; +expr({map_field_exact,Line,K0,V0}, St0) -> + {K,St1} = expr(K0, St0), + {V,St2} = expr(V0, St1), + {{map_field_exact,Line,K,V},St2}; %%expr({struct,Line,Tag,Es0}, Vs, St0) -> %% {Es1,Esvs,Esus,St1} = expr_list(Es0, Vs, St0), %% {{struct,Line,Tag,Es1},Esvs,Esus,St1}; diff --git a/lib/stdlib/src/erl_internal.erl b/lib/stdlib/src/erl_internal.erl index 28de7205ea..edfb097de0 100644 --- a/lib/stdlib/src/erl_internal.erl +++ b/lib/stdlib/src/erl_internal.erl @@ -70,6 +70,7 @@ guard_bif(bit_size, 1) -> true; guard_bif(byte_size, 1) -> true; guard_bif(element, 2) -> true; guard_bif(self, 0) -> true; +guard_bif(map_size, 1) -> true; guard_bif(node, 0) -> true; guard_bif(node, 1) -> true; guard_bif(tuple_size, 1) -> true; @@ -82,6 +83,7 @@ guard_bif(is_function, 1) -> true; guard_bif(is_function, 2) -> true; guard_bif(is_integer, 1) -> true; guard_bif(is_list, 1) -> true; +guard_bif(is_map, 1) -> true; guard_bif(is_number, 1) -> true; guard_bif(is_pid, 1) -> true; guard_bif(is_port, 1) -> true; @@ -113,6 +115,7 @@ new_type_test(is_function, 1) -> true; new_type_test(is_function, 2) -> true; new_type_test(is_integer, 1) -> true; new_type_test(is_list, 1) -> true; +new_type_test(is_map, 1) -> true; new_type_test(is_number, 1) -> true; new_type_test(is_pid, 1) -> true; new_type_test(is_port, 1) -> true; @@ -315,6 +318,7 @@ bif(is_function, 1) -> true; bif(is_function, 2) -> true; bif(is_integer, 1) -> true; bif(is_list, 1) -> true; +bif(is_map, 1) -> true; bif(is_number, 1) -> true; bif(is_pid, 1) -> true; bif(is_port, 1) -> true; @@ -335,6 +339,7 @@ bif(list_to_pid, 1) -> true; bif(list_to_tuple, 1) -> true; bif(load_module, 2) -> true; bif(make_ref, 0) -> true; +bif(map_size,1) -> true; bif(max,2) -> true; bif(min,2) -> true; bif(module_loaded, 1) -> true; diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index f0d50df4c7..f630db6032 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -225,6 +225,8 @@ format_error({too_many_arguments,Arity}) -> "maximum allowed is ~w", [Arity,?MAX_ARGUMENTS]); %% --- patterns and guards --- format_error(illegal_pattern) -> "illegal pattern"; +format_error({illegal_map_key_variable,K}) -> + io_lib:format("illegal use of variable ~w in map",[K]); format_error(illegal_bin_pattern) -> "binary patterns cannot be matched in parallel using '='"; format_error(illegal_expr) -> "illegal expression"; @@ -232,6 +234,9 @@ format_error({illegal_guard_local_call, {F,A}}) -> io_lib:format("call to local/imported function ~w/~w is illegal in guard", [F,A]); format_error(illegal_guard_expr) -> "illegal guard expression"; +%% --- maps --- +format_error(illegal_map_construction) -> + "only association operators '=>' are allowed in map construction"; %% --- records --- format_error({undefined_record,T}) -> io_lib:format("record ~w undefined", [T]); @@ -1366,6 +1371,19 @@ pattern({cons,_Line,H,T}, Vt, Old, Bvt, St0) -> {vtmerge_pat(Hvt, Tvt),vtmerge_pat(Bvt1,Bvt2),St2}; pattern({tuple,_Line,Ps}, Vt, Old, Bvt, St) -> pattern_list(Ps, Vt, Old, Bvt, St); +pattern({map,_Line,Ps}, Vt, Old, Bvt, St) -> + pattern_list(Ps, Vt, Old, Bvt, St); +pattern({map_field_assoc,Line,_,_}, _, _, _, St) -> + {[],[],add_error(Line, illegal_pattern, St)}; +pattern({map_field_exact,Line,KP,VP}, Vt, Old, Bvt0, St0) -> + %% if the key pattern has variables we should fail + case expr(KP,[],St0) of + {[],_} -> + pattern(VP, Vt, Old, Bvt0, St0); + {[Var|_],_} -> + %% found variables in key expression + {Vt,Old,add_error(Line,{illegal_map_key_variable,element(1,Var)},St0)} + end; %%pattern({struct,_Line,_Tag,Ps}, Vt, Old, Bvt, St) -> %% pattern_list(Ps, Vt, Old, Bvt, St); pattern({record_index,Line,Name,Field}, _Vt, _Old, _Bvt, St) -> @@ -1753,6 +1771,14 @@ gexpr({cons,_Line,H,T}, Vt, St) -> gexpr_list([H,T], Vt, St); gexpr({tuple,_Line,Es}, Vt, St) -> gexpr_list(Es, Vt, St); +gexpr({map,_Line,Es}, Vt, St) -> + gexpr_list(Es, Vt, St); +gexpr({map,_Line,Src,Es}, Vt, St) -> + gexpr_list([Src|Es], Vt, St); +gexpr({map_field_assoc,_Line,K,V}, Vt, St) -> + gexpr_list([K,V], Vt, St); +gexpr({map_field_exact,_Line,K,V}, Vt, St) -> + gexpr_list([K,V], Vt, St); gexpr({record_index,Line,Name,Field}, _Vt, St) -> check_record(Line, Name, St, fun (Dfs, St1) -> record_field(Field, Name, Dfs, St1) end ); @@ -1970,6 +1996,24 @@ expr({bc,_Line,E,Qs}, Vt, St) -> handle_comprehension(E, Qs, Vt, St); expr({tuple,_Line,Es}, Vt, St) -> expr_list(Es, Vt, St); +expr({map,Line,Es}, Vt, St) -> + {Rvt,St1} = expr_list(Es,Vt,St), + case is_valid_map_construction(Es) of + true -> {Rvt,St1}; + false -> {[],add_error(Line,illegal_map_construction,St1)} + end; +expr({map,_Line,Src,Es}, Vt, St) -> + expr_list([Src|Es], Vt, St); +expr({map_field_assoc,Line,K,V}, Vt, St) -> + case is_valid_map_key(K,St) of + true -> expr_list([K,V], Vt, St); + {false,Var} -> {[],add_error(Line,{illegal_map_key_variable,Var},St)} + end; +expr({map_field_exact,Line,K,V}, Vt, St) -> + case is_valid_map_key(K,St) of + true -> expr_list([K,V], Vt, St); + {false,Var} -> {[],add_error(Line,{illegal_map_key_variable,Var},St)} + end; expr({record_index,Line,Name,Field}, _Vt, St) -> check_record(Line, Name, St, fun (Dfs, St1) -> record_field(Field, Name, Dfs, St1) end); @@ -2229,6 +2273,20 @@ is_valid_call(Call) -> _ -> true end. +%% check_map_construction +%% Only #{ K => V }, i.e. assoc is a valid construction +is_valid_map_construction([{map_field_assoc,_,_,_}|Es]) -> + is_valid_map_construction(Es); +is_valid_map_construction([]) -> true; +is_valid_map_construction(_) -> false. + +is_valid_map_key(K,St) -> + case expr(K,[],St) of + {[],_} -> true; + {[Var|_],_} -> + {false,element(1,Var)} + end. + %% record_def(Line, RecordName, [RecField], State) -> State. %% Add a record definition if it does not already exist. Normalise %% so that all fields have explicit initial value. @@ -2549,6 +2607,13 @@ check_type({type, L, range, [From, To]}, SeenVars, St) -> _ -> add_error(L, {type_syntax, range}, St) end, {SeenVars, St1}; +check_type({type, _L, map, any}, SeenVars, St) -> {SeenVars, St}; +check_type({type, _L, map, Pairs}, SeenVars, St) -> + lists:foldl(fun(Pair, {AccSeenVars, AccSt}) -> + check_type(Pair, AccSeenVars, AccSt) + end, {SeenVars, St}, Pairs); +check_type({type, _L, map_field_assoc, Dom, Range}, SeenVars, St) -> + check_type({type, -1, product, [Dom, Range]}, SeenVars, St); check_type({type, _L, tuple, any}, SeenVars, St) -> {SeenVars, St}; check_type({type, _L, any}, SeenVars, St) -> {SeenVars, St}; check_type({type, L, binary, [Base, Unit]}, SeenVars, St) -> @@ -2654,6 +2719,7 @@ is_default_type({iodata, 0}) -> true; is_default_type({iolist, 0}) -> true; is_default_type({list, 0}) -> true; is_default_type({list, 1}) -> true; +is_default_type({map, 0}) -> true; is_default_type({maybe_improper_list, 0}) -> true; is_default_type({maybe_improper_list, 2}) -> true; is_default_type({mfa, 0}) -> true; diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl index 59a05a48ee..6316db7054 100644 --- a/lib/stdlib/src/erl_parse.yrl +++ b/lib/stdlib/src/erl_parse.yrl @@ -34,6 +34,7 @@ binary_comprehension tuple %struct record_expr record_tuple record_field record_fields +map_expr map_tuple map_field map_field_assoc map_field_exact map_fields map_key if_expr if_clause if_clauses case_expr cr_clause cr_clauses receive_expr fun_expr fun_clause fun_clauses atom_or_var integer_or_var try_expr try_catch try_clause try_clauses @@ -47,6 +48,7 @@ opt_bit_size_expr bit_size_expr opt_bit_type_list bit_type_list bit_type top_type top_type_100 top_types type typed_expr typed_attr_val type_sig type_sigs type_guard type_guards fun_type fun_type_100 binary_type type_spec spec_fun typed_exprs typed_record_fields field_types field_type +map_pair_types map_pair_type bin_base_type bin_unit_type type_200 type_300 type_400 type_500. Terminals @@ -59,7 +61,7 @@ char integer float atom string var '*' '/' 'div' 'rem' 'band' 'and' '+' '-' 'bor' 'bxor' 'bsl' 'bsr' 'or' 'xor' '++' '--' -'==' '/=' '=<' '<' '>=' '>' '=:=' '=/=' '<=' +'==' '/=' '=<' '<' '>=' '>' '=:=' '=/=' '<=' '=>' ':=' '<<' '>>' '!' '=' '::' '..' '...' 'spec' 'callback' % helper @@ -154,6 +156,8 @@ type -> '[' ']' : {type, ?line('$1'), nil, []}. type -> '[' top_type ']' : {type, ?line('$1'), list, ['$2']}. type -> '[' top_type ',' '...' ']' : {type, ?line('$1'), nonempty_list, ['$2']}. +type -> '#' '{' '}' : {type, ?line('$1'), map, []}. +type -> '#' '{' map_pair_types '}' : {type, ?line('$1'), map, '$3'}. type -> '{' '}' : {type, ?line('$1'), tuple, []}. type -> '{' top_types '}' : {type, ?line('$1'), tuple, '$2'}. type -> '#' atom '{' '}' : {type, ?line('$1'), record, ['$2']}. @@ -175,6 +179,10 @@ fun_type -> '(' top_types ')' '->' top_type : {type, ?line('$1'), 'fun', [{type, ?line('$1'), product, '$2'},'$5']}. +map_pair_types -> map_pair_type : ['$1']. +map_pair_types -> map_pair_type ',' map_pair_types : ['$1'|'$3']. +map_pair_type -> top_type '=>' top_type : {type, ?line('$2'), map_field_assoc,'$1','$3'}. + field_types -> field_type : ['$1']. field_types -> field_type ',' field_types : ['$1'|'$3']. @@ -247,6 +255,7 @@ expr_500 -> expr_600 : '$1'. expr_600 -> prefix_op expr_700 : ?mkop1('$1', '$2'). +expr_600 -> map_expr : '$1'. expr_600 -> expr_700 : '$1'. expr_700 -> function_call : '$1'. @@ -327,6 +336,30 @@ tuple -> '{' exprs '}' : {tuple,?line('$1'),'$2'}. %%struct -> atom tuple : %% {struct,?line('$1'),element(3, '$1'),element(3, '$2')}. +map_expr -> '#' map_tuple : + {map, ?line('$1'),'$2'}. +map_expr -> expr_max '#' map_tuple : + {map, ?line('$2'),'$1','$3'}. +map_expr -> map_expr '#' map_tuple : + {map, ?line('$2'),'$1','$3'}. + +map_tuple -> '{' '}' : []. +map_tuple -> '{' map_fields '}' : '$2'. + +map_fields -> map_field : ['$1']. +map_fields -> map_field ',' map_fields : ['$1' | '$3']. + +map_field -> map_field_assoc : '$1'. +map_field -> map_field_exact : '$1'. + +map_field_assoc -> map_key '=>' expr : + {map_field_assoc,?line('$1'),'$1','$3'}. + +map_field_exact -> map_key ':=' expr : + {map_field_exact,?line('$1'),'$1','$3'}. + +map_key -> expr : '$1'. + %% N.B. This is called from expr_700. %% N.B. Field names are returned as the complete object, even if they are @@ -648,6 +681,8 @@ skip_paren(Type) -> build_gen_type({atom, La, tuple}) -> {type, La, tuple, any}; +build_gen_type({atom, La, map}) -> + {type, La, map, any}; build_gen_type({atom, La, Name}) -> {type, La, Name, []}. @@ -860,6 +895,12 @@ normalise({cons,_,Head,Tail}) -> [normalise(Head)|normalise(Tail)]; normalise({tuple,_,Args}) -> list_to_tuple(normalise_list(Args)); +normalise({map,_,Pairs}=M) -> + maps:from_list(lists:map(fun + %% only allow '=>' + ({map_field_assoc,_,K,V}) -> {normalise(K),normalise(V)}; + (_) -> erlang:error({badarg,M}) + end, Pairs)); %% Special case for unary +/-. normalise({op,_,'+',{char,_,I}}) -> I; normalise({op,_,'+',{integer,_,I}}) -> I; @@ -1060,3 +1101,5 @@ get_attribute(L, Name) -> get_attributes(L) -> erl_scan:attributes_info(L). + +%% vim: ft=erlang diff --git a/lib/stdlib/src/erl_scan.erl b/lib/stdlib/src/erl_scan.erl index 4ba6dd01fa..ae59d5f44f 100644 --- a/lib/stdlib/src/erl_scan.erl +++ b/lib/stdlib/src/erl_scan.erl @@ -569,7 +569,7 @@ scan1("++"++Cs, St, Line, Col, Toks) -> tok2(Cs, St, Line, Col, Toks, "++", '++', 2); scan1("+"=Cs, _St, Line, Col, Toks) -> {more,{Cs,Col,Toks,Line,[],fun scan/6}}; -%% =:= =/= =< == +%% =:= =/= =< == => scan1("=:="++Cs, St, Line, Col, Toks) -> tok2(Cs, St, Line, Col, Toks, "=:=", '=:=', 3); scan1("=:"=Cs, _St, Line, Col, Toks) -> @@ -580,6 +580,8 @@ scan1("=/"=Cs, _St, Line, Col, Toks) -> {more,{Cs,Col,Toks,Line,[],fun scan/6}}; scan1("=<"++Cs, St, Line, Col, Toks) -> tok2(Cs, St, Line, Col, Toks, "=<", '=<', 2); +scan1("=>"++Cs, St, Line, Col, Toks) -> + tok2(Cs, St, Line, Col, Toks, "=>", '=>', 2); scan1("=="++Cs, St, Line, Col, Toks) -> tok2(Cs, St, Line, Col, Toks, "==", '==', 2); scan1("="=Cs, _St, Line, Col, Toks) -> @@ -594,6 +596,9 @@ scan1("||"++Cs, St, Line, Col, Toks) -> tok2(Cs, St, Line, Col, Toks, "||", '||', 2); scan1("|"=Cs, _St, Line, Col, Toks) -> {more,{Cs,Col,Toks,Line,[],fun scan/6}}; +%% := +scan1(":="++Cs, St, Line, Col, Toks) -> + tok2(Cs, St, Line, Col, Toks, ":=", ':=', 2); %% :- scan1(":-"++Cs, St, Line, Col, Toks) -> tok2(Cs, St, Line, Col, Toks, ":-", ':-', 2); diff --git a/lib/stdlib/src/io_lib.erl b/lib/stdlib/src/io_lib.erl index 375d05f359..adc9a0cf5f 100644 --- a/lib/stdlib/src/io_lib.erl +++ b/lib/stdlib/src/io_lib.erl @@ -257,7 +257,9 @@ write(T, D) when is_tuple(T) -> [write(element(1, T), D-1)| write_tail(tl(tuple_to_list(T)), D-1, $,)], $}] - end. + end; +%write(Term, D) when is_map(Term) -> write_map(Term, D); +write(Term, D) -> write_map(Term, D). %% write_tail(List, Depth, CharacterBeforeDots) %% Test the terminating case first as this looks better with depth. @@ -275,6 +277,18 @@ write_port(Port) -> write_ref(Ref) -> erlang:ref_to_list(Ref). +write_map(Map, D) when is_integer(D) -> + [$#,${,write_map_body(maps:to_list(Map), D),$}]. + +write_map_body(_, 0) -> "..."; +write_map_body([],_) -> []; +write_map_body([{K,V}],D) -> write_map_assoc(K,V,D); +write_map_body([{K,V}|KVs], D) -> + [write_map_assoc(K,V,D),$, | write_map_body(KVs,D-1)]. + +write_map_assoc(K,V,D) -> + [write(K,D - 1),"=>",write(V,D-1)]. + write_binary(B, D) when is_integer(D) -> [$<,$<,write_binary_body(B, D),$>,$>]. diff --git a/lib/stdlib/src/io_lib_pretty.erl b/lib/stdlib/src/io_lib_pretty.erl index 7637ad7a3d..f02a7921f8 100644 --- a/lib/stdlib/src/io_lib_pretty.erl +++ b/lib/stdlib/src/io_lib_pretty.erl @@ -101,6 +101,7 @@ print(Term, Col, Ll, D, M, RecDefFun, Enc, Str) when Col =< 0 -> print(Term, 1, Ll, D, M, RecDefFun, Enc, Str); print(Term, Col, Ll, D, M0, RecDefFun, Enc, Str) when is_tuple(Term); is_list(Term); + is_map(Term); is_bitstring(Term) -> If = {_S, Len} = print_length(Term, D, RecDefFun, Enc, Str), M = max_cs(M0, Len), @@ -137,6 +138,10 @@ pp({{tuple,true,L}, _Len}, Col, Ll, M, TInd, Ind, LD, W) -> [${, pp_tag_tuple(L, Col, Ll, M, TInd, Ind, LD, W + 1), $}]; pp({{tuple,false,L}, _Len}, Col, Ll, M, TInd, Ind, LD, W) -> [${, pp_list(L, Col + 1, Ll, M, TInd, indent(1, Ind), LD, $,, W + 1), $}]; +pp({{map,Pairs},_Len}, Col, Ll, M, TInd, Ind, LD, W) -> + [$#,${, pp_list(Pairs, Col + 2, Ll, M, TInd, indent(2, Ind), LD, $,, W + 1), $}]; +pp({{map_pair,K,V},_Len}, Col, Ll, M, TInd, Ind, LD, W) -> + [pp(K, Col, Ll, M, TInd, Ind, LD, W), " => ", pp(V, Col, Ll, M, TInd, Ind, LD, W)]; pp({{record,[{Name,NLen} | L]}, _Len}, Col, Ll, M, TInd, Ind, LD, W) -> [Name, ${, pp_record(L, NLen, Col, Ll, M, TInd, Ind, LD, W + NLen+1), $}]; pp({{bin,S}, _Len}, Col, Ll, M, _TInd, Ind, LD, W) -> @@ -283,6 +288,10 @@ write({{tuple, _IsTagged, L}, _}) -> [${, write_list(L, $,), $}]; write({{list, L}, _}) -> [$[, write_list(L, $|), $]]; +write({{map, Pairs}, _}) -> + [$#,${, write_list(Pairs, $,), $}]; +write({{map_pair, K, V}, _}) -> + [write(K)," => ",write(V)]; write({{record, [{Name,_} | L]}, _}) -> [Name, ${, write_fields(L), $}]; write({{bin, S}, _}) -> @@ -331,6 +340,8 @@ print_length([], _D, _RF, _Enc, _Str) -> {"[]", 2}; print_length({}, _D, _RF, _Enc, _Str) -> {"{}", 2}; +print_length(#{}=M, _D, _RF, _Enc, _Str) when map_size(M) =:= 0 -> + {"#{}", 3}; print_length(List, D, RF, Enc, Str) when is_list(List) -> case Str andalso printable_list(List, D, Enc) of true -> @@ -356,6 +367,8 @@ print_length(R, D, RF, Enc, Str) when is_atom(element(1, R)), end; print_length(Tuple, D, RF, Enc, Str) when is_tuple(Tuple) -> print_length_tuple(Tuple, D, RF, Enc, Str); +print_length(Map, D, RF, Enc, Str) when is_map(Map) -> + print_length_map(Map, D, RF, Enc, Str); print_length(<<>>, _D, _RF, _Enc, _Str) -> {"<<>>", 4}; print_length(<<_/bitstring>>, 1, _RF, _Enc, _Str) -> @@ -389,6 +402,25 @@ print_length(Term, _D, _RF, _Enc, _Str) -> S = io_lib:write(Term), {S, lists:flatlength(S)}. +print_length_map(_Map, 1, _RF, _Enc, _Str) -> + {"#{...}", 6}; +print_length_map(Map, D, RF, Enc, Str) when is_map(Map) -> + Pairs = print_length_map_pairs(maps:to_list(Map), D, RF, Enc, Str), + {{map, Pairs}, list_length(Pairs, 3)}. + +print_length_map_pairs([], _D, _RF, _Enc, _Str) -> + []; +print_length_map_pairs(_Pairs, 1, _RF, _Enc, _Str) -> + {dots, 3}; +print_length_map_pairs([{K,V}|Pairs], D, RF, Enc, Str) -> + [print_length_map_pair(K,V,D-1,RF,Enc,Str) | + print_length_map_pairs(Pairs,D-1,RF,Enc,Str)]. + +print_length_map_pair(K, V, D, RF, Enc, Str) -> + {KS, KL} = print_length(K, D, RF, Enc, Str), + {VS, VL} = print_length(V, D, RF, Enc, Str), + {{map_pair, {KS,KL}, {VS,VL}}, KL + VL}. + print_length_tuple(_Tuple, 1, _RF, _Enc, _Str) -> {"{...}", 5}; print_length_tuple(Tuple, D, RF, Enc, Str) -> diff --git a/lib/stdlib/src/maps.erl b/lib/stdlib/src/maps.erl new file mode 100644 index 0000000000..41de174e7d --- /dev/null +++ b/lib/stdlib/src/maps.erl @@ -0,0 +1,198 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2013. 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(maps). + +-export([ + fold/3, + map/2, + size/1, + without/2 + ]). + + +%%% BIFs +-export([ + get/2, + find/2, + from_list/1, + is_key/2, + keys/1, + merge/2, + new/0, + put/3, + remove/2, + to_list/1, + update/3, + values/1 + ]). + +%% Shadowed by erl_bif_types: maps:get/3 +-spec get(Key,Map) -> Value when + Key :: term(), + Map :: map(), + Value :: term(). + +get(_,_) -> erlang:nif_error(undef). + + +%% Shadowed by erl_bif_types: maps:find/3 +-spec find(Key,Map) -> {ok, Value} | error when + Key :: term(), + Map :: map(), + Value :: term(). + +find(_,_) -> erlang:nif_error(undef). + + +%% Shadowed by erl_bif_types: maps:from_list/1 +-spec from_list([{Key,Value}]) -> Map when + Key :: term(), + Value :: term(), + Map :: map(). + +from_list(_) -> erlang:nif_error(undef). + + +%% Shadowed by erl_bif_types: maps:is_key/2 +-spec is_key(Key,Map) -> boolean() when + Key :: term(), + Map :: map(). + +is_key(_,_) -> erlang:nif_error(undef). + + +%% Shadowed by erl_bif_types: maps:keys/1 +-spec keys(Map) -> Keys when + Map :: map(), + Keys :: [Key], + Key :: term(). + +keys(_) -> erlang:nif_error(undef). + + +%% Shadowed by erl_bif_types: maps:merge/2 +-spec merge(Map1,Map2) -> Map3 when + Map1 :: map(), + Map2 :: map(), + Map3 :: map(). + +merge(_,_) -> erlang:nif_error(undef). + + + +%% Shadowed by erl_bif_types: maps:new/0 +-spec new() -> Map when + Map :: map(). + +new() -> erlang:nif_error(undef). + + +%% Shadowed by erl_bif_types: maps:put/3 +-spec put(Key,Value,Map1) -> Map2 when + Key :: term(), + Value :: term(), + Map1 :: map(), + Map2 :: map(). + +put(_,_,_) -> erlang:nif_error(undef). + + +%% Shadowed by erl_bif_types: maps:put/3 +-spec remove(Key,Map1) -> Map2 when + Key :: term(), + Map1 :: map(), + Map2 :: map(). + +remove(_,_) -> erlang:nif_error(undef). + + +%% Shadowed by erl_bif_types: maps:to_list/1 +-spec to_list(Map) -> [{Key,Value}] when + Map :: map(), + Key :: term(), + Value :: term(). + +to_list(_) -> erlang:nif_error(undef). + + +%% Shadowed by erl_bif_types: maps:update/3 +-spec update(Key,Value,Map1) -> Map2 when + Key :: term(), + Value :: term(), + Map1 :: map(), + Map2 :: map(). + +update(_,_,_) -> erlang:nif_error(undef). + + +%% Shadowed by erl_bif_types: maps:values/1 +-spec values(Map) -> Keys when + Map :: map(), + Keys :: [Key], + Key :: term(). + +values(_) -> erlang:nif_error(undef). + + +%%% End of BIFs + +-spec fold(Fun,Init,Map) -> Acc when + Fun :: fun((K, V, AccIn) -> AccOut), + Init :: term(), + Acc :: term(), + AccIn :: term(), + AccOut :: term(), + Map :: map(), + K :: term(), + V :: term(). + +fold(Fun, Init, Map) when is_function(Fun,3), is_map(Map) -> + lists:foldl(fun({K,V},A) -> Fun(K,V,A) end,Init,maps:to_list(Map)). + +-spec map(Fun,Map1) -> Map2 when + Fun :: fun((K, V1) -> V2), + Map1 :: map(), + Map2 :: map(), + K :: term(), + V1 :: term(), + V2 :: term(). + +map(Fun, Map) when is_function(Fun, 2), is_map(Map) -> + maps:from_list(lists:map(fun + ({K,V}) -> + {K,Fun(K,V)} + end,maps:to_list(Map))). + + +-spec size(Map) -> non_neg_integer() when + Map :: map(). + +size(Map) when is_map(Map) -> + erlang:map_size(Map). + + +-spec without(Ks,Map1) -> Map2 when + Ks :: [K], + Map1 :: map(), + Map2 :: map(), + K :: term(). + +without(Ks, M) when is_list(Ks), is_map(M) -> + maps:from_list([{K,V}||{K,V} <- maps:to_list(M), not lists:member(K, Ks)]). diff --git a/lib/stdlib/src/ms_transform.erl b/lib/stdlib/src/ms_transform.erl index 25b04fe45e..27dfcf52e1 100644 --- a/lib/stdlib/src/ms_transform.erl +++ b/lib/stdlib/src/ms_transform.erl @@ -910,6 +910,7 @@ bool_test(is_pid,1) -> true; bool_test(is_port,1) -> true; bool_test(is_reference,1) -> true; bool_test(is_tuple,1) -> true; +bool_test(is_map,1) -> true; bool_test(is_binary,1) -> true; bool_test(is_function,1) -> true; bool_test(is_record,2) -> true; @@ -924,6 +925,7 @@ real_guard_function(node,0) -> true; real_guard_function(node,1) -> true; real_guard_function(round,1) -> true; real_guard_function(size,1) -> true; +real_guard_function(map_size,1) -> true; real_guard_function(tl,1) -> true; real_guard_function(trunc,1) -> true; real_guard_function(self,0) -> true; diff --git a/lib/stdlib/src/stdlib.app.src b/lib/stdlib/src/stdlib.app.src index a30685e830..a64b8e13c0 100644 --- a/lib/stdlib/src/stdlib.app.src +++ b/lib/stdlib/src/stdlib.app.src @@ -71,6 +71,7 @@ lib, lists, log_mf_h, + maps, math, ms_transform, orddict, diff --git a/lib/stdlib/test/erl_scan_SUITE.erl b/lib/stdlib/test/erl_scan_SUITE.erl index e628f7248d..447e159cd4 100644 --- a/lib/stdlib/test/erl_scan_SUITE.erl +++ b/lib/stdlib/test/erl_scan_SUITE.erl @@ -224,8 +224,8 @@ atoms() -> punctuations() -> L = ["<<", "<-", "<=", "<", ">>", ">=", ">", "->", "--", - "-", "++", "+", "=:=", "=/=", "=<", "==", "=", "/=", - "/", "||", "|", ":-", "::", ":"], + "-", "++", "+", "=:=", "=/=", "=<", "=>", "==", "=", "/=", + "/", "||", "|", ":=", ":-", "::", ":"], %% One token at a time: [begin W = list_to_atom(S), diff --git a/lib/syntax_tools/src/erl_syntax.erl b/lib/syntax_tools/src/erl_syntax.erl index 4f7f9e83ac..93187fa018 100644 --- a/lib/syntax_tools/src/erl_syntax.erl +++ b/lib/syntax_tools/src/erl_syntax.erl @@ -582,6 +582,9 @@ type(Node) -> {match, _, _, _} -> match_expr; {op, _, _, _, _} -> infix_expr; {op, _, _, _} -> prefix_expr; + {map,_,_} -> map; + {map_field_assoc,_,_,_} -> map_field_assoc; + {map_field_exact,_,_,_} -> map_field_exact; {record, _, _, _, _} -> record_expr; {record, _, _, _} -> record_expr; {record_field, _, _, _, _} -> record_access; @@ -1910,6 +1913,28 @@ atom_literal(Node) -> %% ===================================================================== + +map_elements(Node) -> + case unwrap(Node) of + {map, _, List} -> + List; + Node1 -> + data(Node1) + end. + +map_field_elements({_,_,K,V}) -> + [K,V]. + +map(List) -> + tree(map, List). + +map_field_assoc(List) -> + tree(map_field_assoc, List). + +map_field_exact(List) -> + tree(map_field_exact, List). + +%% ===================================================================== %% @doc Creates an abstract tuple. If `Elements' is %% `[X1, ..., Xn]', the result represents %% "<code>{<em>X1</em>, ..., <em>Xn</em>}</code>". @@ -5666,15 +5691,15 @@ fun_expr_arity(Node) -> -spec named_fun_expr(syntaxTree(), [syntaxTree()]) -> syntaxTree(). named_fun_expr(Name, Clauses) -> - tree(fun_expr, #named_fun_expr{name = Name, clauses = Clauses}). + tree(named_fun_expr, #named_fun_expr{name = Name, clauses = Clauses}). revert_named_fun_expr(Node) -> Pos = get_pos(Node), Name = named_fun_expr_name(Node), Clauses = [revert_clause(C) || C <- named_fun_expr_clauses(Node)], case type(Name) of - var -> - {named_fun, Pos, concrete(Name), Clauses}; + variable -> + {named_fun, Pos, variable_name(Name), Clauses}; _ -> Node end. @@ -5690,7 +5715,7 @@ revert_named_fun_expr(Node) -> named_fun_expr_name(Node) -> case unwrap(Node) of {named_fun, Pos, Name, _} -> - set_pos(atom(Name), Pos); + set_pos(variable(Name), Pos); Node1 -> (data(Node1))#named_fun_expr.name end. @@ -6396,6 +6421,12 @@ subtrees(T) -> try_expr_clauses(T), try_expr_handlers(T), try_expr_after(T)]; + map -> + [map_elements(T)]; + map_field_assoc -> + [map_field_elements(T)]; + map_field_exact -> + [map_field_elements(T)]; tuple -> [tuple_elements(T)] end @@ -6491,7 +6522,10 @@ make_tree(record_index_expr, [[T], [F]]) -> make_tree(rule, [[N], C]) -> rule(N, C); make_tree(size_qualifier, [[N], [A]]) -> size_qualifier(N, A); make_tree(try_expr, [B, C, H, A]) -> try_expr(B, C, H, A); -make_tree(tuple, [E]) -> tuple(E). +make_tree(tuple, [E]) -> tuple(E); +make_tree(map, [E]) -> map(E); +make_tree(map_field_assoc, [E]) -> map_field_assoc(E); +make_tree(map_field_exact, [E]) -> map_field_exact(E). %% ===================================================================== diff --git a/lib/test_server/src/ts.unix.config b/lib/test_server/src/ts.unix.config index 5a2580f464..a34857b9e5 100644 --- a/lib/test_server/src/ts.unix.config +++ b/lib/test_server/src/ts.unix.config @@ -2,3 +2,5 @@ %% Always run a (VNC) X server on host %% {xserver, "xserver.example.com:66"}. + +{unix,[{telnet,"belegost"},{username,"bofh"},{password,"root"},{keep_alive,true}]}. diff --git a/lib/typer/src/typer.erl b/lib/typer/src/typer.erl index 0ace1d5fb8..20ae4d6066 100644 --- a/lib/typer/src/typer.erl +++ b/lib/typer/src/typer.erl @@ -63,10 +63,10 @@ %% Files in 'fms' are compilable with option 'to_pp'; we keep them %% as {FileName, ModuleName} in case the ModuleName is different fms = [] :: [{file:filename(), module()}], - ex_func = map__new() :: map(), - record = map__new() :: map(), - func = map__new() :: map(), - inc_func = map__new() :: map(), + ex_func = map__new() :: map_dict(), + record = map__new() :: map_dict(), + func = map__new() :: map_dict(), + inc_func = map__new() :: map_dict(), trust_plt = dialyzer_plt:new() :: plt()}). -type analysis() :: #analysis{}. @@ -220,11 +220,11 @@ get_external(Exts, Plt) -> -type fa() :: {atom(), arity()}. -type func_info() :: {line(), atom(), arity()}. --record(info, {records = map__new() :: map(), +-record(info, {records = map__new() :: map_dict(), functions = [] :: [func_info()], - types = map__new() :: map(), + types = map__new() :: map_dict(), edoc = false :: boolean()}). --record(inc, {map = map__new() :: map(), filter = [] :: files()}). +-record(inc, {map = map__new() :: map_dict(), filter = [] :: files()}). -type inc() :: #inc{}. -spec show_or_annotate(analysis()) -> 'ok'. @@ -1094,29 +1094,29 @@ rcv_ext_types(Self, ExtTypes) -> %% specialized for the uses in this module %%-------------------------------------------------------------------- --type map() :: dict(). +-type map_dict() :: dict(). --spec map__new() -> map(). +-spec map__new() -> map_dict(). map__new() -> dict:new(). --spec map__insert({term(), term()}, map()) -> map(). +-spec map__insert({term(), term()}, map_dict()) -> map_dict(). map__insert(Object, Map) -> {Key, Value} = Object, dict:store(Key, Value, Map). --spec map__lookup(term(), map()) -> term(). +-spec map__lookup(term(), map_dict()) -> term(). map__lookup(Key, Map) -> try dict:fetch(Key, Map) catch error:_ -> none end. --spec map__from_list([{fa(), term()}]) -> map(). +-spec map__from_list([{fa(), term()}]) -> map_dict(). map__from_list(List) -> dict:from_list(List). --spec map__remove(term(), map()) -> map(). +-spec map__remove(term(), map_dict()) -> map_dict(). map__remove(Key, Dict) -> dict:erase(Key, Dict). --spec map__fold(fun((term(), term(), term()) -> map()), map(), map()) -> map(). +-spec map__fold(fun((term(), term(), term()) -> map_dict()), map_dict(), map_dict()) -> map_dict(). map__fold(Fun, Acc0, Dict) -> dict:fold(Fun, Acc0, Dict). diff --git a/system/doc/reference_manual/distributed.xml b/system/doc/reference_manual/distributed.xml index d337920a64..88f98bc106 100644 --- a/system/doc/reference_manual/distributed.xml +++ b/system/doc/reference_manual/distributed.xml @@ -199,7 +199,7 @@ dilbert@uab</pre> <cell align="left" valign="middle">Depending on <c>Arg</c>, this function can return a list not only of visible nodes, but also hidden nodes and previously known nodes, etc.</cell> </row> <row> - <cell align="left" valign="middle"><c>set_cookie(Node, Cookie)</c></cell> + <cell align="left" valign="middle"><c>erlang:set_cookie(Node, Cookie)</c></cell> <cell align="left" valign="middle">Sets the magic cookie used when connecting to <c>Node</c>. If <c>Node</c> is the current node, <c>Cookie</c> will be used when connecting to all new nodes.</cell> </row> <row> |