diff options
77 files changed, 3745 insertions, 1923 deletions
diff --git a/.travis.yml b/.travis.yml index 42151a16d2..baa55b383d 100644 --- a/.travis.yml +++ b/.travis.yml @@ -29,7 +29,7 @@ before_script: - kerl_deactivate script: - - ./otp_build all -a + - ./scripts/build-otp after_success: - $ERL_TOP/bin/dialyzer --build_plt --apps asn1 compiler crypto dialyzer edoc erts et hipe inets kernel mnesia observer public_key runtime_tools snmp ssh ssl stdlib syntax_tools wx xmerl --statistics @@ -1,60 +1,78 @@ -Erlang/OTP -========== +# [Erlang/OTP](https://www.erlang.org) -**Erlang** is a programming language used to build massively scalable soft -real-time systems with requirements on high availability. Some of its -uses are in telecom, banking, e-commerce, computer telephony and -instant messaging. Erlang's runtime system has built-in support for -concurrency, distribution and fault tolerance. +**Erlang** is a programming language and runtime system for building massively scalable soft real-time systems with requirements on high availability. -**OTP** is set of Erlang libraries and design principles providing -middle-ware to develop these systems. It includes its own distributed -database, applications to interface towards other languages, debugging -and release handling tools. +**OTP** is a set of Erlang libraries, which consists of the Erlang runtime system, a number of ready-to-use components mainly written in Erlang, and a set of design principles for Erlang programs. [Learn more about Erlang and OTP](http://erlang.org/doc/system_architecture_intro/sys_arch_intro.html). -ERTS and BEAM -------------- -**BEAM** is the name of the virtual machine where all Erlang code is executed. -Every compiled Erlang file has the suffix .beam. The virtual machine -is sometimes referred to as the emulator. +[Learn how to program in Erlang](http://learnyousomeerlang.com/content). -**ERTS** is the Erlang Runtime System where the BEAM, kernel and -standard libraries amongst others are included. +## Examples +There are several examples [on the website](http://erlang.org/faq/getting_started.html) to help you get started. The below example defines a function `world/0` that prints "Hello, world" in the Erlang shell: +```erlang +-module(hello). +-export([world/0]). -More information can be found at [erlang.org] [1]. +world() -> io:format("Hello, world\n"). +``` +Save the file as `hello.erl` and run `erl` to enter the Erlang shell to compile the module. +``` +Erlang/OTP 19 [erts-8.2] [source] [64-bit] [smp:4:4] [async-threads:10] [hipe] [kernel-poll:false] [dtrace] -Building and Installing ------------------------ +Eshell V8.2 (abort with ^G) +1> c(hello). +{ok,hello} +2> hello:world(). +Hello, world +ok +``` +Learn more about the Erlang syntax of [modules](http://erlang.org/doc/reference_manual/modules.html), [functions](http://erlang.org/doc/reference_manual/functions.html) and [expressions](http://erlang.org/doc/reference_manual/expressions.html) on [Erlang.org](https://www.erlang.org). -Information on building and installing Erlang/OTP can be found -in the [$ERL_TOP/HOWTO/INSTALL.md] [5] document. +## Installation +### Binary Distributions +Erlang/OTP is available as pre-built binary packages by most OS package managers. +``` +apt-get install erlang +``` +### Compiling from source -Contributing to Erlang/OTP --------------------------- +To compile Erlang from source, run the following commands. The complete building and installation instructions [can be found here](HOWTO/INSTALL.md). +``` +git clone https://github.com/erlang/otp.git +cd otp +./otp_build autoconf +./configure +make +make install +``` +Alternatively, you can use [Kerl](https://github.com/kerl/kerl), a script that lets you easily build Erlang with a few commands. -Here are the [instructions for submitting patches] [2]. +## Bug Reports -In short: +Please visit [bugs.erlang.org](https://bugs.erlang.org/issues/?jql=project%20%3D%20ERL) for reporting bugs. The instructions for submitting bugs reports [can be found here](https://github.com/erlang/otp/wiki/Bug-reports). -* Submit your patch by opening a new Pull Request. +### Security Disclosure -* Go to the JIRA issue tracker at [bugs.erlang.org] [7] to - see reported issues which you can contribute to. - Search for issues with the status *Help Wanted*. +We take security bugs in Erlang/OTP seriously. Please disclose the issues regarding security by sending an email to [email protected] and not by creating a public issue. +## Contributing -Bug Reports --------------------------- +We are grateful to the community for contributing bug fixes and improvements. Read below to learn how you can take part in improving Erlang/OTP. We appreciate your help! -Please look at the [instructions for submitting bugs reports] [6]. +### Contribution Guide +Read our [contribution guide](https://github.com/erlang/otp/wiki/contribution-guidelines) to learn about our development process, how to propose fixes and improvements, and how to test your changes to Erlang/OTP before submitting a pull request. -Copyright and License ---------------------- +### Help Wanted + +We have a list of [Help Wanted](https://bugs.erlang.org/issues/?jql=status%20%3D%20%22Help%20Wanted%22) bugs that we would appreciate external help from the community. This is a great place to get involved. + +## License + +Erlang/OTP is released under the [Apache License 2.0](http://www.apache.org/licenses/LICENSE-2.0). > %CopyrightBegin% > -> Copyright Ericsson AB 2010-2014. All Rights Reserved. +> Copyright Ericsson AB 2010-2017. All Rights Reserved. > > Licensed under the Apache License, Version 2.0 (the "License"); > you may not use this file except in compliance with the License. @@ -70,12 +88,5 @@ Copyright and License > > %CopyrightEnd% - - - [1]: http://www.erlang.org - [2]: http://wiki.github.com/erlang/otp/contribution-guidelines - [3]: http://www.erlang.org/static/doc/mailinglist.html - [4]: http://erlang.github.com/otp/ - [5]: HOWTO/INSTALL.md - [6]: https://github.com/erlang/otp/wiki/Bug-reports - [7]: http://bugs.erlang.org +## Awesome-Erlang +You can find more projects, tools and articles related to Erlang/OTP on the [awesome-erlang list](https://github.com/drobakowski/awesome-erlang). Add your project there. diff --git a/erts/doc/src/notes.xml b/erts/doc/src/notes.xml index 14fcdb7e0e..ae1d2b1d93 100644 --- a/erts/doc/src/notes.xml +++ b/erts/doc/src/notes.xml @@ -32,6 +32,34 @@ <p>This document describes the changes made to the ERTS application.</p> +<section><title>Erts 8.2.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fix bug in <c>binary_to_term</c> for binaries created by + <c>term_to_binary </c> with option <c>compressed</c>. The + bug can cause <c>badarg</c> exception for a valid binary + when Erlang VM is linked against a <c>zlib</c> library of + version 1.2.9 or newer. Bug exists since OTP 17.0.</p> + <p> + Own Id: OTP-14159 Aux Id: ERL-340 </p> + </item> + <item> + <p> + The driver efile_drv when opening a file now use fstat() + on the open file instead of stat() before opening, if + fstat() exists. This avoids a race when the file happens + to change between stat() and open().</p> + <p> + Own Id: OTP-14184 Aux Id: seq-13266 </p> + </item> + </list> + </section> + +</section> + <section><title>Erts 8.2.1</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/erts/emulator/drivers/unix/unix_efile.c b/erts/emulator/drivers/unix/unix_efile.c index bfe0807df8..3ff68a8859 100644 --- a/erts/emulator/drivers/unix/unix_efile.c +++ b/erts/emulator/drivers/unix/unix_efile.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1997-2016. All Rights Reserved. + * Copyright Ericsson AB 1997-2017. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -79,11 +79,10 @@ * Macros for testing file types. */ -#define ISDIR(st) (((st).st_mode & S_IFMT) == S_IFDIR) -#define ISREG(st) (((st).st_mode & S_IFMT) == S_IFREG) -#define ISDEV(st) \ - (((st).st_mode&S_IFMT) == S_IFCHR || ((st).st_mode&S_IFMT) == S_IFBLK) -#define ISLNK(st) (((st).st_mode & S_IFLNK) == S_IFLNK) +#define ISDIR(st) (S_ISDIR((st).st_mode)) +#define ISREG(st) (S_ISREG((st).st_mode)) +#define ISDEV(st) (S_ISCHR((st).st_mode) || S_ISBLK((st).st_mode)) +#define ISLNK(st) (S_ISLNK((st).st_mode)) #ifdef NO_UMASK #define FILE_MODE 0644 #define DIR_MODE 0755 @@ -366,33 +365,6 @@ efile_openfile(Efile_error* errInfo, /* Where to return error codes. */ int fd; int mode; /* Open mode. */ - if (stat(name, &statbuf) < 0) { - /* statbuf is undefined: if the caller depends on it, - i.e. invoke_read_file(), fail the call immediately */ - if (pSize && flags == EFILE_MODE_READ) - return check_error(-1, errInfo); - } else if (!ISREG(statbuf)) { - /* - * For UNIX only, here is some ugly code to allow - * /dev/null to be opened as a file. - * - * Assumption: The i-node number for /dev/null cannot be zero. - */ - static ino_t dev_null_ino = 0; - - if (dev_null_ino == 0) { - struct stat nullstatbuf; - - if (stat("/dev/null", &nullstatbuf) >= 0) { - dev_null_ino = nullstatbuf.st_ino; - } - } - if (!(dev_null_ino && statbuf.st_ino == dev_null_ino)) { - errno = EISDIR; - return check_error(-1, errInfo); - } - } - switch (flags & (EFILE_MODE_READ|EFILE_MODE_WRITE)) { case EFILE_MODE_READ: mode = O_RDONLY; @@ -411,16 +383,13 @@ efile_openfile(Efile_error* errInfo, /* Where to return error codes. */ return check_error(-1, errInfo); } - if (flags & EFILE_MODE_APPEND) { mode &= ~O_TRUNC; mode |= O_APPEND; } - if (flags & EFILE_MODE_EXCL) { mode |= O_EXCL; } - if (flags & EFILE_MODE_SYNC) { #ifdef O_SYNC mode |= O_SYNC; @@ -430,15 +399,49 @@ efile_openfile(Efile_error* errInfo, /* Where to return error codes. */ #endif } - fd = open(name, mode, FILE_MODE); +#ifdef HAVE_FSTAT + while (((fd = open(name, mode, FILE_MODE)) < 0) && (errno == EINTR)); + if (!check_error(fd, errInfo)) return 0; +#endif + + if ( +#ifdef HAVE_FSTAT + fstat(fd, &statbuf) < 0 +#else + stat(name, &statbuf) < 0 +#endif + ) { + /* statbuf is undefined: if the caller depends on it, + i.e. invoke_read_file(), fail the call immediately */ + if (pSize && flags == EFILE_MODE_READ) { + check_error(-1, errInfo); +#ifdef HAVE_FSTAT + efile_closefile(fd); +#endif + return 0; + } + } + else if (! ISREG(statbuf)) { + struct stat nullstatbuf; + /* + * For UNIX only, here is some ugly code to allow + * /dev/null to be opened as a file. + */ + if ( (stat("/dev/null", &nullstatbuf) < 0) + || (statbuf.st_ino != nullstatbuf.st_ino) + || (statbuf.st_dev != nullstatbuf.st_dev) ) { + errno = EISDIR; + return check_error(-1, errInfo); + } + } - if (!check_error(fd, errInfo)) - return 0; +#ifndef HAVE_FSTAT + while (((fd = open(name, mode, FILE_MODE)) < 0) && (errno == EINTR)); + if (!check_error(fd, errInfo)) return 0; +#endif *pfd = fd; - if (pSize) { - *pSize = statbuf.st_size; - } + if (pSize) *pSize = statbuf.st_size; return 1; } @@ -460,7 +463,7 @@ efile_may_openfile(Efile_error* errInfo, char *name) { void efile_closefile(int fd) { - close(fd); + while((close(fd) < 0) && (errno == EINTR)); } int diff --git a/erts/test/system_smoke.spec b/erts/test/system_smoke.spec index 933d1ba22d..99092c1dab 100644 --- a/erts/test/system_smoke.spec +++ b/erts/test/system_smoke.spec @@ -1,3 +1,8 @@ {suites,"../system_test",[ethread_SUITE]}. -{cases,"../system_test",otp_SUITE,[undefined_functions]}. +{cases,"../system_test",otp_SUITE, + [undefined_functions, + deprecated_not_in_obsolete, + obsolete_but_not_deprecated, + call_to_size_1, + call_to_now_0]}. {skip_cases,"../system_test",ethread_SUITE,[max_threads],"Skip"}. diff --git a/erts/vsn.mk b/erts/vsn.mk index 028b114068..a0a991f5a9 100644 --- a/erts/vsn.mk +++ b/erts/vsn.mk @@ -18,7 +18,7 @@ # %CopyrightEnd% # -VSN = 8.2.1 +VSN = 8.2.2 # Port number 4365 in 4.2 # Port number 4366 in 4.3 diff --git a/lib/asn1/doc/src/asn1_getting_started.xml b/lib/asn1/doc/src/asn1_getting_started.xml index d40b294c39..d2b73d63c3 100644 --- a/lib/asn1/doc/src/asn1_getting_started.xml +++ b/lib/asn1/doc/src/asn1_getting_started.xml @@ -187,6 +187,14 @@ erlc -o ../asnfiles -I ../asnfiles -I /usr/local/standards/asn1 Person.asn</pre> <item> <p>DER encoding rule. Only when using option <c>-ber</c>.</p> </item> + <tag><c>+maps</c></tag> + <item> + <p>Use maps instead of records to represent the <c>SEQUENCE</c> and + <c>SET</c> types. No <c>.hrl</c> files will be generated. + See the Section <seealso marker="asn1_getting_started#MAP_SEQ_SET"> + Map representation for SEQUENCE and SET</seealso> + for more information.</p> + </item> <tag><c>+asn1config</c></tag> <item> <p>This functionality works together with option @@ -766,8 +774,11 @@ Pdu ::= SEQUENCE { b REAL, c OBJECT IDENTIFIER, d NULL } </pre> - <p>This is a 4-component structure called <c>Pdu</c>. The record format - is the major format for representation of <c>SEQUENCE</c> in Erlang. + <p>This is a 4-component structure called <c>Pdu</c>. By default, + a <c>SEQUENCE</c> is represented by a record in Erlang. + It can also be represented as a map; see + <seealso marker="asn1_getting_started#MAP_SEQ_SET"> + Map representation for SEQUENCE and SET</seealso>. For each <c>SEQUENCE</c> and <c>SET</c> in an ASN.1 module an Erlang record declaration is generated. For <c>Pdu</c>, a record like the following is defined:</p> @@ -878,6 +889,48 @@ SExt ::= SEQUENCE { </section> <section> + <marker id="MAP_SEQ_SET"></marker> + <title>Map representation for SEQUENCE and SET</title> + <p>If the ASN.1 module has been compiled with option <c>maps</c>, + the types <c>SEQUENCE</c> and <c>SET</c> are represented as maps.</p> + <p>In the following example, this ASN.1 specification is used:</p> + <pre> +File DEFINITIONS AUTOMATIC TAGS ::= +BEGIN +Seq1 ::= SEQUENCE { + a INTEGER DEFAULT 42, + b BOOLEAN OPTIONAL, + c IA5String +} +END </pre> + + <p>Optional fields are to be omitted from the map if they have + no value:</p> + + <pre> +1> <input>asn1ct:compile('File', [per,maps]).</input> +ok +2> <input>{ok,E} = 'File':encode('Seq1', #{a=>0,c=>"string"}).</input> +{ok,<<128,1,0,6,115,116,114,105,110,103>>} </pre> + + <p>When decoding, optional fields will be omitted from the map:</p> + + <pre> +3> <input>'File':decode('Seq1', E).</input> +{ok,#{a => 0,c => "string"}} </pre> + + <p>Default values can be omitted from the map:</p> + <pre> +4> <input>{ok,E2} = 'File':encode('Seq1', #{c=>"string"}).</input> +{ok,<<0,6,115,116,114,105,110,103>>} +5> <input>'File':decode('Seq1', E2).</input> +{ok,#{a => 42,c => "string"}} </pre> + + <note><p>It is not allowed to use the atoms <c>asn1_VALUE</c> and + <c>asn1_DEFAULT</c> with maps.</p></note> + </section> + + <section> <marker id="CHOICE"></marker> <title>CHOICE</title> <p>The type <c>CHOICE</c> is a space saver and is similar to the @@ -1004,11 +1057,16 @@ T ::= CHOICE { <section> <title>Naming of Records in .hrl Files</title> + <p>When the option <c>maps</c> is given, no <c>.hrl</c> files + will be generated. The rest of this section describes the behavior + of the compiler when <c>maps</c> is not used.</p> + <p>When an ASN.1 specification is compiled, all defined types of type - <c>SET</c> or <c>SEQUENCE</c> result in a corresponding record in the - generated <c>.hrl</c> file. This is because the values for - <c>SET</c> and <c>SEQUENCE</c> are represented as records as - mentioned earlier.</p> + <c>SET</c> or <c>SEQUENCE</c> result in a corresponding record in the + generated <c>.hrl</c> file. This is because the values for + <c>SET</c> and <c>SEQUENCE</c> are represented as records + by default.</p> + <p>Some special cases of this functionality are presented in the next section.</p> @@ -1144,9 +1202,10 @@ SS ::= SET { <p>This example shows that a function is generated by the compiler that returns a valid Erlang representation of the value, although the value is of a complex type.</p> - <p>Furthermore, a macro is generated for each value in the <c>.hrl</c> - file. So, the defined value <c>tt</c> can also be extracted by - <c>?tt</c> in application code.</p> + <p>Furthermore, if the option <c>maps</c> is not used, + a macro is generated for each value in the <c>.hrl</c> + file. So, the defined value <c>tt</c> can also be extracted by + <c>?tt</c> in application code.</p> </section> <section> diff --git a/lib/asn1/doc/src/asn1ct.xml b/lib/asn1/doc/src/asn1ct.xml index ebe1ce44dc..859d6a50bb 100644 --- a/lib/asn1/doc/src/asn1ct.xml +++ b/lib/asn1/doc/src/asn1ct.xml @@ -170,11 +170,24 @@ File3.asn</pre> as for <c>ber</c>. </p> </item> + <tag><c>maps</c></tag> + <item> + <p>This option changes the representation of the types + <c>SEQUENCE</c> and <c>SET</c> to use maps (instead of + records). This option also suppresses the generation of + <c>.hrl</c> files.</p> + <p>For details, see Section + <seealso marker="asn1_getting_started#MAP_SEQ_SET"> + Map representation for SEQUENCE and SET</seealso> + in the User's Guide. + </p> + </item> <tag><c>compact_bit_string</c></tag> <item> <p> The <c>BIT STRING</c> type is decoded to "compact notation". <em>This option is not recommended for new code.</em> + This option cannot be combined with the option <c>maps</c>. </p> <p>For details, see Section <seealso marker="asn1_getting_started#BIT STRING"> @@ -188,6 +201,7 @@ File3.asn</pre> The <c>BIT STRING</c> type is decoded to the legacy format, that is, a list of zeroes and ones. <em>This option is not recommended for new code.</em> + This option cannot be combined with the option <c>maps</c>. </p> <p>For details, see Section <seealso marker="asn1_getting_started#BIT STRING">BIT STRING</seealso> @@ -202,7 +216,8 @@ File3.asn</pre> marker="asn1_getting_started#BIT STRING">BIT STRING</seealso> and Section <seealso marker="asn1_getting_started#OCTET STRING">OCTET STRING</seealso> in the User's Guide.</p> - <p><em>This option is not recommended for new code.</em></p> + <p><em>This option is not recommended for new code.</em> + This option cannot be combined with the option <c>maps</c>.</p> </item> <tag><c>{n2n, EnumTypeName}</c></tag> <item> diff --git a/lib/asn1/src/asn1_db.erl b/lib/asn1/src/asn1_db.erl index 869ea310aa..a3e45ca915 100644 --- a/lib/asn1/src/asn1_db.erl +++ b/lib/asn1/src/asn1_db.erl @@ -20,7 +20,7 @@ %% -module(asn1_db). --export([dbstart/1,dbnew/2,dbload/1,dbload/3,dbsave/2,dbput/2, +-export([dbstart/1,dbnew/3,dbload/1,dbload/4,dbsave/2,dbput/2, dbput/3,dbget/2]). -export([dbstop/0]). @@ -37,13 +37,13 @@ dbstart(Includes0) -> put(?MODULE, spawn_link(fun() -> init(Parent, Includes) end)), ok. -dbload(Module, Erule, Mtime) -> - req({load, Module, Erule, Mtime}). +dbload(Module, Erule, Maps, Mtime) -> + req({load, Module, {Erule,Maps}, Mtime}). dbload(Module) -> req({load, Module, any, {{0,0,0},{0,0,0}}}). -dbnew(Module, Erule) -> req({new, Module, Erule}). +dbnew(Module, Erule, Maps) -> req({new, Module, {Erule,Maps}}). dbsave(OutFile, Module) -> cast({save, OutFile, Module}). dbput(Module, K, V) -> cast({set, Module, K, V}). dbput(Module, Kvs) -> cast({set, Module, Kvs}). @@ -110,19 +110,19 @@ loop(#state{parent = Parent, monitor = MRef, table = Table, ok = ets:tab2file(Mtab, TempFile), ok = file:rename(TempFile, OutFile), loop(State); - {From, {new, Mod, Erule}} -> + {From, {new, Mod, EruleMaps}} -> [] = ets:lookup(Table, Mod), %Assertion. ModTableId = ets:new(list_to_atom(lists:concat(["asn1_",Mod])), []), ets:insert(Table, {Mod, ModTableId}), - ets:insert(ModTableId, {?MAGIC_KEY, info(Erule)}), + ets:insert(ModTableId, {?MAGIC_KEY, info(EruleMaps)}), reply(From, ok), loop(State); - {From, {load, Mod, Erule, Mtime}} -> + {From, {load, Mod, EruleMaps, Mtime}} -> case ets:member(Table, Mod) of true -> reply(From, ok); false -> - case load_table(Mod, Erule, Mtime, Includes) of + case load_table(Mod, EruleMaps, Mtime, Includes) of {ok, ModTableId} -> ets:insert(Table, {Mod, ModTableId}), reply(From, ok); @@ -151,20 +151,20 @@ lookup(Tab, K) -> [{K,V}] -> V end. -info(Erule) -> - {asn1ct:vsn(),Erule}. +info(EruleMaps) -> + {asn1ct:vsn(),EruleMaps}. -load_table(Mod, Erule, Mtime, Includes) -> +load_table(Mod, EruleMaps, Mtime, Includes) -> Base = lists:concat([Mod, ".asn1db"]), case path_find(Includes, Mtime, Base) of error -> error; - {ok,ModTab} when Erule =:= any -> + {ok,ModTab} when EruleMaps =:= any -> {ok,ModTab}; {ok,ModTab} -> Vsn = asn1ct:vsn(), case ets:lookup(ModTab, ?MAGIC_KEY) of - [{_,{Vsn,Erule}}] -> + [{_,{Vsn,EruleMaps}}] -> %% Correct version and encoding rule. {ok,ModTab}; _ -> diff --git a/lib/asn1/src/asn1_records.hrl b/lib/asn1/src/asn1_records.hrl index af10c1771c..d3d76f9566 100644 --- a/lib/asn1/src/asn1_records.hrl +++ b/lib/asn1/src/asn1_records.hrl @@ -28,6 +28,7 @@ -define('COMPLETE_ENCODE',1). -define('TLV_DECODE',2). +-define(MISSING_IN_MAP, asn1__MISSING_IN_MAP). -record(module,{pos,name,defid,tagdefault='EXPLICIT',exports={exports,[]},imports={imports,[]}, extensiondefault=empty,typeorval}). @@ -96,6 +97,17 @@ error_context %Top-level thingie (contains line numbers) }). +%% Code generation parameters and options. +-record(gen, + {erule=ber :: 'ber' | 'per', + der=false :: boolean(), + aligned=false :: boolean(), + rec_prefix="" :: string(), + macro_prefix="" :: string(), + pack=record :: 'record' | 'map', + options=[] :: [any()] + }). + %% state record used by back-end at partial decode %% active is set to 'yes' when a partial decode function is generated. %% prefix is set to 'dec-inc-' or 'dec-partial-' is for diff --git a/lib/asn1/src/asn1ct.erl b/lib/asn1/src/asn1ct.erl index 4e030861f5..d27f8897af 100644 --- a/lib/asn1/src/asn1ct.erl +++ b/lib/asn1/src/asn1ct.erl @@ -193,7 +193,7 @@ check_pass(#st{code=M,file=File,includes=Includes, erule=Erule,dbfile=DbFile,opts=Opts, inputmodules=InputModules}=St) -> start(Includes), - case asn1ct_check:storeindb(#state{erule=Erule}, M) of + case asn1ct_check:storeindb(#state{erule=Erule,options=Opts}, M) of ok -> Module = asn1_db:dbget(M#module.name, 'MODULE'), State = #state{mname=Module#module.name, @@ -216,8 +216,8 @@ check_pass(#st{code=M,file=File,includes=Includes, {error,St#st{error=Reason}} end. -save_pass(#st{code=M,erule=Erule}=St) -> - ok = asn1ct_check:storeindb(#state{erule=Erule}, M), +save_pass(#st{code=M,erule=Erule,opts=Opts}=St) -> + ok = asn1ct_check:storeindb(#state{erule=Erule,options=Opts}, M), {ok,St}. parse_listing(#st{code=Code,outfile=OutFile0}=St) -> @@ -838,33 +838,53 @@ 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), + Gen = init_gen_record(EncodingRule, Options), + + check_maps_option(Gen), + %% create decoding function names and taglists for partial decode - case (catch specialized_decode_prepare(EncodingRule,M,GenTOrV,Options)) of - {error, Reason} -> warning("Error in configuration file: ~n~p~n", - [Reason], Options, - "Error in configuration file"); - _ -> ok + try + specialized_decode_prepare(Gen, M) + catch + throw:{error, Reason} -> + warning("Error in configuration file: ~n~p~n", + [Reason], Options, + "Error in configuration file") end, - Result = - case (catch asn1ct_gen:pgen(OutFile,EncodingRule, - M#module.name,GenTOrV,Options)) of - {'EXIT',Reason2} -> - error("~p~n",[Reason2],Options), - {error,Reason2}; - _ -> - ok - end, + Res = case catch asn1ct_gen:pgen(OutFile, Gen, M#module.name, GenTOrV) of + {'EXIT',Reason2} -> + error("~p~n",[Reason2],Options), + {error,Reason2}; + _ -> + ok + end, debug_off(Options), - erase(encoding_options), cleanup_bit_string_format(), erase(tlv_format), % used in ber erase(class_default_type),% used in ber asn1ct_table:delete(check_functions), - Result. + Res. + +init_gen_record(EncodingRule, Options) -> + Erule = case EncodingRule of + uper -> per; + _ -> EncodingRule + end, + Der = proplists:get_bool(der, Options), + Aligned = EncodingRule =:= per, + RecPrefix = proplists:get_value(record_name_prefix, Options, ""), + MacroPrefix = proplists:get_value(macro_name_prefix, Options, ""), + Pack = case proplists:get_value(maps, Options, false) of + true -> map; + false -> record + end, + #gen{erule=Erule,der=Der,aligned=Aligned, + rec_prefix=RecPrefix,macro_prefix=MacroPrefix, + pack=Pack,options=Options}. + setup_legacy_erlang_types(Opts) -> F = case lists:member(legacy_erlang_types, Opts) of @@ -910,6 +930,26 @@ cleanup_bit_string_format() -> get_bit_string_format() -> get(bit_string_format). +check_maps_option(#gen{pack=map}) -> + case get_bit_string_format() of + bitstring -> + ok; + _ -> + Message1 = "The 'maps' option must not be combined with " + "'compact_bit_string' or 'legacy_bit_string'", + exit({error,{asn1,Message1}}) + end, + case use_legacy_types() of + false -> + ok; + true -> + Message2 = "The 'maps' option must not be combined with " + "'legacy_erlang_types'", + exit({error,{asn1,Message2}}) + end; +check_maps_option(#gen{}) -> + ok. + %% parse_and_save parses an asn1 spec and saves the unchecked parse %% tree in a data base file. @@ -919,22 +959,27 @@ parse_and_save(Module,S) -> SourceDir = S#state.sourcedir, Includes = [I || {i,I} <- Options], Erule = S#state.erule, + Maps = lists:member(maps, Options), case get_input_file(Module, [SourceDir|Includes]) of %% search for asn1 source {file,SuffixedASN1source} -> Mtime = filelib:last_modified(SuffixedASN1source), - case asn1_db:dbload(Module, Erule, Mtime) of + case asn1_db:dbload(Module, Erule, Maps, Mtime) of ok -> ok; error -> parse_and_save1(S, SuffixedASN1source, Options) end; - Err -> + Err when not Maps -> case asn1_db:dbload(Module) of ok -> + %% FIXME: This should be an error. warning("could not do a consistency check of the ~p file: no asn1 source file was found.~n", [lists:concat([Module,".asn1db"])],Options); error -> ok end, + {error,{asn1,input_file_error,Err}}; + Err -> + %% Always fail directly when the 'maps' option is used. {error,{asn1,input_file_error,Err}} end. @@ -997,9 +1042,8 @@ input_file_type(File) -> end end; ".asn1config" -> - case read_config_file(File,asn1_module) of + case read_config_file_info(File, asn1_module) of {ok,Asn1Module} -> -% put(asn1_config_file,File), input_file_type(Asn1Module); Error -> Error @@ -1092,16 +1136,27 @@ translate_options([H|T]) -> translate_options([]) -> []. remove_asn_flags(Options) -> - [X || X <- Options, - X /= get_rule(Options), - X /= optimize, - X /= compact_bit_string, - X /= legacy_bit_string, - X /= legacy_erlang_types, - X /= debug, - X /= asn1config, - X /= record_name_prefix]. - + [X || X <- Options, not is_asn1_flag(X)]. + +is_asn1_flag(asn1config) -> true; +is_asn1_flag(ber) -> true; +is_asn1_flag(compact_bit_string) -> true; +is_asn1_flag(debug) -> true; +is_asn1_flag(der) -> true; +is_asn1_flag(legacy_bit_string) -> true; +is_asn1_flag({macro_name_prefix,_}) -> true; +is_asn1_flag({n2n,_}) -> true; +is_asn1_flag(noobj) -> true; +is_asn1_flag(no_ok_wrapper) -> true; +is_asn1_flag(optimize) -> true; +is_asn1_flag(per) -> true; +is_asn1_flag({record_name_prefix,_}) -> true; +is_asn1_flag(undec_rec) -> true; +is_asn1_flag(uper) -> true; +is_asn1_flag(verbose) -> true; +%% 'warnings_as_errors' is intentionally passed through to the compiler. +is_asn1_flag(_) -> false. + debug_on(Options) -> case lists:member(debug,Options) of true -> @@ -1370,25 +1425,26 @@ prepare_bytes(Bytes) -> list_to_binary(Bytes). vsn() -> ?vsn. -specialized_decode_prepare(Erule,M,TsAndVs,Options) -> - case lists:member(asn1config,Options) of +specialized_decode_prepare(#gen{erule=ber,options=Options}=Gen, M) -> + case lists:member(asn1config, Options) of true -> - partial_decode_prepare(Erule,M,TsAndVs,Options); - _ -> + special_decode_prepare_1(Gen, M); + false -> ok - end. + end; +specialized_decode_prepare(_, _) -> + ok. + %% Reads the configuration file if it exists and stores information %% about partial decode and incomplete decode -partial_decode_prepare(ber,M,TsAndVs,Options) when is_tuple(TsAndVs) -> +special_decode_prepare_1(#gen{options=Options}=Gen, M) -> %% read configure file - - ModName = - case lists:keysearch(asn1config,1,Options) of - {value,{_,MName}} -> MName; - _ -> M#module.name - end, + ModName = case lists:keyfind(asn1config, 1, Options) of + {_,MName} -> MName; + false -> M#module.name + end, %% io:format("ModName: ~p~nM#module.name: ~p~n~n",[ModName,M#module.name]), - case read_config_file(ModName) of + case read_config_file(Gen, ModName) of no_config_file -> ok; CfgList -> @@ -1407,11 +1463,7 @@ partial_decode_prepare(ber,M,TsAndVs,Options) when is_tuple(TsAndVs) -> Part_inc_tlv_tags = tlv_tags(CommandList2), save_config(partial_incomplete_decode,Part_inc_tlv_tags), save_gen_state(exclusive_decode,ExclusiveDecode,Part_inc_tlv_tags) - end; -partial_decode_prepare(_,_,_,_) -> - ok. - - + end. %% create_partial_inc_decode_gen_info/2 %% @@ -1863,46 +1915,38 @@ tlv_tag1(<<0:1,PartialTag:7>>,Acc) -> tlv_tag1(<<1:1,PartialTag:7,Buffer/binary>>,Acc) -> tlv_tag1(Buffer,(Acc bsl 7) bor PartialTag). -%% reads the content from the configuration file and returns the -%% selected part choosen by InfoType. Assumes that the config file +%% Reads the content from the configuration file and returns the +%% selected part chosen by InfoType. Assumes that the config file %% content is an Erlang term. -read_config_file(ModuleName,InfoType) when is_atom(InfoType) -> - CfgList = read_config_file(ModuleName), - get_config_info(CfgList,InfoType). +read_config_file_info(ModuleName, InfoType) when is_atom(InfoType) -> + Name = ensure_ext(ModuleName, ".asn1config"), + CfgList = read_config_file0(Name, []), + get_config_info(CfgList, InfoType). +read_config_file(#gen{options=Options}, ModuleName) -> + Name = ensure_ext(ModuleName, ".asn1config"), + Includes = [I || {i,I} <- Options], + read_config_file0(Name, ["."|Includes]). -read_config_file(ModuleName) -> - case file:consult(lists:concat([ModuleName,'.asn1config'])) of +read_config_file0(Name, [D|Dirs]) -> + case file:consult(filename:join(D, Name)) of {ok,CfgList} -> CfgList; {error,enoent} -> - Options = get(encoding_options), - Includes = [I || {i,I} <- Options], - read_config_file1(ModuleName,Includes); + read_config_file0(Name, Dirs); {error,Reason} -> Error = "error reading asn1 config file: " ++ file:format_error(Reason), throw({error,Error}) - end. -read_config_file1(ModuleName,[]) -> - case filename:extension(ModuleName) of - ".asn1config" -> - no_config_file; - _ -> - read_config_file(lists:concat([ModuleName,".asn1config"])) end; -read_config_file1(ModuleName,[H|T]) -> -% File = filename:join([H,lists:concat([ModuleName,'.asn1config'])]), - File = filename:join([H,ModuleName]), - case file:consult(File) of - {ok,CfgList} -> - CfgList; - {error,enoent} -> - read_config_file1(ModuleName,T); - {error,Reason} -> - Error = "error reading asn1 config file: " ++ - file:format_error(Reason), - throw({error,Error}) +read_config_file0(_, []) -> + no_config_file. + +ensure_ext(ModuleName, Ext) -> + Name = filename:join([ModuleName]), + case filename:extension(Name) of + Ext -> Name; + _ -> Name ++ Ext end. get_config_info(CfgList,InfoType) -> @@ -2382,8 +2426,10 @@ format_error({write_error,File,Reason}) -> io_lib:format("writing output file ~s failed: ~s", [File,file:format_error(Reason)]). -is_error(S) when is_record(S, state) -> - is_error(S#state.options); +is_error(#state{options=Opts}) -> + is_error(Opts); +is_error(#gen{options=Opts}) -> + is_error(Opts); is_error(O) -> lists:member(errors, O) orelse is_verbose(O). @@ -2392,8 +2438,10 @@ is_warning(S) when is_record(S, state) -> is_warning(O) -> lists:member(warnings, O) orelse is_verbose(O). -is_verbose(S) when is_record(S, state) -> - is_verbose(S#state.options); +is_verbose(#state{options=Opts}) -> + is_verbose(Opts); +is_verbose(#gen{options=Opts}) -> + is_verbose(Opts); is_verbose(O) -> lists:member(verbose, O). diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index f2c895bfaa..321f4147f5 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -2239,12 +2239,18 @@ normalized_record(SorS,S,Value,Components,NameList) -> case is_record_normalized(S,NewName,Value,length(Components)) of true -> Value; - _ -> + false -> NoComps = length(Components), ListOfVals = normalize_seq_or_set(SorS,S,Value,Components,NameList,[]), - NoComps = length(ListOfVals), %% Assert - list_to_tuple([NewName|ListOfVals]) + NoComps = length(ListOfVals), %Assertion. + case use_maps(S) of + false -> + list_to_tuple([NewName|ListOfVals]); + true -> + create_map_value(Components, ListOfVals) + end end. + is_record_normalized(S,Name,V = #'Externalvaluereference'{},NumComps) -> case get_referenced_type(S,V) of {_M,#valuedef{type=_T1,value=V2}} -> @@ -2253,9 +2259,20 @@ is_record_normalized(S,Name,V = #'Externalvaluereference'{},NumComps) -> end; is_record_normalized(_S,Name,Value,NumComps) when is_tuple(Value) -> (tuple_size(Value) =:= (NumComps + 1)) andalso (element(1, Value) =:= Name); +is_record_normalized(_S, _Name, Value, _NumComps) when is_map(Value) -> + true; is_record_normalized(_,_,_,_) -> false. +use_maps(#state{options=Opts}) -> + lists:member(maps, Opts). + +create_map_value(Components, ListOfVals) -> + Zipped = lists:zip(Components, ListOfVals), + L = [{Name,V} || {#'ComponentType'{name=Name},V} <- Zipped, + V =/= asn1_NOVALUE], + maps:from_list(L). + normalize_seq_or_set(SorS, S, [{#seqtag{val=Cname},V}|Vs], [#'ComponentType'{name=Cname,typespec=TS}|Cs], @@ -4192,7 +4209,7 @@ iof_associated_type1(S,C) -> %% fieldname=[{typefieldreference,'Type'}], fieldname={'Type',[]}, type=Typefield_type}, - IOFComponents = + IOFComponents0 = [#'ComponentType'{name='type-id', typespec=#type{tag=C1TypeTag, def=ObjectIdentifier, @@ -4209,6 +4226,7 @@ iof_associated_type1(S,C) -> tablecinf=Comp2tablecinf}, prop=mandatory, tags=[{'CONTEXT',0}]}], + IOFComponents = textual_order(IOFComponents0), #'SEQUENCE'{tablecinf=TableCInf, components=simplify_comps(IOFComponents)}. @@ -5673,7 +5691,8 @@ storeindb(S0, #module{name=ModName,typeorval=TVlist0}=M) -> storeindb_1(S, #module{name=ModName}=M, TVlist0, TVlist) -> NewM = M#module{typeorval=findtypes_and_values(TVlist0)}, - asn1_db:dbnew(ModName, S#state.erule), + Maps = lists:member(maps, S#state.options), + asn1_db:dbnew(ModName, S#state.erule, Maps), asn1_db:dbput(ModName, 'MODULE', NewM), asn1_db:dbput(ModName, TVlist), include_default_class(S, NewM#module.name), diff --git a/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl b/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl index 325bea5879..16af09bca9 100644 --- a/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl +++ b/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl @@ -32,7 +32,7 @@ -include("asn1_records.hrl"). --import(asn1ct_gen, [emit/1,demit/1,get_record_name_prefix/0]). +-import(asn1ct_gen, [emit/1,demit/1,get_record_name_prefix/1]). -define(ASN1CT_GEN_BER,asn1ct_gen_ber_bin_v2). @@ -57,7 +57,7 @@ %%=============================================================================== %%=============================================================================== -gen_encode_sequence(Erules,Typename,D) when is_record(D,type) -> +gen_encode_sequence(Gen, Typename, #type{}=D) -> asn1ct_name:start(), asn1ct_name:new(term), asn1ct_name:new(bytes), @@ -67,8 +67,12 @@ gen_encode_sequence(Erules,Typename,D) when is_record(D,type) -> ValName = case Typename of ['EXTERNAL'] -> + Tr = case Gen of + #gen{pack=record} -> transform_to_EXTERNAL1990; + #gen{pack=map} -> transform_to_EXTERNAL1990_maps + end, emit([indent(4),"NewVal = ", - {call,ext,transform_to_EXTERNAL1990,["Val"]}, + {call,ext,Tr,["Val"]}, com,nl]), "NewVal"; _ -> @@ -90,18 +94,9 @@ gen_encode_sequence(Erules,Typename,D) when is_record(D,type) -> {Rl,El} -> Rl ++ El; _ -> CompList end, - -%% don't match recordname for now, because of compatibility reasons -%% emit(["{'",asn1ct_gen:list2rname(Typename),"'"]), - emit(["{_"]), - case length(CompList1) of - 0 -> - true; - CompListLen -> - emit([","]), - mkcindexlist([Tc || Tc <- lists:seq(1,CompListLen)]) - end, - emit(["} = ",ValName,",",nl]), + + enc_match_input(Gen, ValName, CompList1), + EncObj = case TableConsInfo of #simpletableattributes{usedclassfield=Used, @@ -125,7 +120,7 @@ gen_encode_sequence(Erules,Typename,D) when is_record(D,type) -> emit([ObjectEncode," = ",nl, " ",{asis,ObjSetMod},":'getenc_",ObjSetName, "'("]), - ValueMatch = value_match(ValueIndex, + ValueMatch = value_match(Gen, ValueIndex, lists:concat(["Cindex",N])), emit([indent(35),ValueMatch,"),",nl]), {AttrN,ObjectEncode}; @@ -144,7 +139,7 @@ gen_encode_sequence(Erules,Typename,D) when is_record(D,type) -> end end, - gen_enc_sequence_call(Erules,Typename,CompList1,1,Ext,EncObj), + gen_enc_sequence_call(Gen, Typename, CompList1, 1, Ext, EncObj), emit([nl," BytesSoFar = "]), case SeqOrSet of @@ -168,7 +163,36 @@ gen_encode_sequence(Erules,Typename,D) when is_record(D,type) -> call(encode_tags, ["TagIn","BytesSoFar","LenSoFar"]), emit([".",nl]). -gen_decode_sequence(Erules,Typename,D) when is_record(D,type) -> +enc_match_input(#gen{pack=record}, ValName, CompList) -> + Len = length(CompList), + Vars = [lists:concat(["Cindex",N]) || N <- lists:seq(1, Len)], + RecordName = "_", + emit(["{",lists:join(",", [RecordName|Vars]),"} = ",ValName,com,nl]); +enc_match_input(#gen{pack=map}, ValName, CompList) -> + Len = length(CompList), + Vars = [lists:concat(["Cindex",N]) || N <- lists:seq(1, Len)], + Zipped = lists:zip(CompList, Vars), + M = [[{asis,Name},":=",Var] || + {#'ComponentType'{prop=mandatory,name=Name},Var} <- Zipped], + case M of + [] -> + ok; + [_|_] -> + emit(["#{",lists:join(",", M),"} = ",ValName,com,nl]) + end, + Os0 = [{Name,Var} || + {#'ComponentType'{prop=Prop,name=Name},Var} <- Zipped, + Prop =/= mandatory], + F = fun({Name,Var}) -> + [Var," = case ",ValName," of\n" + " #{",{asis,Name},":=",Var,"_0} -> ", + Var,"_0;\n" + " _ -> ",atom_to_list(?MISSING_IN_MAP),"\n" + "end"] + end, + emit(lists:join(",\n", [F(E) || E <- Os0]++[[]])). + +gen_decode_sequence(Gen, Typename, #type{}=D) -> asn1ct_name:start(), asn1ct_name:new(tag), #'SEQUENCE'{tablecinf=TableConsInfo,components=CList0} = D#type.def, @@ -225,15 +249,20 @@ gen_decode_sequence(Erules,Typename,D) when is_record(D,type) -> _ -> {false,false} end, - RecordName = lists:concat([get_record_name_prefix(), - asn1ct_gen:list2rname(Typename)]), - case gen_dec_sequence_call(Erules,Typename,CompList2,Ext,DecObjInf) of - no_terms -> % an empty sequence - emit([nl,nl]), - demit(["Result = "]), %dbg - %% return value as record + RecordName0 = lists:concat([get_record_name_prefix(Gen), + asn1ct_gen:list2rname(Typename)]), + RecordName = list_to_atom(RecordName0), + case gen_dec_sequence_call(Gen, Typename, CompList2, Ext, DecObjInf) of + no_terms -> % an empty sequence asn1ct_name:new(rb), - emit([" {'",RecordName,"'}.",nl,nl]); + case Gen of + #gen{pack=record} -> + emit([nl,nl, + " {'",RecordName,"'}.",nl,nl]); + #gen{pack=map} -> + emit([nl,nl, + " #{}.",nl,nl]) + end; {LeadingAttrTerm,PostponedDecArgs} -> emit([nl]), case {LeadingAttrTerm,PostponedDecArgs} of @@ -243,7 +272,7 @@ gen_decode_sequence(Erules,Typename,D) when is_record(D,type) -> ok; {[{ObjSetRef,LeadingAttr,Term}],PostponedDecArgs} -> DecObj = asn1ct_gen:un_hyphen_var(lists:concat(['DecObj',LeadingAttr,Term])), - ValueMatch = value_match(ValueIndex,Term), + ValueMatch = value_match(Gen, ValueIndex,Term), {ObjSetMod,ObjSetName} = ObjSetRef, emit([DecObj," =",nl, " ",{asis,ObjSetMod},":'getdec_",ObjSetName,"'(", @@ -263,22 +292,64 @@ gen_decode_sequence(Erules,Typename,D) when is_record(D,type) -> "end,",nl]) end, asn1ct_name:new(rb), - case Typename of - ['EXTERNAL'] -> - emit([" OldFormat={'",RecordName, - "', "]), - mkvlist(asn1ct_name:all(term)), - emit(["},",nl]), - emit([" ", - {call,ext,transform_to_EXTERNAL1994, - ["OldFormat"]},".",nl]); - _ -> - emit([" {'",RecordName,"', "]), - mkvlist(asn1ct_name:all(term)), - emit(["}.",nl,nl]) - end + gen_dec_pack(Gen, RecordName, Typename, CompList), + emit([".",nl]) end. +gen_dec_pack(Gen, RecordName, Typename, CompList) -> + case Typename of + ['EXTERNAL'] -> + dec_external(Gen, RecordName); + _ -> + asn1ct_name:new(res), + gen_dec_do_pack(Gen, RecordName, CompList), + emit([com,nl, + {curr,res}]) + end. + +dec_external(#gen{pack=record}, RecordName) -> + All = [{var,Term} || Term <- asn1ct_name:all(term)], + Record = [{asis,RecordName}|All], + emit(["OldFormat={",lists:join(",", Record),"},",nl, + {call,ext,transform_to_EXTERNAL1994, + ["OldFormat"]}]); +dec_external(#gen{pack=map}, _RecordName) -> + Vars = asn1ct_name:all(term), + Names = ['direct-reference','indirect-reference', + 'data-value-descriptor',encoding], + Zipped = lists:zip(Names, Vars), + MapInit = lists:join(",", [["'",N,"'=>",{var,V}] || {N,V} <- Zipped]), + emit(["OldFormat = #{",MapInit,"}",com,nl, + "ASN11994Format =",nl, + {call,ext,transform_to_EXTERNAL1994_maps, + ["OldFormat"]}]). + +gen_dec_do_pack(#gen{pack=record}, RecordName, _CompList) -> + All = asn1ct_name:all(term), + L = [{asis,RecordName}|[{var,Var} || Var <- All]], + emit([{curr,res}," = {",lists:join(",", L),"}"]); +gen_dec_do_pack(#gen{pack=map}, _, CompList) -> + Zipped = lists:zip(CompList, asn1ct_name:all(term)), + PF = fun({#'ComponentType'{prop='OPTIONAL'},_}) -> false; + ({_,_}) -> true + end, + {Mandatory,Optional} = lists:partition(PF, Zipped), + L = [[{asis,Name},"=>",{var,Var}] || + {#'ComponentType'{name=Name},Var} <- Mandatory], + emit([{curr,res}," = #{",lists:join(",", L),"}"]), + gen_dec_map_optional(Optional). + +gen_dec_map_optional([{#'ComponentType'{name=Name},Var}|T]) -> + asn1ct_name:new(res), + emit([com,nl, + {curr,res}," = case ",{var,Var}," of",nl, + " asn1_NOVALUE -> ",{prev,res},";",nl, + " _ -> ",{prev,res},"#{",{asis,Name},"=>",{var,Var},"}",nl, + "end"]), + gen_dec_map_optional(T); +gen_dec_map_optional([]) -> + ok. + gen_dec_postponed_decs(_,[]) -> emit(nl); gen_dec_postponed_decs(DecObj,[{_Cname,{FirstPFN,PFNList},Term, @@ -327,7 +398,7 @@ emit_opt_or_mand_check(Value,TmpTerm) -> gen_encode_set(Erules,Typename,D) when is_record(D,type) -> gen_encode_sequence(Erules,Typename,D). -gen_decode_set(Erules,Typename,D) when is_record(D,type) -> +gen_decode_set(Gen, Typename, #type{}=D) -> asn1ct_name:start(), %% asn1ct_name:new(term), asn1ct_name:new(tag), @@ -393,7 +464,7 @@ gen_decode_set(Erules,Typename,D) when is_record(D,type) -> _ -> emit(["SetFun = fun(FunTlv) ->", nl]), emit(["case FunTlv of ",nl]), - NextNum = gen_dec_set_cases(Erules,Typename,CompList,1), + NextNum = gen_dec_set_cases(Gen, Typename, CompList, 1), emit([indent(6), {curr,else}," -> ",nl, indent(9),"{",NextNum,", ",{curr,else},"}",nl]), emit([indent(3),"end",nl]), @@ -405,14 +476,17 @@ gen_decode_set(Erules,Typename,D) when is_record(D,type) -> asn1ct_name:new(tlv) end, - RecordName = lists:concat([get_record_name_prefix(), - asn1ct_gen:list2rname(Typename)]), - case gen_dec_sequence_call(Erules,Typename,CompList,Ext,DecObjInf) of - no_terms -> % an empty sequence - emit([nl,nl]), - demit(["Result = "]), %dbg - %% return value as record - emit([" {'",RecordName,"'}.",nl]); + RecordName0 = lists:concat([get_record_name_prefix(Gen), + asn1ct_gen:list2rname(Typename)]), + RecordName = list_to_atom(RecordName0), + case gen_dec_sequence_call(Gen, Typename, CompList, Ext, DecObjInf) of + no_terms -> % an empty SET + case Gen of + #gen{pack=record} -> + emit([nl,nl," {'",RecordName,"'}.",nl,nl]); + #gen{pack=map} -> + emit([nl,nl," #{}.",nl,nl]) + end; {LeadingAttrTerm,PostponedDecArgs} -> emit([nl]), case {LeadingAttrTerm,PostponedDecArgs} of @@ -422,7 +496,7 @@ gen_decode_set(Erules,Typename,D) when is_record(D,type) -> ok; {[{ObjSetRef,LeadingAttr,Term}],PostponedDecArgs} -> DecObj = asn1ct_gen:un_hyphen_var(lists:concat(['DecObj',LeadingAttr,Term])), - ValueMatch = value_match(ValueIndex,Term), + ValueMatch = value_match(Gen, ValueIndex, Term), {ObjSetMod,ObjSetName} = ObjSetRef, emit([DecObj," =",nl, " ",{asis,ObjSetMod},":'getdec_",ObjSetName,"'(", @@ -441,9 +515,8 @@ gen_decode_set(Erules,Typename,D) when is_record(D,type) -> "}}}) % extra fields not allowed",nl, "end,",nl]) end, - emit([" {'",RecordName,"', "]), - mkvlist(asn1ct_name:all(term)), - emit(["}.",nl]) + gen_dec_pack(Gen, RecordName, Typename, CompList), + emit([".",nl]) end. @@ -504,10 +577,8 @@ gen_decode_sof(Erules,TypeName,_InnerTypeName,D) when is_record(D,type) -> emit([" || ",{curr,v}," <- ",{curr,tlv},"].",nl,nl,nl]). -gen_encode_sof_components(Erules,Typename,SeqOrSetOf,Cont) - when is_record(Cont,type)-> - - {Objfun,Objfun_novar,EncObj} = +gen_encode_sof_components(Gen, Typename, SeqOrSetOf, #type{}=Cont) -> + {Objfun,Objfun_novar,EncObj} = case Cont#type.tablecinf of [{objfun,_}|_R] -> {", ObjFun",", _",{no_attr,"ObjFun"}}; @@ -517,20 +588,19 @@ gen_encode_sof_components(Erules,Typename,SeqOrSetOf,Cont) emit(["'enc_",asn1ct_gen:list2name(Typename), "_components'([]",Objfun_novar,", AccBytes, AccLen) -> ",nl]), - case catch lists:member(der,get(encoding_options)) of - true when SeqOrSetOf=='SET OF'-> + case {Gen,SeqOrSetOf} of + {#gen{der=true},'SET OF'} -> asn1ct_func:need({ber,dynamicsort_SETOF,1}), emit([indent(3), "{dynamicsort_SETOF(AccBytes),AccLen};",nl,nl]); - _ -> + {_,_} -> emit([indent(3),"{lists:reverse(AccBytes),AccLen};",nl,nl]) end, emit(["'enc_",asn1ct_gen:list2name(Typename), "_components'([H|T]",Objfun,",AccBytes, AccLen) ->",nl]), TypeNameSuffix = asn1ct_gen:constructed_suffix(SeqOrSetOf,Cont#type.def), - gen_enc_line(Erules,Typename,TypeNameSuffix,Cont,"H",3, -% mandatory,"{EncBytes,EncLen} = ",EncObj), - mandatory,EncObj), + gen_enc_line(Gen, Typename, TypeNameSuffix, Cont, "H", 3, + mandatory, EncObj), emit([",",nl]), emit([indent(3),"'enc_",asn1ct_gen:list2name(Typename), "_components'(T",Objfun,","]), @@ -1028,35 +1098,44 @@ gen_enc_line(Erules,TopType,Cname,Type,Element,Indent,OptOrMand,Assign,EncObj) emit([nl,indent(7),"end"]) end. -gen_optormand_case(mandatory, _Erules, _TopType, _Cname, _Type, _Element) -> +gen_optormand_case(mandatory, _Gen, _TopType, _Cname, _Type, _Element) -> ok; -gen_optormand_case('OPTIONAL', Erules, _TopType, _Cname, _Type, Element) -> +gen_optormand_case('OPTIONAL', Gen, _TopType, _Cname, _Type, Element) -> emit([" case ",Element," of",nl]), - emit([indent(9),"asn1_NOVALUE -> {", - empty_lb(Erules),",0};",nl]), + Missing = case Gen of + #gen{pack=record} -> asn1_NOVALUE; + #gen{pack=map} -> ?MISSING_IN_MAP + end, + emit([indent(9),Missing," -> {", + empty_lb(Gen),",0};",nl]), emit([indent(9),"_ ->",nl,indent(12)]); -gen_optormand_case({'DEFAULT',DefaultValue}, Erules, _TopType, +gen_optormand_case({'DEFAULT',DefaultValue}, Gen, _TopType, _Cname, Type, Element) -> CurrMod = get(currmod), - case catch lists:member(der,get(encoding_options)) of - true -> - asn1ct_gen_check:emit(Type, DefaultValue, Element); - _ -> - emit([" case ",Element," of",nl]), - emit([indent(9),"asn1_DEFAULT -> {", - empty_lb(Erules), - ",0};",nl]), - case DefaultValue of - #'Externalvaluereference'{module=CurrMod, - value=V} -> - emit([indent(9),"?",{asis,V}," -> {", - empty_lb(Erules),",0};",nl]); - _ -> - emit([indent(9),{asis, - DefaultValue}," -> {", - empty_lb(Erules),",0};",nl]) - end, - emit([indent(9),"_ ->",nl,indent(12)]) + case Gen of + #gen{erule=ber,der=true} -> + asn1ct_gen_check:emit(Gen, Type, DefaultValue, Element); + #gen{erule=ber,der=false,pack=Pack} -> + Ind9 = indent(9), + DefMarker = case Pack of + record -> asn1_DEFAULT; + map -> ?MISSING_IN_MAP + end, + emit([" case ",Element," of",nl, + Ind9,{asis,DefMarker}," ->",nl, + Ind9,indent(3),"{",empty_lb(Gen),",0};",nl, + Ind9,"_ when ",Element," =:= "]), + Dv = case DefaultValue of + #'Externalvaluereference'{module=CurrMod, + value=V} -> + ["?",{asis,V}]; + _ -> + [{asis,DefaultValue}] + end, + emit(Dv++[" ->",nl, + Ind9,indent(3),"{",empty_lb(Gen),",0};",nl, + Ind9,"_ ->",nl, + indent(12)]) end. %% Use for SEQUENCE OF and CHOICE. @@ -1207,7 +1286,7 @@ gen_dec_call({typefield,_},_,_,Cname,Type,BytesVar,Tag,_,_,_DecObjInf,OptOrMandC (Type#type.def)#'ObjectClassFieldType'.fieldname, [{Cname,RefedFieldName,asn1ct_gen:mk_var(asn1ct_name:curr(term)), asn1ct_gen:mk_var(asn1ct_name:curr(tmpterm)),Tag,OptOrMandComp}]; -gen_dec_call(InnerType, _Erules, TopType, Cname, Type, BytesVar, +gen_dec_call(InnerType, Gen, TopType, Cname, Type, BytesVar, Tag, _PrimOptOrMand, _OptOrMand, DecObjInf,_) -> WhatKind = asn1ct_gen:type(InnerType), gen_dec_call1(WhatKind, InnerType, TopType, Cname, @@ -1215,7 +1294,7 @@ gen_dec_call(InnerType, _Erules, TopType, Cname, Type, BytesVar, case DecObjInf of {Cname,{_,OSet,_UniqueFName,ValIndex}} -> Term = asn1ct_gen:mk_var(asn1ct_name:curr(term)), - ValueMatch = value_match(ValIndex,Term), + ValueMatch = value_match(Gen, ValIndex, Term), {ObjSetMod,ObjSetName} = OSet, emit([",",nl,"ObjFun = ",{asis,ObjSetMod},":'getdec_",ObjSetName, "'(",ValueMatch,")"]); @@ -1340,19 +1419,6 @@ gen_dec_call1(WhatKind, _, TopType, Cname, Type, BytesVar, Tag) -> indent(N) -> lists:duplicate(N,32). % 32 = space -mkcindexlist([H,T1|T], Sep) -> % Sep is a string e.g ", " or "+ " - emit(["Cindex",H,Sep]), - mkcindexlist([T1|T], Sep); -mkcindexlist([H|T], Sep) -> - emit(["Cindex",H]), - mkcindexlist(T, Sep); -mkcindexlist([], _) -> - true. - -mkcindexlist(L) -> - mkcindexlist(L,", "). - - mkvlist([H,T1|T], Sep) -> % Sep is a string e.g ", " or "+ " emit([{var,H},Sep]), mkvlist([T1|T], Sep); @@ -1429,19 +1495,25 @@ mkfuncname(TopType,Cname,WhatKind,Prefix,Suffix) -> {F, "?MODULE", F} end. -empty_lb(ber) -> +empty_lb(#gen{erule=ber}) -> "<<>>". -value_match(Index,Value) when is_atom(Value) -> - value_match(Index,atom_to_list(Value)); -value_match([],Value) -> +value_match(#gen{pack=record}, VIs, Value) -> + value_match_rec(VIs, Value); +value_match(#gen{pack=map}, VIs, Value) -> + value_match_map(VIs, Value). + +value_match_rec([], Value) -> + Value; +value_match_rec([{VI,_}|VIs], Value0) -> + Value = value_match_rec(VIs, Value0), + lists:concat(["element(",VI,", ",Value,")"]). + +value_match_map([], Value) -> Value; -value_match([{VI,_}|VIs],Value) -> - value_match1(Value,VIs,lists:concat(["element(",VI,","]),1). -value_match1(Value,[],Acc,Depth) -> - Acc ++ Value ++ lists:concat(lists:duplicate(Depth,")")); -value_match1(Value,[{VI,_}|VIs],Acc,Depth) -> - value_match1(Value,VIs,Acc++lists:concat(["element(",VI,","]),Depth+1). +value_match_map([{_,Name}|VIs], Value0) -> + Value = value_match_map(VIs, Value0), + lists:concat(["maps:get(",Name,", ",Value,")"]). call(F, Args) -> asn1ct_func:call(ber, F, Args). diff --git a/lib/asn1/src/asn1ct_constructed_per.erl b/lib/asn1/src/asn1ct_constructed_per.erl index a34b25182c..b7579c8065 100644 --- a/lib/asn1/src/asn1ct_constructed_per.erl +++ b/lib/asn1/src/asn1ct_constructed_per.erl @@ -32,17 +32,27 @@ -include("asn1_records.hrl"). %-compile(export_all). --import(asn1ct_gen, [emit/1,demit/1,get_record_name_prefix/0]). --import(asn1ct_func, [call/3]). +-import(asn1ct_gen, [emit/1,demit/1,get_record_name_prefix/1]). + +-type type_name() :: any(). + %% ENCODE GENERATOR FOR SEQUENCE TYPE ** ********** -gen_encode_set(Erules,TypeName,D) -> - gen_encode_constructed(Erules,TypeName,D). +-spec gen_encode_set(Gen, TypeName, #type{}) -> 'ok' when + Gen :: #gen{}, + TypeName :: type_name(). + +gen_encode_set(Gen, TypeName, D) -> + gen_encode_constructed(Gen, TypeName, D). + +-spec gen_encode_sequence(Gen, TypeName, #type{}) -> 'ok' when + Gen :: #gen{}, + TypeName :: type_name(). -gen_encode_sequence(Erules,TypeName,D) -> - gen_encode_constructed(Erules,TypeName,D). +gen_encode_sequence(Gen, TypeName, D) -> + gen_encode_constructed(Gen, TypeName, D). gen_encode_constructed(Erule, Typename, #type{}=D) -> asn1ct_name:start(), @@ -50,88 +60,23 @@ gen_encode_constructed(Erule, Typename, #type{}=D) -> asn1ct_imm:enc_cg(Imm, is_aligned(Erule)), emit([".",nl]). -gen_encode_constructed_imm(Erule, Typename, #type{}=D) -> - {ExtAddGroup,TmpCompList,TableConsInfo} = - case D#type.def of - #'SEQUENCE'{tablecinf=TCI,components=CL,extaddgroup=ExtAddGroup0} -> - {ExtAddGroup0,CL,TCI}; - #'SET'{tablecinf=TCI,components=CL} -> - {undefined,CL,TCI} - end, - - CompList = case ExtAddGroup of - undefined -> - TmpCompList; - _ when is_integer(ExtAddGroup) -> - %% This is a fake SEQUENCE representing an ExtensionAdditionGroup - %% Reset the textual order so we get the right - %% index of the components - [Comp#'ComponentType'{textual_order=undefined}|| - Comp<-TmpCompList] - end, - ExternalImm = - case Typename of - ['EXTERNAL'] -> - Next = asn1ct_gen:mk_var(asn1ct_name:next(val)), - Curr = asn1ct_gen:mk_var(asn1ct_name:curr(val)), - asn1ct_name:new(val), - [{call,ext,transform_to_EXTERNAL1990,[{var,Curr}],{var,Next}}]; - _ -> - [] - end, - Aligned = is_aligned(Erule), - Value0 = make_var(val), +gen_encode_constructed_imm(Gen, Typename, #type{}=D) -> + {CompList,TableConsInfo} = enc_complist(D), + ExternalImm = external_imm(Gen, Typename), Optionals = optionals(to_textual_order(CompList)), - ImmOptionals = [asn1ct_imm:per_enc_optional(Value0, Opt, Aligned) || - Opt <- Optionals], + ImmOptionals = enc_optionals(Gen, Optionals), Ext = extensible_enc(CompList), + Aligned = is_aligned(Gen), ExtImm = case Ext of {ext,ExtPos,NumExt} when NumExt > 0 -> - gen_encode_extaddgroup(CompList), + gen_encode_extaddgroup(Gen, CompList), Value = make_var(val), - asn1ct_imm:per_enc_extensions(Value, ExtPos, - NumExt, Aligned); + enc_extensions(Gen, Value, ExtPos, NumExt, Aligned); _ -> [] end, - {EncObj,ObjSetImm} = - case TableConsInfo of - #simpletableattributes{usedclassfield=Used, - uniqueclassfield=Unique} when Used /= Unique -> - {false,[]}; - %% ObjectSet, name of the object set in constraints - %% - %%{ObjectSet,AttrN,N,UniqueFieldName} -> %% N is index of attribute that determines constraint - #simpletableattributes{objectsetname=ObjectSet, - c_name=AttrN, - c_index=N, - usedclassfield=UniqueFieldName, - uniqueclassfield=UniqueFieldName, - valueindex=ValueIndex0 - } -> %% N is index of attribute that determines constraint - {Module,ObjSetName} = ObjectSet, - #typedef{typespec=#'ObjectSet'{gen=Gen}} = - asn1_db:dbget(Module, ObjSetName), - case Gen of - true -> - ValueIndex = ValueIndex0 ++ [{N+1,top}], - Val = make_var(val), - {ObjSetImm0,Dst} = enc_dig_out_value(ValueIndex, Val), - {{AttrN,Dst},ObjSetImm0}; - false -> - {false,[]} - end; - _ -> - case D#type.tablecinf of - [{objfun,_}|_] -> - %% when the simpletableattributes was at an outer - %% level and the objfun has been passed through the - %% function call - {{"got objfun through args",{var,"ObjFun"}},[]}; - _ -> - {false,[]} - end - end, + MatchImm = enc_map_match(Gen, CompList), + {EncObj,ObjSetImm} = enc_table(Gen, TableConsInfo, D), ImmSetExt = case Ext of {ext,_Pos,NumExt2} when NumExt2 > 0 -> @@ -141,38 +86,195 @@ gen_encode_constructed_imm(Erule, Typename, #type{}=D) -> _ -> [] end, - ImmBody = gen_enc_components_call(Erule, Typename, CompList, EncObj, Ext), - ExternalImm ++ ExtImm ++ ObjSetImm ++ + ImmBody = gen_enc_components_call(Gen, Typename, CompList, EncObj, Ext), + ExternalImm ++ MatchImm ++ ExtImm ++ ObjSetImm ++ asn1ct_imm:enc_append([ImmSetExt] ++ ImmOptionals ++ ImmBody). -gen_encode_extaddgroup(CompList) -> +external_imm(Gen, ['EXTERNAL']) -> + Next = asn1ct_gen:mk_var(asn1ct_name:next(val)), + Curr = asn1ct_gen:mk_var(asn1ct_name:curr(val)), + asn1ct_name:new(val), + F = case Gen of + #gen{pack=record} -> transform_to_EXTERNAL1990; + #gen{pack=map} -> transform_to_EXTERNAL1990_maps + end, + [{call,ext,F,[{var,Curr}],{var,Next}}]; +external_imm(_, _) -> + []. + +enc_extensions(#gen{pack=record}, Value, ExtPos, NumExt, Aligned) -> + asn1ct_imm:per_enc_extensions(Value, ExtPos, NumExt, Aligned); +enc_extensions(#gen{pack=map}, Value, ExtPos, NumExt, Aligned) -> + Vars = [{var,lists:concat(["Input@",Pos])} || + Pos <- lists:seq(ExtPos, ExtPos+NumExt-1)], + Undefined = atom_to_list(?MISSING_IN_MAP), + asn1ct_imm:per_enc_extensions_map(Value, Vars, Undefined, Aligned). + +enc_complist(#type{def=Def}) -> + case Def of + #'SEQUENCE'{tablecinf=TCI,components=CL0,extaddgroup=ExtAddGroup} -> + case ExtAddGroup of + undefined -> + {CL0,TCI}; + _ when is_integer(ExtAddGroup) -> + %% This is a fake SEQUENCE representing an + %% ExtensionAdditionGroup. Renumber the textual + %% order so we get the right index of the + %% components. + CL = add_textual_order(CL0), + {CL,TCI} + end; + #'SET'{tablecinf=TCI,components=CL} -> + {CL,TCI} + end. + +enc_table(Gen, #simpletableattributes{objectsetname=ObjectSet, + c_name=AttrN, + c_index=N, + usedclassfield=UniqueFieldName, + uniqueclassfield=UniqueFieldName, + valueindex=ValueIndex0}, _) -> + {Module,ObjSetName} = ObjectSet, + #typedef{typespec=#'ObjectSet'{gen=MustGen}} = + asn1_db:dbget(Module, ObjSetName), + case MustGen of + true -> + ValueIndex = ValueIndex0 ++ [{N+1,'ASN1_top'}], + Val = make_var(val), + {ObjSetImm,Dst} = enc_dig_out_value(Gen, ValueIndex, Val), + {{AttrN,Dst},ObjSetImm}; + false -> + {false,[]} + end; +enc_table(_Gen, #simpletableattributes{}, _) -> + {false,[]}; +enc_table(_Gen, _, #type{tablecinf=TCInf}) -> + case TCInf of + [{objfun,_}|_] -> + %% The simpletableattributes was at an outer + %% level and the objfun has been passed through the + %% function call. + {{"got objfun through args",{var,"ObjFun"}},[]}; + _ -> + {false,[]} + end. + +enc_optionals(Gen, Optionals) -> + Var = make_var(val), + enc_optionals_1(Gen, Optionals, Var). + +enc_optionals_1(#gen{pack=record}=Gen, [{Pos,DefVals}|T], Var) -> + {Imm0,Element} = asn1ct_imm:enc_element(Pos+1, Var), + Imm = asn1ct_imm:per_enc_optional(Element, DefVals), + [Imm0++Imm|enc_optionals_1(Gen, T, Var)]; +enc_optionals_1(#gen{pack=map}=Gen, [{Pos,DefVals0}|T], V) -> + Var = {var,lists:concat(["Input@",Pos])}, + DefVals = translate_missing_value(Gen, DefVals0), + Imm = asn1ct_imm:per_enc_optional(Var, DefVals), + [Imm|enc_optionals_1(Gen, T, V)]; +enc_optionals_1(_, [], _) -> + []. + +enc_map_match(#gen{pack=record}, _Cs) -> + []; +enc_map_match(#gen{pack=map}, Cs0) -> + Var0 = "Input", + Cs = enc_flatten_components(Cs0), + M = [[quote_atom(Name),":=",lists:concat([Var0,"@",Order])] || + #'ComponentType'{prop=mandatory,name=Name, + textual_order=Order} <- Cs], + Mand = case M of + [] -> + []; + [_|_] -> + Patt = {expr,lists:flatten(["#{",lists:join(",", M),"}"])}, + [{assign,Patt,{var,asn1ct_name:curr(val)}}] + end, + + Os0 = [{Name,Order} || + #'ComponentType'{prop=Prop,name=Name, + textual_order=Order} <- Cs, + Prop =/= mandatory], + {var,Val} = make_var(val), + F = fun({Name,Order}) -> + Var = lists:concat([Var0,"@",Order]), + P0 = ["case ",Val," of\n" + " #{",quote_atom(Name),":=",Var,"_0} -> ", + Var,"_0;\n" + " _ -> ",atom_to_list(?MISSING_IN_MAP),"\n" + "end"], + P = lists:flatten(P0), + {assign,{var,Var},P} + end, + Os = [F(O) || O <- Os0], + Mand ++ Os. + +enc_flatten_components({Root1,Ext0,Root2}=CL) -> + {_,Gs} = extgroup_pos_and_length(CL), + Ext = wrap_extensionAdditionGroups(Ext0, Gs), + Root1 ++ Root2 ++ [mark_optional(C) || C <- Ext]; +enc_flatten_components({Root,Ext}) -> + enc_flatten_components({Root,Ext,[]}); +enc_flatten_components(Cs) -> + Cs. + +gen_encode_extaddgroup(#gen{pack=record}, CompList) -> case extgroup_pos_and_length(CompList) of {extgrouppos,[]} -> ok; {extgrouppos,ExtGroupPosLenList} -> - _ = [do_gen_encode_extaddgroup(G) || G <- ExtGroupPosLenList], + _ = [gen_encode_eag_record(G) || + G <- ExtGroupPosLenList], ok - end. + end; +gen_encode_extaddgroup(#gen{pack=map}, Cs0) -> + Cs = enc_flatten_components(Cs0), + gen_encode_eag_map(Cs). + +gen_encode_eag_map([#'ComponentType'{name=Group,typespec=Type}|Cs]) -> + case Type of + #type{def=#'SEQUENCE'{extaddgroup=G,components=GCs0}} + when is_integer(G) -> + Ns = [N || #'ComponentType'{name=N,prop=mandatory} <- GCs0], + test_for_mandatory(Ns, Group), + gen_encode_eag_map(Cs); + _ -> + gen_encode_eag_map(Cs) + end; +gen_encode_eag_map([]) -> + ok. + +test_for_mandatory([Mand|_], Group) -> + emit([{next,val}," = case ",{curr,val}," of",nl, + "#{",quote_atom(Mand),":=_} -> ", + {curr,val},"#{",{asis,Group},"=>",{curr,val},"};",nl, + "#{} -> ",{curr,val},nl, + "end,",nl]), + asn1ct_name:new(val); +test_for_mandatory([], _) -> + ok. -do_gen_encode_extaddgroup({ActualGroupPos,GroupVirtualPos,GroupLen}) -> +gen_encode_eag_record({ActualPos,VirtualPos,Len}) -> Val = asn1ct_gen:mk_var(asn1ct_name:curr(val)), - Elements = make_elements(GroupVirtualPos+1, - Val, - lists:seq(1, GroupLen)), - Expr = any_non_value(GroupVirtualPos+1, Val, GroupLen, ""), + Elements = get_input_vars(Val, VirtualPos, Len), + Expr = any_non_value(Val, VirtualPos, Len), emit([{next,val}," = case ",Expr," of",nl, - "false -> setelement(",{asis,ActualGroupPos+1},", ", + "false -> setelement(",{asis,ActualPos+1},", ", {curr,val},", asn1_NOVALUE);",nl, - "true -> setelement(",{asis,ActualGroupPos+1},", ", + "true -> setelement(",{asis,ActualPos+1},", ", {curr,val},", {extaddgroup,", Elements,"})",nl, "end,",nl]), asn1ct_name:new(val). -any_non_value(_, _, 0, _) -> +any_non_value(Val, Pos, N) -> + L = any_non_value_1(Val, Pos, N), + lists:join(" orelse ", L). + +any_non_value_1(_, _, 0) -> []; -any_non_value(Pos, Val, N, Sep) -> - Sep ++ [make_element(Pos, Val)," =/= asn1_NOVALUE"] ++ - any_non_value(Pos+1, Val, N-1, [" orelse",nl]). +any_non_value_1(Val, Pos, N) -> + Var = get_input_var(Val, Pos), + [Var ++ " =/= asn1_NOVALUE"|any_non_value_1(Val, Pos+1, N-1)]. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% generate decode function for SEQUENCE and SET @@ -306,55 +408,105 @@ gen_dec_constructed_imm(Erule, Typename, #type{}=D) -> {DecObjInf,_,_} = ObjSetInfo, EmitComp = gen_dec_components_call(Erule, Typename, CompList, DecObjInf, Ext, length(Optionals)), - EmitRest = fun({AccTerm,AccBytes}) -> - gen_dec_constructed_imm_2(Erule, Typename, - CompList, - ObjSetInfo, - AccTerm, AccBytes) - end, - [EmitExt,EmitOpt|EmitComp++[{safe,EmitRest}]]. + EmitObjSets = gen_dec_objsets_fun(Erule, ObjSetInfo), + EmitPack = fun(_) -> + gen_dec_pack(Erule, Typename, CompList) + end, + RestGroup = {group,[{safe,EmitObjSets},{safe,EmitPack}]}, + [EmitExt,EmitOpt|EmitComp++[RestGroup]]. + +gen_dec_objsets_fun(Gen, ObjSetInfo) -> + fun({AccTerm,AccBytes}) -> + {_,_UniqueFName,ValueIndex} = ObjSetInfo, + case {AccTerm,AccBytes} of + {[],[]} -> + ok; + {_,[]} -> + ok; + {[{ObjSet,LeadingAttr,Term}],ListOfOpenTypes} -> + ValueMatch = value_match(Gen, ValueIndex, Term), + _ = [begin + gen_dec_open_type(Gen, ValueMatch, ObjSet, + LeadingAttr, T), + emit([com,nl]) + end || T <- ListOfOpenTypes], + ok + end + end. -gen_dec_constructed_imm_2(Erule, Typename, CompList, - ObjSetInfo, AccTerm, AccBytes) -> - {_,_UniqueFName,ValueIndex} = ObjSetInfo, - case {AccTerm,AccBytes} of - {[],[]} -> - ok; - {_,[]} -> - ok; - {[{ObjSet,LeadingAttr,Term}],ListOfOpenTypes} -> - ValueMatch = value_match(ValueIndex, Term), - _ = [begin - gen_dec_open_type(Erule, ValueMatch, ObjSet, - LeadingAttr, T), - emit([com,nl]) - end || T <- ListOfOpenTypes], - ok - end, - %% we don't return named lists any more Cnames = mkcnamelist(CompList), - demit({"Result = "}), %dbg - %% return value as record - RecordName = record_name(Typename), +gen_dec_pack(Gen, Typename, CompList) -> case Typename of ['EXTERNAL'] -> - emit({" OldFormat={'",RecordName, - "'"}), - mkvlist(asn1ct_name:all(term)), - emit({"},",nl}), - emit([" ASN11994Format =",nl, - " ", - {call,ext,transform_to_EXTERNAL1994, - ["OldFormat"]},com,nl]), - emit(" {ASN11994Format,"); + dec_external(Gen, Typename); _ -> - emit(["{{'",RecordName,"'"]), - %% CompList is used here because we don't want - %% ExtensionAdditionGroups to be wrapped in SEQUENCES when - %% we are ordering the fields according to textual order - mkvlist(textual_order(to_encoding_order(CompList),asn1ct_name:all(term))), - emit("},") - end, - emit({{curr,bytes},"}"}). + asn1ct_name:new(res), + gen_dec_do_pack(Gen, Typename, CompList), + emit([com,nl, + "{",{curr,res},",",{curr,bytes},"}"]) + end. + +dec_external(#gen{pack=record}=Gen, Typename) -> + RecordName = list_to_atom(record_name(Gen, Typename)), + All = [{var,Term} || Term <- asn1ct_name:all(term)], + Record = [{asis,RecordName}|All], + emit(["OldFormat={",lists:join(",", Record),"},",nl, + "ASN11994Format =",nl, + {call,ext,transform_to_EXTERNAL1994, + ["OldFormat"]},com,nl, + "{ASN11994Format,",{curr,bytes},"}"]); +dec_external(#gen{pack=map}, _Typename) -> + Vars = asn1ct_name:all(term), + Names = ['direct-reference','indirect-reference', + 'data-value-descriptor',encoding], + Zipped = lists:zip(Names, Vars), + MapInit = lists:join(",", [["'",N,"'=>",{var,V}] || {N,V} <- Zipped]), + emit(["OldFormat = #{",MapInit,"}",com,nl, + "ASN11994Format =",nl, + {call,ext,transform_to_EXTERNAL1994_maps, + ["OldFormat"]},com,nl, + "{ASN11994Format,",{curr,bytes},"}"]). + +gen_dec_do_pack(#gen{pack=record}=Gen, TypeName, CompList) -> + Zipped0 = zip_components(CompList, asn1ct_name:all(term)), + Zipped = textual_order(Zipped0), + RecordName = ["'",record_name(Gen, TypeName),"'"], + L = [RecordName|[{var,Var} || {_,Var} <- Zipped]], + emit([{curr,res}," = {",lists:join(",", L),"}"]); +gen_dec_do_pack(#gen{pack=map}, _, CompList0) -> + CompList = enc_flatten_components(CompList0), + Zipped0 = zip_components(CompList, asn1ct_name:all(term)), + Zipped = textual_order(Zipped0), + PF = fun({#'ComponentType'{prop='OPTIONAL'},_}) -> false; + ({_,_}) -> true + end, + {Mandatory,Optional} = lists:partition(PF, Zipped), + L = [[{asis,Name},"=>",{var,Var}] || + {#'ComponentType'{name=Name},Var} <- Mandatory], + emit([{curr,res}," = #{",lists:join(",", L),"}"]), + gen_dec_map_optional(Optional), + gen_dec_merge_maps(asn1ct_name:all(map)). + +gen_dec_map_optional([{#'ComponentType'{name=Name},Var}|T]) -> + asn1ct_name:new(res), + emit([com,nl, + {curr,res}," = case ",{var,Var}," of",nl, + " asn1_NOVALUE -> ",{prev,res},";",nl, + " _ -> ",{prev,res},"#{",{asis,Name},"=>",{var,Var},"}",nl, + "end"]), + gen_dec_map_optional(T); +gen_dec_map_optional([]) -> + ok. + +gen_dec_merge_maps([M|Ms]) -> + asn1ct_name:new(res), + emit([com,nl, + {curr,res}," = maps:merge(",{prev,res},", ",{var,M},")"]), + gen_dec_merge_maps(Ms); +gen_dec_merge_maps([]) -> + ok. + +quote_atom(A) when is_atom(A) -> + io_lib:format("~p", [A]). %% record_name([TypeName]) -> RecordNameString %% Construct a record name for the constructed type, ignoring any @@ -362,10 +514,10 @@ gen_dec_constructed_imm_2(Erule, Typename, CompList, %% group. Such fake sequences never appear as a top type, and their %% name always start with "ExtAddGroup". -record_name(Typename0) -> +record_name(Gen, Typename0) -> [TopType|Typename1] = lists:reverse(Typename0), Typename = filter_ext_add_groups(Typename1, [TopType]), - lists:concat([get_record_name_prefix(), + lists:concat([get_record_name_prefix(Gen), asn1ct_gen:list2rname(Typename)]). filter_ext_add_groups([H|T], Acc) when is_atom(H) -> @@ -379,17 +531,26 @@ filter_ext_add_groups([H|T], Acc) -> filter_ext_add_groups(T, [H|Acc]); filter_ext_add_groups([], Acc) -> Acc. -textual_order([#'ComponentType'{textual_order=undefined}|_],TermList) -> - TermList; -textual_order(CompList,TermList) when is_list(CompList) -> - OrderList = [Ix||#'ComponentType'{textual_order=Ix} <- CompList], - [Term||{_,Term}<- - lists:sort(lists:zip(OrderList, - lists:sublist(TermList,length(OrderList))))]; - %% sublist is just because Termlist can sometimes be longer than - %% OrderList, which it really shouldn't -textual_order({Root,Ext},TermList) -> - textual_order(Root ++ Ext,TermList). +zip_components({Root,Ext}, Vars) -> + zip_components({Root,Ext,[]}, Vars); +zip_components({R1,Ext0,R2}, Vars) -> + Ext = [mark_optional(C) || C <- Ext0], + zip_components(R1++R2++Ext, Vars); +zip_components(Cs, Vars) when is_list(Cs) -> + zip_components_1(Cs, Vars). + +zip_components_1([#'ComponentType'{}=C|Cs], [V|Vs]) -> + [{C,V}|zip_components_1(Cs, Vs)]; +zip_components_1([_|Cs], Vs) -> + zip_components_1(Cs, Vs); +zip_components_1([], []) -> + []. + +textual_order([{#'ComponentType'{textual_order=undefined},_}|_]=L) -> + L; +textual_order(L0) -> + L = [{Ix,P} || {#'ComponentType'{textual_order=Ix},_}=P <- L0], + [C || {_,C} <- lists:sort(L)]. to_textual_order({Root,Ext}) -> {to_textual_order(Root),Ext}; @@ -458,7 +619,7 @@ dec_objset_default(N, _, _, true) -> end]). dec_objset_1(Erule, N, {Id,Obj}, RestFields, Typename) -> - emit([{asis,N},"(Bytes, ",{asis,Id},") ->",nl]), + emit([{asis,N},"(Bytes, Id) when Id =:= ",{asis,Id}," ->",nl]), dec_objset_2(Erule, Obj, RestFields, Typename). dec_objset_2(Erule, Obj, RestFields0, Typename) -> @@ -595,8 +756,7 @@ do_gen_decode_sof(Erules, Typename, SeqOrSetOf, D) -> emit([",",nl, {asis,F},"(",Num,", ",Buf,ObjFun,", [])"]). -is_aligned(per) -> true; -is_aligned(uper) -> false. +is_aligned(#gen{erule=per,aligned=Aligned}) -> Aligned. gen_decode_length(Constraint, Erule) -> emit(["%% Length with constraint ",{asis,Constraint},nl]), @@ -640,22 +800,7 @@ gen_decode_sof_components(Erule, Name, Typename, SeqOrSetOf, Cont) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% General and special help functions (not exported) - -mkvlist([H|T]) -> - emit(","), - mkvlist2([H|T]); -mkvlist([]) -> - true. -mkvlist2([H,T1|T]) -> - emit({{var,H},","}), - mkvlist2([T1|T]); -mkvlist2([H|T]) -> - emit({{var,H}}), - mkvlist2(T); -mkvlist2([]) -> - true. - +%% General and special help functions (not exported) extensible_dec(CompList) when is_list(CompList) -> noext; @@ -728,28 +873,26 @@ gen_dec_optionals(Optionals) -> {imm,Imm0,E}. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Produce a list with positions (in the Value record) where -%% there are optional components, start with 2 because first element -%% is the record name - -optionals({L1,Ext,L2}) -> - Opt1 = optionals(L1,[],2), - ExtComps = length([C||C = #'ComponentType'{}<-Ext]), - Opt2 = optionals(L2,[],2+length(L1)+ExtComps), - Opt1 ++ Opt2; -optionals({L,_Ext}) -> optionals(L,[],2); -optionals(L) -> optionals(L,[],2). -optionals([#'ComponentType'{prop='OPTIONAL'}|Rest], Acc, Pos) -> - optionals(Rest, [Pos|Acc], Pos+1); -optionals([#'ComponentType'{typespec=T,prop={'DEFAULT',Val}}|Rest], - Acc, Pos) -> +optionals({Root1,Ext,Root2}) -> + Opt1 = optionals(Root1, 1), + ExtComps = length([C || C = #'ComponentType'{} <- Ext]), + Opt2 = optionals(Root2, 1 + length(Root1) + ExtComps), + Opt1 ++ Opt2; +optionals({L,_Ext}) -> + optionals(L, 1); +optionals(L) -> + optionals(L, 1). + +optionals([#'ComponentType'{prop='OPTIONAL'}|Rest], Pos) -> + [{Pos,[asn1_NOVALUE]}|optionals(Rest, Pos+1)]; +optionals([#'ComponentType'{typespec=T,prop={'DEFAULT',Val}}|Cs], Pos) -> Vals = def_values(T, Val), - optionals(Rest, [{Pos,Vals}|Acc], Pos+1); -optionals([#'ComponentType'{}|Rest], Acc, Pos) -> - optionals(Rest, Acc, Pos+1); -optionals([], Acc, _) -> - lists:reverse(Acc). + [{Pos,Vals}|optionals(Cs, Pos+1)]; +optionals([#'ComponentType'{}|Rest], Pos) -> + optionals(Rest, Pos+1); +optionals([], _) -> + []. %%%%%%%%%%%%%%%%%%%%%% %% create_optionality_table(Cs=[#'ComponentType'{textual_order=undefined}|_]) -> @@ -779,13 +922,6 @@ get_optionality_pos(TextPos,OptTable) -> no_num end. -to_encoding_order(Cs) when is_list(Cs) -> - Cs; -to_encoding_order(Cs = {_Root,_Ext}) -> - Cs; -to_encoding_order({R1,Ext,R2}) -> - {R1++R2,Ext}. - add_textual_order(Cs) when is_list(Cs) -> {NewCs,_} = add_textual_order1(Cs,1), NewCs; @@ -810,69 +946,77 @@ add_textual_order1(Cs,NumIn) -> end, NumIn,Cs). -gen_enc_components_call(Erule,TopType,{Root,ExtList}, DynamicEnc,Ext) -> - gen_enc_components_call(Erule,TopType,{Root,ExtList,[]}, DynamicEnc,Ext); -gen_enc_components_call(Erule,TopType,CL={Root,ExtList,Root2}, DynamicEnc,Ext) -> - %% The type has extensionmarker - {Imm0,Rpos} = gen_enc_components_call1(Erule,TopType,Root++Root2,1, DynamicEnc,noext,[]), +gen_enc_components_call(Erule, TopType, {Root,ExtList}, DynamicEnc, Ext) -> + gen_enc_components_call(Erule, TopType, {Root,ExtList,[]}, DynamicEnc, Ext); +gen_enc_components_call(Erule, TopType, {R1,ExtList0,R2}=CL, DynamicEnc, Ext) -> + Root = R1 ++ R2, + Imm0 = gen_enc_components_call1(Erule, TopType, Root, DynamicEnc, noext), ExtImm = case Ext of {ext,_,ExtNum} when ExtNum > 0 -> [{var,"Extensions"}]; _ -> [] end, - %handle extensions {extgrouppos,ExtGroupPosLen} = extgroup_pos_and_length(CL), - NewExtList = wrap_extensionAdditionGroups(ExtList,ExtGroupPosLen), - {Imm1,_} = gen_enc_components_call1(Erule,TopType,NewExtList,Rpos,DynamicEnc,Ext,[]), + ExtList1 = wrap_extensionAdditionGroups(ExtList0, ExtGroupPosLen), + ExtList = [mark_optional(C) || C <- ExtList1], + Imm1 = gen_enc_components_call1(Erule, TopType, ExtList, DynamicEnc, Ext), Imm0 ++ [ExtImm|Imm1]; -gen_enc_components_call(Erule,TopType, CompList, DynamicEnc, Ext) -> - %% The type has no extensionmarker - {Imm,_} = gen_enc_components_call1(Erule,TopType,CompList,1,DynamicEnc,Ext,[]), - Imm. - -gen_enc_components_call1(Erule,TopType, - [C=#'ComponentType'{name=Cname,typespec=Type,prop=Prop}|Rest], - Tpos, - DynamicEnc, Ext, Acc) -> - - TermNo = - case C#'ComponentType'.textual_order of - undefined -> - Tpos; - CanonicalNum -> - CanonicalNum - end, - Val = make_var(val), - {Imm0,Element} = asn1ct_imm:enc_element(TermNo+1, Val), - Imm1 = gen_enc_line_imm(Erule, TopType, Cname, Type, Element, DynamicEnc, Ext), - Category = case {Prop,Ext} of - {'OPTIONAL',_} -> - optional; - {{'DEFAULT',DefVal},_} -> - {default,DefVal}; - {_,{ext,ExtPos,_}} when Tpos >= ExtPos -> - optional; - {_,_} -> - mandatory - end, - Imm2 = case Category of +gen_enc_components_call(Erule, TopType, CompList, DynamicEnc, Ext) -> + %% No extension marker. + gen_enc_components_call1(Erule, TopType, CompList, DynamicEnc, Ext). + +mark_optional(#'ComponentType'{prop=Prop0}=C) -> + Prop = case Prop0 of + mandatory -> 'OPTIONAL'; + 'OPTIONAL'=Keep -> Keep; + {'DEFAULT',_}=Keep -> Keep + end, + C#'ComponentType'{prop=Prop}; +mark_optional(Other) -> + Other. + +gen_enc_components_call1(Gen, TopType, [C|Rest], DynamicEnc, Ext) -> + #'ComponentType'{name=Cname,typespec=Type, + prop=Prop,textual_order=Num} = C, + {Imm0,Element} = enc_fetch_field(Gen, Num, Prop), + Imm1 = gen_enc_line_imm(Gen, TopType, Cname, Type, + Element, DynamicEnc, Ext), + Imm2 = case Prop of mandatory -> Imm1; - optional -> - asn1ct_imm:enc_absent(Element, [asn1_NOVALUE], Imm1); - {default,Def} -> + 'OPTIONAL' -> + enc_absent(Gen, Element, [asn1_NOVALUE], Imm1); + {'DEFAULT',Def} -> DefValues = def_values(Type, Def), - asn1ct_imm:enc_absent(Element, DefValues, Imm1) + enc_absent(Gen, Element, DefValues, Imm1) end, Imm = case Imm2 of [] -> []; _ -> Imm0 ++ Imm2 end, - gen_enc_components_call1(Erule, TopType, Rest, Tpos+1, DynamicEnc, Ext, [Imm|Acc]); -gen_enc_components_call1(_Erule,_TopType,[],Pos,_,_, Acc) -> - ImmList = lists:reverse(Acc), - {ImmList,Pos}. + [Imm|gen_enc_components_call1(Gen, TopType, Rest, DynamicEnc, Ext)]; +gen_enc_components_call1(_Gen, _TopType, [], _, _) -> + []. + +enc_absent(Gen, Var, Absent0, Imm) -> + Absent = translate_missing_value(Gen, Absent0), + asn1ct_imm:enc_absent(Var, Absent, Imm). + +translate_missing_value(#gen{pack=record}, Optionals) -> + Optionals; +translate_missing_value(#gen{pack=map}, Optionals) -> + case Optionals of + [asn1_NOVALUE|T] -> [?MISSING_IN_MAP|T]; + [asn1_DEFAULT|T] -> [?MISSING_IN_MAP|T]; + {call,_,_,_} -> Optionals + end. + +enc_fetch_field(#gen{pack=record}, Num, _Prop) -> + Val = make_var(val), + asn1ct_imm:enc_element(Num+1, Val); +enc_fetch_field(#gen{pack=map}, Num, _) -> + {[],{var,lists:concat(["Input@",Num])}}. def_values(#type{def=#'Externaltypereference'{module=Mod,type=Type}}, Def) -> #typedef{typespec=T} = asn1_db:dbget(Mod, Type), @@ -1115,27 +1259,31 @@ gen_dec_components_call(Erule, TopType, {Root,ExtList}, DecInfObj, Ext, NumberOfOptionals) -> gen_dec_components_call(Erule,TopType,{Root,ExtList,[]}, DecInfObj,Ext,NumberOfOptionals); -gen_dec_components_call(Erule,TopType,CL={Root1,ExtList,Root2}, - DecInfObj,Ext,NumberOfOptionals) -> +gen_dec_components_call(Gen, TopType, {Root1,ExtList,Root2}=CL, + DecInfObj, Ext, NumberOfOptionals) -> %% The type has extensionmarker OptTable = create_optionality_table(Root1++Root2), Init = {ignore,fun(_) -> {[],[]} end}, {EmitRoot,Tpos} = - gen_dec_comp_calls(Root1++Root2, Erule, TopType, OptTable, + gen_dec_comp_calls(Root1++Root2, Gen, TopType, OptTable, DecInfObj, noext, NumberOfOptionals, 1, []), - EmitGetExt = gen_dec_get_extension(Erule), + EmitGetExt = gen_dec_get_extension(Gen), {extgrouppos,ExtGroupPosLen} = extgroup_pos_and_length(CL), NewExtList = wrap_extensionAdditionGroups(ExtList, ExtGroupPosLen), - {EmitExts,_} = gen_dec_comp_calls(NewExtList, Erule, TopType, OptTable, + {EmitExts,_} = gen_dec_comp_calls(NewExtList, Gen, TopType, OptTable, DecInfObj, Ext, NumberOfOptionals, Tpos, []), NumExtsToSkip = ext_length(ExtList), Finish = fun(St) -> emit([{next,bytes},"= "]), - call(Erule, skipextensions, - [{curr,bytes},NumExtsToSkip+1,"Extensions"]), + Mod = case Gen of + #gen{erule=per,aligned=false} -> uper; + #gen{erule=per,aligned=true} -> per + end, + asn1ct_func:call(Mod, skipextensions, + [{curr,bytes},NumExtsToSkip+1,"Extensions"]), asn1ct_name:new(bytes), St end, @@ -1178,7 +1326,7 @@ gen_dec_comp_calls([C|Cs], Erule, TopType, OptTable, DecInfObj, gen_dec_comp_calls([], _, _, _, _, _, _, Tpos, Acc) -> {lists:append(lists:reverse(Acc)),Tpos}. -gen_dec_comp_call(Comp, Erule, TopType, Tpos, OptTable, DecInfObj, +gen_dec_comp_call(Comp, Gen, TopType, Tpos, OptTable, DecInfObj, Ext, NumberOfOptionals) -> #'ComponentType'{typespec=Type,prop=Prop,textual_order=TextPos} = Comp, Pos = case Ext of @@ -1219,15 +1367,9 @@ gen_dec_comp_call(Comp, Erule, TopType, Tpos, OptTable, DecInfObj, _ -> case Type of #type{def=#'SEQUENCE'{ - extaddgroup=Number1, - components=ExtGroupCompList1}} when is_integer(Number1)-> - fun(St) -> - emit(["{{_,"]), - emit_extaddgroupTerms(term,ExtGroupCompList1), - emit(["}"]), - emit([",",{next,bytes},"} = "]), - St - end; + extaddgroup=GroupNum, + components=CompList}} when is_integer(GroupNum)-> + dec_match_extadd_fun(Gen, CompList); _ -> fun(St) -> asn1ct_name:new(term), @@ -1237,9 +1379,9 @@ gen_dec_comp_call(Comp, Erule, TopType, Tpos, OptTable, DecInfObj, end end end, - {Pre,Post} = comp_call_pre_post(Ext, Prop, Pos, Type, TextPos, + {Pre,Post} = comp_call_pre_post(Gen, Ext, Prop, Pos, Type, TextPos, OptTable, NumberOfOptionals, Ext), - Lines = gen_dec_seq_line_imm(Erule, TopType, Comp, Tpos, DecInfObj, Ext), + Lines = gen_dec_seq_line_imm(Gen, TopType, Comp, Tpos, DecInfObj, Ext), AdvBuffer = {ignore,fun(St) -> asn1ct_name:new(bytes), St @@ -1247,9 +1389,24 @@ gen_dec_comp_call(Comp, Erule, TopType, Tpos, OptTable, DecInfObj, [{group,[{safe,Comment},{safe,Preamble}] ++ Pre ++ Lines ++ Post ++ [{safe,AdvBuffer}]}]. -comp_call_pre_post(noext, mandatory, _, _, _, _, _, _) -> +dec_match_extadd_fun(#gen{pack=record}, CompList) -> + fun(St) -> + emit(["{{_,"]), + emit_extaddgroupTerms(term, CompList), + emit(["}"]), + emit([",",{next,bytes},"} = "]), + St + end; +dec_match_extadd_fun(#gen{pack=map}, _CompList) -> + fun(St) -> + asn1ct_name:new(map), + emit(["{",{curr,map},",",{next,bytes},"} = "]), + St + end. + +comp_call_pre_post(_Gen, noext, mandatory, _, _, _, _, _, _) -> {[],[]}; -comp_call_pre_post(noext, Prop, _, Type, TextPos, +comp_call_pre_post(_Gen, noext, Prop, _, Type, TextPos, OptTable, NumOptionals, Ext) -> %% OPTIONAL or DEFAULT OptPos = get_optionality_pos(TextPos, OptTable), @@ -1273,32 +1430,53 @@ comp_call_pre_post(noext, Prop, _, Type, TextPos, "end"]), St end]}; -comp_call_pre_post({ext,_,_}, Prop, Pos, Type, _, _, _, Ext) -> +comp_call_pre_post(Gen, {ext,_,_}, Prop, Pos, Type, _, _, _, Ext) -> %% Extension {[fun(St) -> emit(["case Extensions of",nl, " <<_:",Pos-1,",1:1,_/bitstring>> ->",nl]), St end], - [fun(St) -> - emit([";",nl, - "_ ->",nl, - "{"]), - case Type of - #type{def=#'SEQUENCE'{ - extaddgroup=Number2, - components=ExtGroupCompList2}} - when is_integer(Number2)-> - emit("{extAddGroup,"), - gen_dec_extaddGroup_no_val(Ext, Type, ExtGroupCompList2), - emit("}"); - _ -> - gen_dec_component_no_val(Ext, Type, Prop) - end, - emit([",",{curr,bytes},"}",nl, - "end"]), - St - end]}. + [extadd_group_fun(Gen, Prop, Type, Ext)]}. + +extadd_group_fun(#gen{pack=record}, Prop, Type, Ext) -> + fun(St) -> + emit([";",nl, + "_ ->",nl, + "{"]), + case Type of + #type{def=#'SEQUENCE'{ + extaddgroup=Number2, + components=ExtGroupCompList2}} + when is_integer(Number2)-> + emit("{extAddGroup,"), + gen_dec_extaddGroup_no_val(Ext, Type, ExtGroupCompList2), + emit("}"); + _ -> + gen_dec_component_no_val(Ext, Type, Prop) + end, + emit([",",{curr,bytes},"}",nl, + "end"]), + St + end; +extadd_group_fun(#gen{pack=map}, Prop, Type, Ext) -> + fun(St) -> + emit([";",nl, + "_ ->",nl, + "{"]), + case Type of + #type{def=#'SEQUENCE'{ + extaddgroup=Number2, + components=Comp}} + when is_integer(Number2)-> + dec_map_extaddgroup_no_val(Ext, Type, Comp); + _ -> + gen_dec_component_no_val(Ext, Type, Prop) + end, + emit([",",{curr,bytes},"}",nl, + "end"]), + St + end. is_mandatory_predef_tab_c(noext, mandatory, {"got objfun through args","ObjFun"}) -> @@ -1325,7 +1503,20 @@ gen_dec_component_no_val(_, _, 'OPTIONAL') -> emit({"asn1_NOVALUE"}); gen_dec_component_no_val({ext,_,_}, _, mandatory) -> emit({"asn1_NOVALUE"}). - + +dec_map_extaddgroup_no_val(Ext, Type, Comp) -> + L0 = [dec_map_extaddgroup_no_val_1(N, P, Ext, Type) || + #'ComponentType'{name=N,prop=P} <- Comp], + L = [E || E <- L0, E =/= []], + emit(["#{",lists:join(",", L),"}"]). + +dec_map_extaddgroup_no_val_1(Name, {'DEFAULT',DefVal0}, _Ext, Type) -> + DefVal = asn1ct_gen:conform_value(Type, DefVal0), + [Name,"=>",{asis,DefVal}]; +dec_map_extaddgroup_no_val_1(_Name, 'OPTIONAL', _, _) -> + []; +dec_map_extaddgroup_no_val_1(_Name, mandatory, {ext,_,_}, _) -> + []. gen_dec_choice_line(Erule, TopType, Comp, Pre) -> Imm0 = gen_dec_line_imm(Erule, TopType, Comp, false, Pre), @@ -1461,29 +1652,29 @@ gen_dec_line_special(Erule, {typefield,_}, _TopType, Comp, Prop}],PrevSt} end end; -gen_dec_line_special(Erule, Atype, TopType, Comp, DecInfObj) -> - case gen_dec_line_other(Erule, Atype, TopType, Comp) of +gen_dec_line_special(Gen, Atype, TopType, Comp, DecInfObj) -> + case gen_dec_line_other(Gen, Atype, TopType, Comp) of Fun when is_function(Fun, 1) -> fun({BytesVar,PrevSt}) -> Fun(BytesVar), - gen_dec_line_dec_inf(Comp, DecInfObj), + gen_dec_line_dec_inf(Gen,Comp, DecInfObj), {[],PrevSt} end; Imm0 -> {imm,Imm0, fun(Imm, {BytesVar,PrevSt}) -> asn1ct_imm:dec_code_gen(Imm, BytesVar), - gen_dec_line_dec_inf(Comp, DecInfObj), + gen_dec_line_dec_inf(Gen, Comp, DecInfObj), {[],PrevSt} end} end. -gen_dec_line_dec_inf(Comp, DecInfObj) -> +gen_dec_line_dec_inf(Gen, Comp, DecInfObj) -> #'ComponentType'{name=Cname} = Comp, case DecInfObj of {Cname,{_,_OSet,_UniqueFName,ValIndex}} -> Term = asn1ct_gen:mk_var(asn1ct_name:curr(term)), - ValueMatch = value_match(ValIndex,Term), + ValueMatch = value_match(Gen, ValIndex,Term), emit([",",nl, "ObjFun = ",ValueMatch]); _ -> @@ -1705,20 +1896,17 @@ gen_dec_choice2(Erule, TopType, [H0|T], Pos, Sep0, Pre) -> gen_dec_choice2(Erule, TopType, T, Pos+1, Sep, Pre); gen_dec_choice2(_, _, [], _, _, _) -> ok. -make_elements(I,Val,ExtCnames) -> - make_elements(I,Val,ExtCnames,[]). +get_input_vars(Val, I, N) -> + L = get_input_vars_1(Val, I, N), + lists:join(",", L). -make_elements(I,Val,[_ExtCname],Acc)-> % the last one, no comma needed - Element = make_element(I, Val), - make_elements(I+1,Val,[],[Element|Acc]); -make_elements(I,Val,[_ExtCname|Rest],Acc)-> - Element = make_element(I, Val), - make_elements(I+1,Val,Rest,[", ",Element|Acc]); -make_elements(_I,_,[],Acc) -> - lists:reverse(Acc). +get_input_vars_1(_Val, _I, 0) -> + []; +get_input_vars_1(Val, I, N) -> + [get_input_var(Val, I)|get_input_vars_1(Val, I+1, N-1)]. -make_element(I, Val) -> - lists:flatten(io_lib:format("element(~w, ~s)", [I,Val])). +get_input_var(Val, I) -> + lists:flatten(io_lib:format("element(~w, ~s)", [I+1,Val])). emit_extaddgroupTerms(VarSeries,[_]) -> asn1ct_name:new(VarSeries), @@ -1735,62 +1923,66 @@ flat_complist({Rl1,El,Rl2}) -> Rl1 ++ El ++ Rl2; flat_complist({Rl,El}) -> Rl ++ El; flat_complist(CompList) -> CompList. -%%wrap_compList({Root1,Ext,Root2}) -> -%% {Root1,wrap_extensionAdditionGroups(Ext),Root2}; -%%wrap_compList({Root1,Ext}) -> -%% {Root1,wrap_extensionAdditionGroups(Ext)}; -%%wrap_compList(CompList) -> -%% CompList. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Will convert all componentTypes following 'ExtensionAdditionGroup' +%% Convert all componentTypes following 'ExtensionAdditionGroup' %% up to the matching 'ExtensionAdditionGroupEnd' into one componentType -%% of type SEQUENCE with the componentTypes as components +%% of type SEQUENCE with the componentTypes as components. %% -wrap_extensionAdditionGroups(ExtCompList,ExtGroupPosLen) -> - wrap_extensionAdditionGroups(ExtCompList,ExtGroupPosLen,[],0,0). +wrap_extensionAdditionGroups(ExtCompList, ExtGroupPosLen) -> + wrap_eags(ExtCompList, ExtGroupPosLen, 0, 0). -wrap_extensionAdditionGroups([{'ExtensionAdditionGroup',_Number}|Rest], - [{ActualPos,_,_}|ExtGroupPosLenRest],Acc,_ExtAddGroupDiff,ExtGroupNum) -> - {ExtGroupCompList,['ExtensionAdditionGroupEnd'|Rest2]} = +wrap_eags([{'ExtensionAdditionGroup',_Number}|T0], + [{ActualPos,_,_}|Gs], _ExtAddGroupDiff, ExtGroupNum) -> + {ExtGroupCompList,['ExtensionAdditionGroupEnd'|T]} = lists:splitwith(fun(#'ComponentType'{}) -> true; (_) -> false - end, - Rest), - wrap_extensionAdditionGroups(Rest2,ExtGroupPosLenRest, - [#'ComponentType'{ - name=list_to_atom("ExtAddGroup"++ - integer_to_list(ExtGroupNum+1)), - typespec=#type{def=#'SEQUENCE'{ - extaddgroup=ExtGroupNum+1, - components=ExtGroupCompList}}, - textual_order = ActualPos, - prop='OPTIONAL'}|Acc],length(ExtGroupCompList)-1, - ExtGroupNum+1); -wrap_extensionAdditionGroups([H=#'ComponentType'{textual_order=Tord}|T], - ExtAddGrpLenPos,Acc,ExtAddGroupDiff,ExtGroupNum) when is_integer(Tord) -> - wrap_extensionAdditionGroups(T,ExtAddGrpLenPos,[H#'ComponentType'{ - textual_order=Tord - ExtAddGroupDiff}|Acc],ExtAddGroupDiff,ExtGroupNum); -wrap_extensionAdditionGroups([H|T],ExtAddGrpLenPos,Acc,ExtAddGroupDiff,ExtGroupNum) -> - wrap_extensionAdditionGroups(T,ExtAddGrpLenPos,[H|Acc],ExtAddGroupDiff,ExtGroupNum); -wrap_extensionAdditionGroups([],_,Acc,_,_) -> - lists:reverse(Acc). - -value_match(Index,Value) when is_atom(Value) -> - value_match(Index,atom_to_list(Value)); -value_match([],Value) -> + end, T0), + Name = list_to_atom(lists:concat(["ExtAddGroup",ExtGroupNum+1])), + Seq = #type{def=#'SEQUENCE'{extaddgroup=ExtGroupNum+1, + components=ExtGroupCompList}}, + Comp = #'ComponentType'{name=Name, + typespec=Seq, + textual_order=ActualPos, + prop='OPTIONAL'}, + [Comp|wrap_eags(T, Gs, length(ExtGroupCompList)-1, ExtGroupNum+1)]; +wrap_eags([#'ComponentType'{textual_order=Tord}=H|T], + ExtAddGrpLenPos, ExtAddGroupDiff, ExtGroupNum) + when is_integer(Tord) -> + Comp = H#'ComponentType'{textual_order=Tord - ExtAddGroupDiff}, + [Comp|wrap_eags(T, ExtAddGrpLenPos, ExtAddGroupDiff, ExtGroupNum)]; +wrap_eags([H|T], ExtAddGrpLenPos, ExtAddGroupDiff, ExtGroupNum) -> + [H|wrap_eags(T, ExtAddGrpLenPos, ExtAddGroupDiff, ExtGroupNum)]; +wrap_eags([], _, _, _) -> + []. + +value_match(#gen{pack=record}, VIs, Value) -> + value_match_rec(VIs, Value); +value_match(#gen{pack=map}, VIs, Value) -> + value_match_map(VIs, Value). + +value_match_rec([], Value) -> Value; -value_match([{VI,_}|VIs],Value) -> - value_match1(Value,VIs,lists:concat(["element(",VI,","]),1). -value_match1(Value,[],Acc,Depth) -> - Acc ++ Value ++ lists:concat(lists:duplicate(Depth,")")); -value_match1(Value,[{VI,_}|VIs],Acc,Depth) -> - value_match1(Value,VIs,Acc++lists:concat(["element(",VI,","]),Depth+1). - -enc_dig_out_value([], Value) -> +value_match_rec([{VI,_}|VIs], Value0) -> + Value = value_match_rec(VIs, Value0), + lists:concat(["element(",VI,", ",Value,")"]). + +value_match_map([], Value) -> + Value; +value_match_map([{_,Name}|VIs], Value0) -> + Value = value_match_map(VIs, Value0), + lists:concat(["maps:get(",Name,", ",Value,")"]). + +enc_dig_out_value(_Gen, [], Value) -> {[],Value}; -enc_dig_out_value([{N,_}|T], Value) -> - {Imm0,Dst0} = enc_dig_out_value(T, Value), +enc_dig_out_value(#gen{pack=record}=Gen, [{N,_}|T], Value) -> + {Imm0,Dst0} = enc_dig_out_value(Gen, T, Value), {Imm,Dst} = asn1ct_imm:enc_element(N, Dst0), + {Imm0++Imm,Dst}; +enc_dig_out_value(#gen{pack=map}, [{N,'ASN1_top'}], _Value) -> + {[],{var,lists:concat(["Input@",N-1])}}; +enc_dig_out_value(#gen{pack=map}=Gen, [{_,Name}|T], Value) -> + {Imm0,Dst0} = enc_dig_out_value(Gen, T, Value), + {Imm,Dst} = asn1ct_imm:enc_maps_get(Name, Dst0), {Imm0++Imm,Dst}. make_var(Base) -> diff --git a/lib/asn1/src/asn1ct_eval_ext.funcs b/lib/asn1/src/asn1ct_eval_ext.funcs index 5761901f89..01c67e7b5a 100644 --- a/lib/asn1/src/asn1ct_eval_ext.funcs +++ b/lib/asn1/src/asn1ct_eval_ext.funcs @@ -1 +1,2 @@ {ext,transform_to_EXTERNAL1994,1}. +{ext,transform_to_EXTERNAL1994_maps,1}. diff --git a/lib/asn1/src/asn1ct_gen.erl b/lib/asn1/src/asn1ct_gen.erl index bfaffa13bf..4fa830d7d9 100644 --- a/lib/asn1/src/asn1ct_gen.erl +++ b/lib/asn1/src/asn1ct_gen.erl @@ -34,10 +34,10 @@ insert_once/2, ct_gen_module/1, index2suffix/1, - get_record_name_prefix/0, + get_record_name_prefix/1, conform_value/2, named_bitstring_value/2]). --export([pgen/5, +-export([pgen/4, mk_var/1, un_hyphen_var/1]). -export([gen_encode_constructed/4, @@ -45,23 +45,20 @@ -define(SUPPRESSION_FUNC, 'dialyzer-suppressions'). + %% pgen(Outfile, Erules, Module, TypeOrVal, Options) -%% Generate Erlang module (.erl) and (.hrl) file corresponding to an ASN.1 module -%% .hrl file is only generated if necessary -%% Erules = per | ber -%% Module = atom() -%% TypeOrVal = {TypeList,ValueList} -%% TypeList = ValueList = [atom()] -%% Options = [Options] from asn1ct:compile() - -pgen(OutFile,Erules,Module,TypeOrVal,Options) -> - pgen_module(OutFile,Erules,Module,TypeOrVal,Options,true). - - -pgen_module(OutFile,Erules,Module, - TypeOrVal = {Types,_Values,_Ptypes,_Classes,_Objects,_ObjectSets}, - Options,Indent) -> - N2nConvEnums = [CName|| {n2n,CName} <- get(encoding_options)], +%% Generate Erlang module (.erl) and (.hrl) file corresponding to +%% an ASN.1 module. The .hrl file is only generated if necessary. + +-spec pgen(Outfile, Gen, Module, Contents) -> 'ok' when + Outfile :: any(), + Gen :: #gen{}, + Module :: module(), + Contents :: tuple(). + +pgen(OutFile, #gen{options=Options}=Gen, Module, Contents) -> + {Types,_Values,_Ptypes,_Classes,_Objects,_ObjectSets} = Contents, + N2nConvEnums = [CName|| {n2n,CName} <- Options], case N2nConvEnums -- Types of [] -> ok; @@ -70,29 +67,28 @@ pgen_module(OutFile,Erules,Module, UnmatchedTypes}) end, put(outfile,OutFile), - HrlGenerated = pgen_hrl(Erules,Module,TypeOrVal,Options,Indent), + put(currmod, Module), + HrlGenerated = pgen_hrl(Gen, Module, Contents), asn1ct_name:start(), ErlFile = lists:concat([OutFile,".erl"]), _ = open_output_file(ErlFile), asn1ct_func:start_link(), - gen_head(Erules,Module,HrlGenerated), - pgen_exports(Erules,Module,TypeOrVal), - pgen_dispatcher(Erules,Module,TypeOrVal), + gen_head(Gen, Module, HrlGenerated), + pgen_exports(Gen, Module, Contents), + pgen_dispatcher(Gen, Contents), pgen_info(), - pgen_typeorval(Erules,Module,N2nConvEnums,TypeOrVal), - pgen_partial_incomplete_decode(Erules), -% gen_vars(asn1_db:mod_to_vars(Module)), -% gen_tag_table(AllTypes), + pgen_typeorval(Gen, Module, N2nConvEnums, Contents), + pgen_partial_incomplete_decode(Gen), emit([nl, "%%%",nl, "%%% Run-time functions.",nl, "%%%",nl]), - dialyzer_suppressions(Erules), + dialyzer_suppressions(Gen), Fd = get(gen_file_out), asn1ct_func:generate(Fd), close_output_file(), _ = erase(outfile), - asn1ct:verbose("--~p--~n",[{generated,ErlFile}],Options). + asn1ct:verbose("--~p--~n", [{generated,ErlFile}], Gen). dialyzer_suppressions(Erules) -> emit([nl, @@ -181,10 +177,10 @@ pgen_objectsets(Rtmod,Erules,Module,[H|T]) -> Rtmod:gen_objectset_code(Erules,TypeDef), pgen_objectsets(Rtmod,Erules,Module,T). -pgen_partial_decode(Rtmod,Erule,Module) when Erule == ber -> - pgen_partial_inc_dec(Rtmod,Erule,Module), - pgen_partial_dec(Rtmod,Erule,Module); -pgen_partial_decode(_,_,_) -> +pgen_partial_decode(Rtmod, #gen{erule=ber}=Gen, Module) -> + pgen_partial_inc_dec(Rtmod, Gen, Module), + pgen_partial_dec(Rtmod, Gen, Module); +pgen_partial_decode(_, _, _) -> ok. pgen_partial_inc_dec(Rtmod,Erules,Module) -> @@ -225,7 +221,7 @@ pgen_partial_inc_dec1(Rtmod,Erules,Module,[P|Ps]) -> pgen_partial_inc_dec1(_,_,_,[]) -> ok. -gen_partial_inc_dec_refed_funcs(Rtmod,Erule) when Erule == ber -> +gen_partial_inc_dec_refed_funcs(Rtmod, #gen{erule=ber}=Gen) -> case asn1ct:next_refed_func() of [] -> ok; @@ -233,19 +229,17 @@ gen_partial_inc_dec_refed_funcs(Rtmod,Erule) when Erule == ber -> TypeDef = asn1_db:dbget(M,Name), asn1ct:update_gen_state(namelist,Pattern), asn1ct:set_current_sindex(Sindex), - Rtmod:gen_inc_decode(Erule,TypeDef), - gen_dec_part_inner_constr(Rtmod,Erule,TypeDef,[Name]), - gen_partial_inc_dec_refed_funcs(Rtmod,Erule); + Rtmod:gen_inc_decode(Gen, TypeDef), + gen_dec_part_inner_constr(Rtmod, Gen, TypeDef, [Name]), + gen_partial_inc_dec_refed_funcs(Rtmod, Gen); {Name,Sindex,Pattern,Type} -> TypeDef=#typedef{name=asn1ct_gen:list2name(Name),typespec=Type}, asn1ct:update_gen_state(namelist,Pattern), asn1ct:set_current_sindex(Sindex), - Rtmod:gen_inc_decode(Erule,TypeDef), - gen_dec_part_inner_constr(Rtmod,Erule,TypeDef,Name), - gen_partial_inc_dec_refed_funcs(Rtmod,Erule) - end; -gen_partial_inc_dec_refed_funcs(_,_) -> - ok. + Rtmod:gen_inc_decode(Gen, TypeDef), + gen_dec_part_inner_constr(Rtmod, Gen, TypeDef, Name), + gen_partial_inc_dec_refed_funcs(Rtmod, Gen) + end. pgen_partial_dec(_Rtmod,Erules,_Module) -> Type_pattern = asn1ct:get_gen_state_field(type_pattern), @@ -254,16 +248,16 @@ pgen_partial_dec(_Rtmod,Erules,_Module) -> pgen_partial_types(Erules,Type_pattern), ok. -pgen_partial_types(Erules,Type_pattern) -> - % until this functionality works on all back-ends - Options = get(encoding_options), - case lists:member(asn1config,Options) of +pgen_partial_types(#gen{options=Options}=Gen, TypePattern) -> + %% until this functionality works on all back-ends + case lists:member(asn1config, Options) of true -> - pgen_partial_types1(Erules,Type_pattern); - _ -> ok + pgen_partial_types1(Gen, TypePattern); + false -> + ok end. - + pgen_partial_types1(Erules,[{FuncName,[TopType|RestTypes]}|Rest]) -> % emit([FuncName,"(Bytes) ->",nl]), CurrMod = get(currmod), @@ -441,7 +435,8 @@ pgen_partial_incomplete_decode(Erule) -> _ -> ok end. -pgen_partial_incomplete_decode1(ber) -> + +pgen_partial_incomplete_decode1(#gen{erule=ber}) -> case asn1ct:read_config_data(partial_incomplete_decode) of undefined -> ok; @@ -451,7 +446,7 @@ pgen_partial_incomplete_decode1(ber) -> GeneratedFs= asn1ct:get_gen_state_field(gen_refed_funcs), % io:format("GeneratedFs :~n~p~n",[GeneratedFs]), gen_part_decode_funcs(GeneratedFs,0); -pgen_partial_incomplete_decode1(_) -> ok. +pgen_partial_incomplete_decode1(#gen{}) -> ok. emit_partial_incomplete_decode({FuncName,TopType,Pattern}) -> TypePattern = asn1ct:get_gen_state_field(inc_type_pattern), @@ -654,29 +649,30 @@ gen_decode_constructed(Erules,Typename,InnerType,D) when is_record(D,typedef) -> gen_decode_constructed(Erules,Typename,InnerType,D#typedef.typespec). -pgen_exports(Erules,_Module,{Types,Values,_,_,Objects,ObjectSets}) -> - emit(["-export([encoding_rule/0,bit_string_format/0,",nl, +pgen_exports(#gen{options=Options}=Gen, _Module, Contents) -> + {Types,Values,_,_,Objects,ObjectSets} = Contents, + emit(["-export([encoding_rule/0,maps/0,bit_string_format/0,",nl, " legacy_erlang_types/0]).",nl]), emit(["-export([",{asis,?SUPPRESSION_FUNC},"/1]).",nl]), case Types of [] -> ok; _ -> emit({"-export([",nl}), - case Erules of - ber -> + case Gen of + #gen{erule=ber} -> gen_exports1(Types,"enc_",2); _ -> gen_exports1(Types,"enc_",1) end, emit({"-export([",nl}), - case Erules of - ber -> + case Gen of + #gen{erule=ber} -> gen_exports1(Types, "dec_", 2); _ -> gen_exports1(Types, "dec_", 1) end end, - case [X || {n2n,X} <- get(encoding_options)] of + case [X || {n2n,X} <- Options] of [] -> ok; A2nNames -> emit({"-export([",nl}), @@ -693,10 +689,10 @@ pgen_exports(Erules,_Module,{Types,Values,_,_,Objects,ObjectSets}) -> case Objects of [] -> ok; _ -> - case erule(Erules) of - per -> - ok; - ber -> + case Gen of + #gen{erule=per} -> + ok; + #gen{erule=ber} -> emit({"-export([",nl}), gen_exports1(Objects,"enc_",3), emit({"-export([",nl}), @@ -706,10 +702,10 @@ pgen_exports(Erules,_Module,{Types,Values,_,_,Objects,ObjectSets}) -> case ObjectSets of [] -> ok; _ -> - case erule(Erules) of - per -> - ok; - ber -> + case Gen of + #gen{erule=per} -> + ok; + #gen{erule=ber} -> emit({"-export([",nl}), gen_exports1(ObjectSets, "getenc_",1), emit({"-export([",nl}), @@ -735,16 +731,17 @@ gen_partial_inc_decode_exports() -> {_,undefined} -> ok; {Data,_} -> - gen_partial_inc_decode_exports(Data), + gen_partial_inc_decode_exports0(Data), emit(["-export([decode_part/2]).",nl]) end. -gen_partial_inc_decode_exports([]) -> + +gen_partial_inc_decode_exports0([]) -> ok; -gen_partial_inc_decode_exports([{Name,_,_}|Rest]) -> +gen_partial_inc_decode_exports0([{Name,_,_}|Rest]) -> emit(["-export([",Name,"/1"]), gen_partial_inc_decode_exports1(Rest); -gen_partial_inc_decode_exports([_|Rest]) -> - gen_partial_inc_decode_exports(Rest). +gen_partial_inc_decode_exports0([_|Rest]) -> + gen_partial_inc_decode_exports0(Rest). gen_partial_inc_decode_exports1([]) -> emit(["]).",nl]); @@ -773,27 +770,27 @@ gen_selected_decode_exports1([{FuncName,_}|Rest]) -> emit([",",nl," ",FuncName,"/1"]), gen_selected_decode_exports1(Rest). -pgen_dispatcher(Erules,_Module,{[],_Values,_,_,_Objects,_ObjectSets}) -> +pgen_dispatcher(Erules, {[],_Values,_,_,_Objects,_ObjectSets}) -> gen_info_functions(Erules); -pgen_dispatcher(Erules,_Module,{Types,_Values,_,_,_Objects,_ObjectSets}) -> +pgen_dispatcher(Gen, {Types,_Values,_,_,_Objects,_ObjectSets}) -> emit(["-export([encode/2,decode/2]).",nl,nl]), - gen_info_functions(Erules), + gen_info_functions(Gen), - Options = get(encoding_options), + Options = Gen#gen.options, NoFinalPadding = lists:member(no_final_padding, Options), NoOkWrapper = proplists:get_bool(no_ok_wrapper, Options), - Call = case Erules of - per -> - asn1ct_func:need({Erules,complete,1}), + Call = case Gen of + #gen{erule=per,aligned=true} -> + asn1ct_func:need({per,complete,1}), "complete(encode_disp(Type, Data))"; - ber -> + #gen{erule=ber} -> "iolist_to_binary(element(1, encode_disp(Type, Data)))"; - uper when NoFinalPadding == true -> - asn1ct_func:need({Erules,complete_NFP,1}), + #gen{erule=per,aligned=false} when NoFinalPadding -> + asn1ct_func:need({uper,complete_NFP,1}), "complete_NFP(encode_disp(Type, Data))"; - uper -> - asn1ct_func:need({Erules,complete,1}), + #gen{erule=per,aligned=false} -> + asn1ct_func:need({uper,complete,1}), "complete(encode_disp(Type, Data))" end, @@ -809,36 +806,36 @@ pgen_dispatcher(Erules,_Module,{Types,_Values,_,_,_Objects,_ObjectSets}) -> end, emit([nl,nl]), - Return_rest = proplists:get_bool(undec_rest, Options), - Data = case {Erules,Return_rest} of - {ber,true} -> "Data0"; - _ -> "Data" + ReturnRest = proplists:get_bool(undec_rest, Gen#gen.options), + Data = case Gen#gen.erule =:= ber andalso ReturnRest of + true -> "Data0"; + false -> "Data" end, emit(["decode(Type,",Data,") ->",nl]), DecWrap = - case {Erules,Return_rest} of - {ber,false} -> + case {Gen,ReturnRest} of + {#gen{erule=ber},false} -> asn1ct_func:need({ber,ber_decode_nif,1}), "element(1, ber_decode_nif(Data))"; - {ber,true} -> + {#gen{erule=ber},true} -> asn1ct_func:need({ber,ber_decode_nif,1}), emit(["{Data,Rest} = ber_decode_nif(Data0),",nl]), "Data"; - _ -> + {_,_} -> "Data" end, emit([case NoOkWrapper of false -> "try"; true -> "case" end, " decode_disp(Type, ",DecWrap,") of",nl]), - case erule(Erules) of - ber -> + case Gen of + #gen{erule=ber} -> emit([" Result ->",nl]); - per -> + #gen{erule=per} -> emit([" {Result,Rest} ->",nl]) end, - case Return_rest of + case ReturnRest of false -> result_line(NoOkWrapper, ["Result"]); true -> result_line(NoOkWrapper, ["Result","Rest"]) end, @@ -849,14 +846,14 @@ pgen_dispatcher(Erules,_Module,{Types,_Values,_,_,_Objects,_ObjectSets}) -> emit([nl,"end.",nl,nl]) end, - gen_decode_partial_incomplete(Erules), + gen_decode_partial_incomplete(Gen), - case Erules of - ber -> + case Gen of + #gen{erule=ber} -> gen_dispatcher(Types,"encode_disp","enc_",""), gen_dispatcher(Types,"decode_disp","dec_",""), gen_partial_inc_dispatcher(); - _PerOrPer_bin -> + #gen{} -> gen_dispatcher(Types,"encode_disp","enc_",""), gen_dispatcher(Types,"decode_disp","dec_","") end, @@ -885,15 +882,26 @@ try_catch() -> " end",nl, "end."]. -gen_info_functions(Erules) -> +gen_info_functions(Gen) -> + Erule = case Gen of + #gen{erule=ber} -> ber; + #gen{erule=per,aligned=false} -> uper; + #gen{erule=per,aligned=true} -> per + end, + Maps = case Gen of + #gen{pack=record} -> false; + #gen{pack=map} -> true + end, emit(["encoding_rule() -> ", - {asis,Erules},".",nl,nl, + {asis,Erule},".",nl,nl, + "maps() -> ", + {asis,Maps},".",nl,nl, "bit_string_format() -> ", {asis,asn1ct:get_bit_string_format()},".",nl,nl, "legacy_erlang_types() -> ", {asis,asn1ct:use_legacy_types()},".",nl,nl]). -gen_decode_partial_incomplete(ber) -> +gen_decode_partial_incomplete(#gen{erule=ber}) -> case {asn1ct:read_config_data(partial_incomplete_decode), asn1ct:get_gen_state_field(inc_type_pattern)} of {undefined,_} -> @@ -931,7 +939,7 @@ gen_decode_partial_incomplete(ber) -> EmitCaseClauses(), emit([".",nl,nl]) end; -gen_decode_partial_incomplete(_Erule) -> +gen_decode_partial_incomplete(#gen{}) -> ok. gen_partial_inc_dispatcher() -> @@ -1092,22 +1100,21 @@ open_output_file(F) -> close_output_file() -> ok = file:close(erase(gen_file_out)). -pgen_hrl(Erules,Module,TypeOrVal,Options,_Indent) -> - put(currmod,Module), - {Types,Values,Ptypes,_,_,_} = TypeOrVal, +pgen_hrl(#gen{pack=record}=Gen, Module, Contents) -> + {Types,Values,Ptypes,_,_,_} = Contents, Ret = - case pgen_hrltypes(Erules,Module,Ptypes++Types,0) of + case pgen_hrltypes(Gen, Module, Ptypes++Types, 0) of 0 -> case Values of [] -> 0; _ -> - open_hrl(get(outfile),get(currmod)), - pgen_macros(Erules,Module,Values), + open_hrl(get(outfile), Module), + pgen_macros(Gen, Module, Values), 1 end; X -> - pgen_macros(Erules,Module,Values), + pgen_macros(Gen, Module, Values), X end, case Ret of @@ -1119,62 +1126,61 @@ pgen_hrl(Erules,Module,TypeOrVal,Options,_Indent) -> close_output_file(), asn1ct:verbose("--~p--~n", [{generated,lists:concat([get(outfile),".hrl"])}], - Options), + Gen), Y - end. + end; +pgen_hrl(#gen{pack=map}, _, _) -> + 0. pgen_macros(_,_,[]) -> true; -pgen_macros(Erules,Module,[H|T]) -> - Valuedef = asn1_db:dbget(Module,H), - gen_macro(Valuedef), - pgen_macros(Erules,Module,T). +pgen_macros(Gen, Module, [H|T]) -> + Valuedef = asn1_db:dbget(Module, H), + gen_macro(Gen, Valuedef), + pgen_macros(Gen, Module, T). pgen_hrltypes(_,_,[],NumRecords) -> NumRecords; -pgen_hrltypes(Erules,Module,[H|T],NumRecords) -> -% io:format("records = ~p~n",NumRecords), - Typedef = asn1_db:dbget(Module,H), - AddNumRecords = gen_record(Typedef,NumRecords), - pgen_hrltypes(Erules,Module,T,NumRecords+AddNumRecords). +pgen_hrltypes(Gen, Module, [H|T], NumRecords) -> + Typedef = asn1_db:dbget(Module, H), + AddNumRecords = gen_record(Gen, Typedef, NumRecords), + pgen_hrltypes(Gen, Module, T, NumRecords+AddNumRecords). %% Generates a macro for value Value defined in the ASN.1 module -gen_macro(Value) when is_record(Value,valuedef) -> - Prefix = get_macro_name_prefix(), - emit({"-define('",Prefix,Value#valuedef.name,"', ", - {asis,Value#valuedef.value},").",nl}). +gen_macro(Gen, #valuedef{name=Name,value=Value}) -> + Prefix = get_macro_name_prefix(Gen), + emit(["-define('",Prefix,Name,"', ",{asis,Value},").",nl]). %% Generate record functions ************** %% Generates an Erlang record for each named and unnamed SEQUENCE and SET in the ASN.1 %% module. If no SEQUENCE or SET is found there is no .hrl file generated -gen_record(Tdef,NumRecords) when is_record(Tdef,typedef) -> +gen_record(Gen, #typedef{}=Tdef, NumRecords) -> Name = [Tdef#typedef.name], Type = Tdef#typedef.typespec, - gen_record(type,Name,Type,NumRecords); - -gen_record(Tdef,NumRecords) when is_record(Tdef,ptypedef) -> + gen_record(Gen, type, Name, Type, NumRecords); +gen_record(Gen, #ptypedef{}=Tdef, NumRecords) -> Name = [Tdef#ptypedef.name], Type = Tdef#ptypedef.typespec, - gen_record(ptype,Name,Type,NumRecords). - -gen_record(TorPtype,Name,[#'ComponentType'{name=Cname,typespec=Type}|T],Num) -> - Num2 = gen_record(TorPtype,[Cname|Name],Type,Num), - gen_record(TorPtype,Name,T,Num2); -gen_record(TorPtype,Name,{Clist1,Clist2},Num) + gen_record(Gen, ptype, Name, Type, NumRecords). + +gen_record(Gen, TorPtype, Name, + [#'ComponentType'{name=Cname,typespec=Type}|T], Num) -> + Num2 = gen_record(Gen, TorPtype, [Cname|Name], Type, Num), + gen_record(Gen, TorPtype, Name, T, Num2); +gen_record(Gen, TorPtype, Name, {Clist1,Clist2}, Num) when is_list(Clist1), is_list(Clist2) -> - gen_record(TorPtype,Name,Clist1++Clist2,Num); -gen_record(TorPtype,Name,{Clist1,EClist,Clist2},Num) + gen_record(Gen, TorPtype, Name, Clist1++Clist2, Num); +gen_record(Gen, TorPtype, Name, {Clist1,EClist,Clist2}, Num) when is_list(Clist1), is_list(EClist), is_list(Clist2) -> - gen_record(TorPtype,Name,Clist1++EClist++Clist2,Num); -gen_record(TorPtype,Name,[_|T],Num) -> % skip EXTENSIONMARK - gen_record(TorPtype,Name,T,Num); -gen_record(_TorPtype,_Name,[],Num) -> + gen_record(Gen, TorPtype, Name, Clist1++EClist++Clist2, Num); +gen_record(Gen, TorPtype, Name, [_|T], Num) -> % skip EXTENSIONMARK + gen_record(Gen, TorPtype, Name, T, Num); +gen_record(_Gen, _TorPtype, _Name, [], Num) -> Num; - -gen_record(TorPtype,Name,Type,Num) when is_record(Type,type) -> +gen_record(Gen, TorPtype, Name, #type{}=Type, Num) -> Def = Type#type.def, Rec = case Def of Seq when is_record(Seq,'SEQUENCE') -> @@ -1209,7 +1215,7 @@ gen_record(TorPtype,Name,Type,Num) when is_record(Type,type) -> 0 -> open_hrl(get(outfile),get(currmod)); _ -> true end, - Prefix = get_record_name_prefix(), + Prefix = get_record_name_prefix(Gen), emit({"-record('",Prefix,list2name(Name),"',{",nl}), RootList = case CompList of _ when is_list(CompList) -> @@ -1260,33 +1266,28 @@ gen_record(TorPtype,Name,Type,Num) when is_record(Type,type) -> emit({"}).",nl,nl}), CompList end, - gen_record(TorPtype,Name,NewCompList,Num+1); + gen_record(Gen, TorPtype, Name, NewCompList, Num+1); {inner,{'CHOICE', CompList}} -> - gen_record(TorPtype,Name,CompList,Num); + gen_record(Gen, TorPtype, Name, CompList, Num); {NewName,{_, CompList}} -> - gen_record(TorPtype,NewName,CompList,Num) + gen_record(Gen, TorPtype, NewName, CompList, Num) end; -gen_record(_,_,_,NumRecords) -> % skip CLASS etc for now. +gen_record(_, _, _, _, NumRecords) -> % skip CLASS etc for now. NumRecords. - -gen_head(Erules,Mod,Hrl) -> - Options = get(encoding_options), - case Erules of - per -> - emit(["%% Generated by the Erlang ASN.1 PER-" - "compiler version, utilizing bit-syntax:", - asn1ct:vsn(),nl]); - ber -> - emit(["%% Generated by the Erlang ASN.1 BER_V2-" - "compiler version, utilizing bit-syntax:", - asn1ct:vsn(),nl]); - uper -> - emit(["%% Generated by the Erlang ASN.1 UNALIGNED" - " PER-compiler version, utilizing bit-syntax:", - asn1ct:vsn(),nl]) - end, - emit({"%% Purpose: encoder and decoder to the types in mod ",Mod,nl,nl}), - emit({"-module('",Mod,"').",nl}), + +gen_head(#gen{options=Options}=Gen, Mod, Hrl) -> + Name = case Gen of + #gen{erule=per,aligned=false} -> + "PER (unaligned)"; + #gen{erule=per,aligned=true} -> + "PER (aligned)"; + #gen{erule=ber} -> + "BER" + end, + emit(["%% Generated by the Erlang ASN.1 ",Name, + "compiler. Version:",asn1ct:vsn(),nl, + "%% Purpose: encoder and decoder of the types in ",Mod,nl,nl, + "-module('",Mod,"').",nl]), put(currmod,Mod), emit({"-compile(nowarn_unused_vars).",nl}), emit({"-dialyzer(no_improper_lists).",nl}), @@ -1297,7 +1298,7 @@ gen_head(Erules,Mod,Hrl) -> emit(["-asn1_info([{vsn,'",asn1ct:vsn(),"'},",nl, " {module,'",Mod,"'},",nl, " {options,",io_lib:format("~p",[Options]),"}]).",nl,nl]). - + gen_hrlhead(Mod) -> emit({"%% Generated by the Erlang ASN.1 compiler version:",asn1ct:vsn(),nl}), @@ -1585,27 +1586,19 @@ constructed_suffix('SEQUENCE OF',_) -> constructed_suffix('SET OF',_) -> 'SETOF'. -erule(ber) -> ber; -erule(per) -> per; -erule(uper) -> per. - index2suffix(0) -> ""; index2suffix(N) -> lists:concat(["_",N]). -ct_gen_module(ber) -> +ct_gen_module(#gen{erule=ber}) -> asn1ct_gen_ber_bin_v2; -ct_gen_module(per) -> - asn1ct_gen_per; -ct_gen_module(uper) -> +ct_gen_module(#gen{erule=per}) -> asn1ct_gen_per. -ct_constructed_module(ber) -> +ct_constructed_module(#gen{erule=ber}) -> asn1ct_constructed_ber_bin_v2; -ct_constructed_module(per) -> - asn1ct_constructed_per; -ct_constructed_module(uper) -> +ct_constructed_module(#gen{erule=per}) -> asn1ct_constructed_per. get_constraint(C,Key) -> @@ -1617,19 +1610,9 @@ get_constraint(C,Key) -> {value,Cnstr} -> Cnstr end. - -get_record_name_prefix() -> - case lists:keysearch(record_name_prefix,1,get(encoding_options)) of - false -> - ""; - {value,{_,Prefix}} -> - Prefix - end. -get_macro_name_prefix() -> - case lists:keysearch(macro_name_prefix,1,get(encoding_options)) of - false -> - ""; - {value,{_,Prefix}} -> - Prefix - end. +get_record_name_prefix(#gen{rec_prefix=Prefix}) -> + Prefix. + +get_macro_name_prefix(#gen{macro_prefix=Prefix}) -> + Prefix. diff --git a/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl b/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl index b884d14b0d..6c6d4193f3 100644 --- a/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl +++ b/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl @@ -1200,11 +1200,13 @@ gen_objset_enc(Erules, ObjSetName, UniqueName, {no_mod,no_name} -> gen_inlined_enc_funs(Fields, ClFields, ObjSetName, Val, NthObj); {CurrMod,Name} -> - emit(["'getenc_",ObjSetName,"'(",{asis,Val},") ->",nl, + emit(["'getenc_",ObjSetName,"'(Id) when Id =:= ", + {asis,Val}," ->",nl, " fun 'enc_",Name,"'/3;",nl]), {[],NthObj}; {ModuleName,Name} -> - emit(["'getenc_",ObjSetName,"'(",{asis,Val},") ->",nl]), + emit(["'getenc_",ObjSetName,"'(Id) when Id =:= ", + {asis,Val}," ->",nl]), emit_ext_fun(enc,ModuleName,Name), emit([";",nl]), {[],NthObj}; @@ -1382,11 +1384,13 @@ gen_objset_dec(Erules, ObjSName, UniqueName, [{ObjName,Val,Fields}|T], {no_mod,no_name} -> gen_inlined_dec_funs(Fields,ClFields,ObjSName,Val,NthObj); {CurrMod,Name} -> - emit(["'getdec_",ObjSName,"'(",{asis,Val},") ->",nl, + emit(["'getdec_",ObjSName,"'(Id) when Id =:= ", + {asis,Val}," ->",nl, " fun 'dec_",Name,"'/3;", nl]), NthObj; {ModuleName,Name} -> - emit(["'getdec_",ObjSName,"'(",{asis,Val},") ->",nl]), + emit(["'getdec_",ObjSName,"'(Id) when Id =:= ", + {asis,Val}," ->",nl]), emit_ext_fun(dec,ModuleName,Name), emit([";",nl]), NthObj; diff --git a/lib/asn1/src/asn1ct_gen_check.erl b/lib/asn1/src/asn1ct_gen_check.erl index abe77dd0cb..ccc62a3ce3 100644 --- a/lib/asn1/src/asn1ct_gen_check.erl +++ b/lib/asn1/src/asn1ct_gen_check.erl @@ -21,45 +21,51 @@ %% -module(asn1ct_gen_check). --export([emit/3]). +-export([emit/4]). -import(asn1ct_gen, [emit/1]). -include("asn1_records.hrl"). -emit(Type, Default, Value) -> +emit(Gen, Type, Default, Value) -> Key = {Type,Default}, - Gen = fun(Fd, Name) -> - file:write(Fd, gen(Name, Type, Default)) - end, + DoGen = fun(Fd, Name) -> + file:write(Fd, gen(Gen, Name, Type, Default)) + end, emit(" case "), - asn1ct_func:call_gen("is_default_", Key, Gen, [Value]), + asn1ct_func:call_gen("is_default_", Key, DoGen, [Value]), emit([" of",nl, "true -> {[],0};",nl, "false ->",nl]). -gen(Name, #type{def=T}, Default) -> +gen(#gen{pack=Pack}=Gen, Name, #type{def=T}, Default) -> + DefMarker = case Pack of + record -> "asn1_DEFAULT"; + map -> atom_to_list(?MISSING_IN_MAP) + end, NameStr = atom_to_list(Name), - [NameStr,"(asn1_DEFAULT) ->\n", - "true;\n"|case do_gen(T, Default) of - {literal,Literal} -> - [NameStr,"(",term2str(Literal),") ->\n","true;\n", - NameStr,"(_) ->\n","false.\n\n"]; - {exception,Func,Args} -> - [NameStr,"(Value) ->\n", - "try ",Func,"(Value",arg2str(Args),") of\n", - "_ -> true\n" - "catch throw:false -> false\n" - "end.\n\n"] - end]. + [NameStr,"(",DefMarker,") ->\n", + "true;\n"| + case do_gen(Gen, T, Default) of + {literal,Literal} -> + [NameStr,"(Def) when Def =:= ",term2str(Literal)," ->\n", + "true;\n", + NameStr,"(_) ->\n","false.\n\n"]; + {exception,Func,Args} -> + [NameStr,"(Value) ->\n", + "try ",Func,"(Value",arg2str(Args),") of\n", + "_ -> true\n" + "catch throw:false -> false\n" + "end.\n\n"] + end]. -do_gen(_, asn1_NOVALUE) -> +do_gen(_Gen, _, asn1_NOVALUE) -> {literal,asn1_NOVALUE}; -do_gen(#'Externaltypereference'{module=M,type=T}, Default) -> +do_gen(Gen, #'Externaltypereference'{module=M,type=T}, Default) -> #typedef{typespec=#type{def=Td}} = asn1_db:dbget(M, T), - do_gen(Td, Default); -do_gen('BOOLEAN', Default) -> + do_gen(Gen, Td, Default); +do_gen(_Gen, 'BOOLEAN', Default) -> {literal,Default}; -do_gen({'BIT STRING',[]}, Default) -> +do_gen(_Gen, {'BIT STRING',[]}, Default) -> true = is_bitstring(Default), %Assertion. case asn1ct:use_legacy_types() of false -> @@ -67,17 +73,17 @@ do_gen({'BIT STRING',[]}, Default) -> true -> {exception,need(check_legacy_bitstring, 2),[Default]} end; -do_gen({'BIT STRING',[_|_]=NBL}, Default) -> +do_gen(_Gen, {'BIT STRING',[_|_]=NBL}, Default) -> do_named_bitstring(NBL, Default); -do_gen({'ENUMERATED',_}, Default) -> +do_gen(_Gen, {'ENUMERATED',_}, Default) -> {literal,Default}; -do_gen('INTEGER', Default) -> +do_gen(_Gen, 'INTEGER', Default) -> {literal,Default}; -do_gen({'INTEGER',NNL}, Default) -> +do_gen(_Gen, {'INTEGER',NNL}, Default) -> {exception,need(check_int, 3),[Default,NNL]}; -do_gen('NULL', Default) -> +do_gen(_Gen, 'NULL', Default) -> {literal,Default}; -do_gen('OCTET STRING', Default) -> +do_gen(_Gen, 'OCTET STRING', Default) -> true = is_binary(Default), %Assertion. case asn1ct:use_legacy_types() of false -> @@ -85,34 +91,34 @@ do_gen('OCTET STRING', Default) -> true -> {exception,need(check_octetstring, 2),[Default]} end; -do_gen('OBJECT IDENTIFIER', Default0) -> +do_gen(_Gen, 'OBJECT IDENTIFIER', Default0) -> Default = pre_process_oid(Default0), {exception,need(check_objectidentifier, 2),[Default]}; -do_gen({'CHOICE',Cs}, Default) -> +do_gen(Gen, {'CHOICE',Cs}, Default) -> {Tag,Value} = Default, [Type] = [Type || #'ComponentType'{name=T,typespec=Type} <- Cs, T =:= Tag], - case do_gen(Type#type.def, Value) of + case do_gen(Gen, Type#type.def, Value) of {literal,Lit} -> {literal,{Tag,Lit}}; {exception,Func0,Args} -> Key = {Tag,Func0,Args}, - Gen = fun(Fd, Name) -> - S = gen_choice(Name, Tag, Func0, Args), - ok = file:write(Fd, S) + DoGen = fun(Fd, Name) -> + S = gen_choice(Name, Tag, Func0, Args), + ok = file:write(Fd, S) end, - Func = asn1ct_func:call_gen("is_default_choice", Key, Gen), + Func = asn1ct_func:call_gen("is_default_choice", Key, DoGen), {exception,atom_to_list(Func),[]} end; -do_gen(#'SEQUENCE'{components=Cs}, Default) -> - do_seq_set(Cs, Default); -do_gen({'SEQUENCE OF',Type}, Default) -> - do_sof(Type, Default); -do_gen(#'SET'{components=Cs}, Default) -> - do_seq_set(Cs, Default); -do_gen({'SET OF',Type}, Default) -> - do_sof(Type, Default); -do_gen(Type, Default) -> +do_gen(Gen, #'SEQUENCE'{components=Cs}, Default) -> + do_seq_set(Gen, Cs, Default); +do_gen(Gen, {'SEQUENCE OF',Type}, Default) -> + do_sof(Gen, Type, Default); +do_gen(Gen, #'SET'{components=Cs}, Default) -> + do_seq_set(Gen, Cs, Default); +do_gen(Gen, {'SET OF',Type}, Default) -> + do_sof(Gen, Type, Default); +do_gen(_Gen, Type, Default) -> case asn1ct_gen:unify_if_string(Type) of restrictedstring -> {exception,need(check_restrictedstring, 2),[Default]}; @@ -136,39 +142,58 @@ do_named_bitstring(_, Default) when is_bitstring(Default) -> end, {exception,need(Func, 3),[Default,bit_size(Default)]}. -do_seq_set(Cs0, Default) -> +do_seq_set(#gen{pack=record}=Gen, Cs0, Default) -> Tag = element(1, Default), Cs1 = [T || #'ComponentType'{typespec=T} <- Cs0], - Cs = components(Cs1, tl(tuple_to_list(Default))), + Cs = components(Gen, Cs1, tl(tuple_to_list(Default))), case are_all_literals(Cs) of true -> Literal = list_to_tuple([Tag|[L || {literal,L} <- Cs]]), {literal,Literal}; false -> Key = {Cs,Default}, - Gen = fun(Fd, Name) -> - S = gen_components(Name, Tag, Cs), - ok = file:write(Fd, S) - end, - Func = asn1ct_func:call_gen("is_default_cs_", Key, Gen), + DoGen = fun(Fd, Name) -> + S = gen_components(Name, Tag, Cs), + ok = file:write(Fd, S) + end, + Func = asn1ct_func:call_gen("is_default_cs_", Key, DoGen), + {exception,atom_to_list(Func),[]} + end; +do_seq_set(#gen{pack=map}=Gen, Cs0, Default) -> + Cs1 = [{N,T} || #'ComponentType'{name=N,typespec=T} <- Cs0], + Cs = map_components(Gen, Cs1, Default), + AllLiterals = lists:all(fun({_,{literal,_}}) -> true; + ({_,_}) -> false + end, Cs), + case AllLiterals of + true -> + L = [{Name,Lit} || {Name,{literal,Lit}} <- Cs], + {literal,maps:from_list(L)}; + false -> + Key = {Cs,Default}, + DoGen = fun(Fd, Name) -> + S = gen_map_components(Name, Cs), + ok = file:write(Fd, S) + end, + Func = asn1ct_func:call_gen("is_default_cs_", Key, DoGen), {exception,atom_to_list(Func),[]} end. -do_sof(Type, Default0) -> +do_sof(Gen, Type, Default0) -> Default = lists:sort(Default0), Cs0 = lists:duplicate(length(Default), Type), - Cs = components(Cs0, Default), + Cs = components(Gen, Cs0, Default), case are_all_literals(Cs) of true -> Literal = [Lit || {literal,Lit} <- Cs], {exception,need(check_literal_sof, 2),[Literal]}; false -> Key = Cs, - Gen = fun(Fd, Name) -> - S = gen_sof(Name, Cs), - ok = file:write(Fd, S) + DoGen = fun(Fd, Name) -> + S = gen_sof(Name, Cs), + ok = file:write(Fd, S) end, - Func = asn1ct_func:call_gen("is_default_sof", Key, Gen), + Func = asn1ct_func:call_gen("is_default_sof", Key, DoGen), {exception,atom_to_list(Func),[]} end. @@ -199,6 +224,39 @@ gen_cs_2([], _) -> "throw(false)\n" "end.\n"]. +gen_map_components(Name, Cs) -> + [atom_to_list(Name),"(Value) ->\n", + "case Value of\n", + "#{"|gen_map_cs_1(Cs, 1, "", [])]. + +gen_map_cs_1([{Name,{literal,Lit}}|T], I, Sep, Acc) -> + Var = "E"++integer_to_list(I), + G = Var ++ " =:= " ++ term2str(Lit), + [Sep,term2str(Name),":=",Var| + gen_map_cs_1(T, I+1, ",\n", [{guard,G}|Acc])]; +gen_map_cs_1([{Name,Exc}|T], I, Sep, Acc) -> + Var = "E"++integer_to_list(I), + [Sep,term2str(Name),":=",Var| + gen_map_cs_1(T, I+1, ",\n", [{exc,{Var,Exc}}|Acc])]; +gen_map_cs_1([], _, _, Acc) -> + G = lists:join(", ", [S || {guard,S} <- Acc]), + Exc = [E || {exc,E} <- Acc], + Body = gen_map_cs_2(Exc, ""), + case G of + [] -> + ["} ->\n"|Body]; + [_|_] -> + ["} when ",G," ->\n"|Body] + end. + +gen_map_cs_2([{Var,{exception,Func,Args}}|T], Sep) -> + [Sep,Func,"(",Var,arg2str(Args),")"|gen_map_cs_2(T, ",\n")]; +gen_map_cs_2([], _) -> + [";\n", + "_ ->\n" + "throw(false)\n" + "end.\n"]. + gen_sof(Name, Cs) -> [atom_to_list(Name),"(Value) ->\n", "case length(Value) of\n", @@ -221,9 +279,18 @@ gen_sof_1([{exception,Func,Args}|Cs], I) -> gen_sof_1([], _) -> ".\n". -components([#type{def=Def}|Ts], [V|Vs]) -> - [do_gen(Def, V)|components(Ts, Vs)]; -components([], []) -> []. +components(Gen, [#type{def=Def}|Ts], [V|Vs]) -> + [do_gen(Gen, Def, V)|components(Gen, Ts, Vs)]; +components(_Gen, [], []) -> []. + +map_components(Gen, [{Name,#type{def=Def}}|Ts], Value) -> + case maps:find(Name, Value) of + {ok,V} -> + [{Name,do_gen(Gen, Def, V)}|map_components(Gen, Ts, Value)]; + error -> + map_components(Gen, Ts, Value) + end; +map_components(_Gen, [], _Value) -> []. gen_choice(Name, Tag, Func, Args) -> NameStr = atom_to_list(Name), diff --git a/lib/asn1/src/asn1ct_gen_per.erl b/lib/asn1/src/asn1ct_gen_per.erl index aa7223904e..9671a566bf 100644 --- a/lib/asn1/src/asn1ct_gen_per.erl +++ b/lib/asn1/src/asn1ct_gen_per.erl @@ -113,11 +113,7 @@ gen_encode_prim(Erules, D) -> Value = {var,atom_to_list(asn1ct_gen:mk_var(asn1ct_name:curr(val)))}, gen_encode_prim(Erules, D, Value). -gen_encode_prim(Erules, #type{}=D, Value) -> - Aligned = case Erules of - uper -> false; - per -> true - end, +gen_encode_prim(#gen{erule=per,aligned=Aligned}, #type{}=D, Value) -> Imm = gen_encode_prim_imm(Value, D, Aligned), asn1ct_imm:enc_cg(Imm, Aligned). @@ -284,11 +280,7 @@ gen_dec_external(Ext, BytesVar) -> _ -> [{asis,Mod},":"] end,{asis,dec_func(Type)},"(",BytesVar,")"]). -gen_dec_imm(Erule, #type{def=Name,constraint=C}) -> - Aligned = case Erule of - uper -> false; - per -> true - end, +gen_dec_imm(#gen{erule=per,aligned=Aligned}, #type{def=Name,constraint=C}) -> gen_dec_imm_1(Name, C, Aligned). gen_dec_imm_1('ASN1_OPEN_TYPE', Constraint, Aligned) -> diff --git a/lib/asn1/src/asn1ct_imm.erl b/lib/asn1/src/asn1ct_imm.erl index 8b96242c56..2ab848652e 100644 --- a/lib/asn1/src/asn1ct_imm.erl +++ b/lib/asn1/src/asn1ct_imm.erl @@ -37,9 +37,11 @@ per_enc_open_type/2, per_enc_restricted_string/3, per_enc_small_number/2]). --export([per_enc_extension_bit/2,per_enc_extensions/4,per_enc_optional/3]). +-export([per_enc_extension_bit/2,per_enc_extensions/4, + per_enc_extensions_map/4, + per_enc_optional/2]). -export([per_enc_sof/5]). --export([enc_absent/3,enc_append/1,enc_element/2]). +-export([enc_absent/3,enc_append/1,enc_element/2,enc_maps_get/2]). -export([enc_cg/2]). -export([optimize_alignment/1,optimize_alignment/2, dec_slim_cg/2,dec_code_gen/2]). @@ -349,27 +351,32 @@ per_enc_extensions(Val0, Pos0, NumBits, Aligned) when NumBits > 0 -> ['_'|Length ++ PutBits]]}], {var,"Extensions"}}]. -per_enc_optional(Val0, {Pos,DefVals}, _Aligned) when is_integer(Pos), - is_list(DefVals) -> - {B,Val} = enc_element(Pos, Val0), +per_enc_extensions_map(Val0, Vars, Undefined, Aligned) -> + NumBits = length(Vars), + {B,[_Val,Bitmap]} = mk_vars(Val0, [bitmap]), + Length = per_enc_small_length(NumBits, Aligned), + PutBits = case NumBits of + 1 -> [{put_bits,1,1,[1]}]; + _ -> [{put_bits,Bitmap,NumBits,[1]}] + end, + BitmapExpr = extensions_bitmap(Vars, Undefined), + B++[{assign,Bitmap,BitmapExpr}, + {list,[{'cond',[[{eq,Bitmap,0}], + ['_'|Length ++ PutBits]]}], + {var,"Extensions"}}]. + +per_enc_optional(Val, DefVals) when is_list(DefVals) -> Zero = {put_bits,0,1,[1]}, One = {put_bits,1,1,[1]}, - B++[{'cond', - [[{eq,Val,DefVal},Zero] || DefVal <- DefVals] ++ [['_',One]]}]; -per_enc_optional(Val0, {Pos,{call,M,F,A}}, _Aligned) when is_integer(Pos) -> - {B,Val} = enc_element(Pos, Val0), + [{'cond', + [[{eq,Val,DefVal},Zero] || DefVal <- DefVals] ++ [['_',One]]}]; +per_enc_optional(Val, {call,M,F,A}) -> {[],[[],Tmp]} = mk_vars([], [tmp]), Zero = {put_bits,0,1,[1]}, One = {put_bits,1,1,[1]}, - B++[{call,M,F,[Val|A],Tmp}, - {'cond', - [[{eq,Tmp,true},Zero],['_',One]]}]; -per_enc_optional(Val0, Pos, _Aligned) when is_integer(Pos) -> - {B,Val} = enc_element(Pos, Val0), - Zero = {put_bits,0,1,[1]}, - One = {put_bits,1,1,[1]}, - B++[{'cond',[[{eq,Val,asn1_NOVALUE},Zero], - ['_',One]]}]. + [{call,M,F,[Val|A],Tmp}, + {'cond', + [[{eq,Tmp,true},Zero],['_',One]]}]. per_enc_sof(Val0, Constraint, ElementVar, ElementImm, Aligned) -> {B,[Val,Len]} = mk_vars(Val0, [len]), @@ -423,6 +430,13 @@ enc_element(N, Val0) -> {[],[Val,Dst]} = mk_vars(Val0, [element]), {[{call,erlang,element,[N,Val],Dst}],Dst}. +enc_maps_get(N, Val0) -> + {[],[Val,Dst0]} = mk_vars(Val0, [element]), + {var,Dst} = Dst0, + DstExpr = {expr,lists:concat(["#{",N,":=",Dst,"}"])}, + {var,SrcVar} = Val, + {[{assign,DstExpr,SrcVar}],Dst0}. + enc_cg(Imm0, false) -> Imm1 = enc_cse(Imm0), Imm2 = enc_pre_cg(Imm1), @@ -1240,6 +1254,20 @@ enc_length(Len, {Lb,Ub}, Aligned) when is_integer(Lb) -> enc_length(Len, Sv, _Aligned) when is_integer(Sv) -> [{'cond',[[{eq,Len,Sv}]]}]. +extensions_bitmap(Vs, Undefined) -> + Highest = 1 bsl (length(Vs)-1), + Cs = extensions_bitmap_1(Vs, Undefined, Highest), + lists:flatten(lists:join(" bor ", Cs)). + +extensions_bitmap_1([{var,V}|Vs], Undefined, Power) -> + S = ["case ",V," of\n", + " ",Undefined," -> 0;\n" + " _ -> ",integer_to_list(Power),"\n" + "end"], + [S|extensions_bitmap_1(Vs, Undefined, Power bsr 1)]; +extensions_bitmap_1([], _, _) -> + []. + put_bits_binary(Bin, _Unit, Aligned) when is_binary(Bin) -> Sz = byte_size(Bin), <<Int:Sz/unit:8>> = Bin, diff --git a/lib/asn1/src/asn1ct_value.erl b/lib/asn1/src/asn1ct_value.erl index b3d41dd9f3..8bd99d995b 100644 --- a/lib/asn1/src/asn1ct_value.erl +++ b/lib/asn1/src/asn1ct_value.erl @@ -64,7 +64,11 @@ from_type(M,Typename,Type) when is_record(Type,type) -> end; {constructed,bif} when Typename == ['EXTERNAL'] -> Val=from_type_constructed(M,Typename,InnerType,Type), - asn1ct_eval_ext:transform_to_EXTERNAL1994(Val); + T = case M:maps() of + false -> transform_to_EXTERNAL1994; + true -> transform_to_EXTERNAL1994_maps + end, + asn1ct_eval_ext:T(Val); {constructed,bif} -> from_type_constructed(M,Typename,InnerType,Type) end; @@ -118,11 +122,13 @@ get_sequence(M,Typename,Type) -> #'SEQUENCE'{components=Cl} -> {'SEQUENCE',Cl}; #'SET'{components=Cl} -> {'SET',to_textual_order(Cl)} end, - case get_components(M,Typename,CompList) of - [] -> - {list_to_atom(asn1ct_gen:list2rname(Typename))}; - C -> - list_to_tuple([list_to_atom(asn1ct_gen:list2rname(Typename))|C]) + Cs = get_components(M, Typename, CompList), + case M:maps() of + false -> + RecordTag = list_to_atom(asn1ct_gen:list2rname(Typename)), + list_to_tuple([RecordTag|[Val || {_,Val} <- Cs]]); + true -> + maps:from_list(Cs) end. get_components(M,Typename,{Root,Ext}) -> @@ -130,9 +136,9 @@ get_components(M,Typename,{Root,Ext}) -> %% Should enhance this *** HERE *** with proper handling of extensions -get_components(M,Typename,[H|T]) -> - [from_type(M,Typename,H)| - get_components(M,Typename,T)]; +get_components(M, Typename, [H|T]) -> + #'ComponentType'{name=Name} = H, + [{Name,from_type(M, Typename, H)}|get_components(M, Typename, T)]; get_components(_,_,[]) -> []. diff --git a/lib/asn1/src/asn1rtt_ext.erl b/lib/asn1/src/asn1rtt_ext.erl index 3bf01823db..161b2db691 100644 --- a/lib/asn1/src/asn1rtt_ext.erl +++ b/lib/asn1/src/asn1rtt_ext.erl @@ -19,7 +19,8 @@ %% -module(asn1rtt_ext). --export([transform_to_EXTERNAL1990/1,transform_to_EXTERNAL1994/1]). +-export([transform_to_EXTERNAL1990/1,transform_to_EXTERNAL1990_maps/1, + transform_to_EXTERNAL1994/1,transform_to_EXTERNAL1994_maps/1]). transform_to_EXTERNAL1990({_,_,_,_}=Val) -> transform_to_EXTERNAL1990(tuple_to_list(Val), []); @@ -51,6 +52,30 @@ transform_to_EXTERNAL1990([Data_value], Acc) list_to_tuple(lists:reverse([{'octet-aligned',Data_value}|Acc])). +transform_to_EXTERNAL1990_maps(#{identification:=Id,'data-value':=Value}=V) -> + M0 = case Id of + {syntax,DRef} -> + #{'direct-reference'=>DRef}; + {'presentation-context-id',IndRef} -> + #{'indirect-reference'=>IndRef}; + {'context-negotiation', + #{'presentation-context-id':=IndRef, + 'transfer-syntax':=DRef}} -> + #{'direct-reference'=>DRef, + 'indirect-reference'=>IndRef} + end, + M = case V of + #{'data-value-descriptor':=Dvd} -> + M0#{'data-value-descriptor'=>Dvd}; + #{} -> + M0 + end, + M#{encoding=>{'octet-aligned',Value}}; +transform_to_EXTERNAL1990_maps(#{encoding:=_}=V) -> + %% Already in the EXTERNAL 1990 format. + V. + + transform_to_EXTERNAL1994({'EXTERNAL',DRef,IndRef,Data_v_desc,Encoding}=V) -> Identification = case {DRef,IndRef} of @@ -71,3 +96,38 @@ transform_to_EXTERNAL1994({'EXTERNAL',DRef,IndRef,Data_v_desc,Encoding}=V) -> %% information. V end. + +transform_to_EXTERNAL1994_maps(V0) -> + Identification = + case V0 of + #{'direct-reference':=DRef, + 'indirect-reference':=asn1_NOVALUE} -> + {syntax,DRef}; + #{'direct-reference':=asn1_NOVALUE, + 'indirect-reference':=IndRef} -> + {'presentation-context-id',IndRef}; + #{'direct-reference':=DRef, + 'indirect-reference':=IndRef} -> + {'context-negotiation', + #{'transfer-syntax'=>DRef, + 'presentation-context-id'=>IndRef}} + end, + case V0 of + #{encoding:={'octet-aligned',Val}} + when is_list(Val); is_binary(Val) -> + %% Transform to the EXTERNAL 1994 definition. + V = #{identification=>Identification, + 'data-value'=>Val}, + case V0 of + #{'data-value-descriptor':=asn1_NOVALUE} -> + V; + #{'data-value-descriptor':=Dvd} -> + V#{'data-value-descriptor'=>Dvd} + end; + _ -> + %% Keep the EXTERNAL 1990 definition to avoid losing + %% information. + V = [{K,V} || {K,V} <- maps:to_list(V0), + V =/= asn1_NOVALUE], + maps:from_list(V) + end. diff --git a/lib/asn1/test/Makefile b/lib/asn1/test/Makefile index 278c80852b..afd063aa8e 100644 --- a/lib/asn1/test/Makefile +++ b/lib/asn1/test/Makefile @@ -82,6 +82,7 @@ MODULES= \ testInfObjExtract \ testParameterizedInfObj \ testFragmented \ + testMaps \ testMergeCompile \ testMultipleLevels \ testDeepTConstr \ diff --git a/lib/asn1/test/asn1_SUITE.erl b/lib/asn1/test/asn1_SUITE.erl index 88b50e07d9..580c919b9d 100644 --- a/lib/asn1/test/asn1_SUITE.erl +++ b/lib/asn1/test/asn1_SUITE.erl @@ -21,6 +21,9 @@ -module(asn1_SUITE). +%% Suppress compilation of an addititional module compiled for maps. +-define(NO_MAPS_MODULE, asn1_test_lib_no_maps). + -define(only_ber(Func), if Rule =:= ber -> Func; true -> ok @@ -98,6 +101,7 @@ groups() -> testMultipleLevels, testOpt, testSeqDefault, + testMaps, % Uses 'External' {group, [], [testExternal, testSeqExtension]}, @@ -172,8 +176,11 @@ groups() -> {performance, [], [testTimer_ber, + testTimer_ber_maps, testTimer_per, - testTimer_uper]}]. + testTimer_per_maps, + testTimer_uper, + testTimer_uper_maps]}]. %%------------------------------------------------------------------------------ %% Init/end @@ -437,6 +444,16 @@ testDEFAULT(Config, Rule, Opts) -> testDef:main(Rule), testSeqSetDefaultVal:main(Rule, Opts). +testMaps(Config) -> + test(Config, fun testMaps/3, + [{ber,[maps,no_ok_wrapper]}, + {ber,[maps,der,no_ok_wrapper]}, + {per,[maps,no_ok_wrapper]}, + {uper,[maps,no_ok_wrapper]}]). +testMaps(Config, Rule, Opts) -> + asn1_test_lib:compile_all(['Maps'], Config, [Rule|Opts]), + testMaps:main(Rule). + testOpt(Config) -> test(Config, fun testOpt/3). testOpt(Config, Rule, Opts) -> asn1_test_lib:compile("Opt", Config, [Rule|Opts]), @@ -610,12 +627,12 @@ parse(Config) -> [asn1_test_lib:compile(M, Config, [abs]) || M <- test_modules()]. per(Config) -> - test(Config, fun per/3, [per,uper]). + test(Config, fun per/3, [per,uper,{per,[maps]},{uper,[maps]}]). per(Config, Rule, Opts) -> [module_test(M, Config, Rule, Opts) || M <- per_modules()]. ber_other(Config) -> - test(Config, fun ber_other/3, [ber]). + test(Config, fun ber_other/3, [ber,{ber,[maps]}]). ber_other(Config, Rule, Opts) -> [module_test(M, Config, Rule, Opts) || M <- ber_modules()]. @@ -624,7 +641,7 @@ der(Config) -> asn1_test_lib:compile_all(ber_modules(), Config, [der]). module_test(M0, Config, Rule, Opts) -> - asn1_test_lib:compile(M0, Config, [Rule|Opts]), + asn1_test_lib:compile(M0, Config, [Rule,?NO_MAPS_MODULE|Opts]), case list_to_atom(M0) of 'LDAP' -> %% Because of the recursive definition of 'Filter' in @@ -991,7 +1008,9 @@ testS1AP(Config, Rule, Opts) -> testRfcs() -> [{timetrap,{minutes,90}}]. -testRfcs(Config) -> test(Config, fun testRfcs/3, [{ber,[der]}]). +testRfcs(Config) -> test(Config, fun testRfcs/3, + [{ber,[der,?NO_MAPS_MODULE]}, + {ber,[der,maps]}]). testRfcs(Config, Rule, Opts) -> case erlang:system_info(system_architecture) of "sparc-sun-solaris2.10" -> @@ -1006,7 +1025,8 @@ test_compile_options(Config) -> ok = test_compile_options:path(Config), ok = test_compile_options:noobj(Config), ok = test_compile_options:record_name_prefix(Config), - ok = test_compile_options:verbose(Config). + ok = test_compile_options:verbose(Config), + ok = test_compile_options:maps(Config). testDoubleEllipses(Config) -> test(Config, fun testDoubleEllipses/3). testDoubleEllipses(Config, Rule, Opts) -> @@ -1053,7 +1073,7 @@ test_x691(Config, Rule, Opts) -> ok. ticket_6143(Config) -> - ok = test_compile_options:ticket_6143(Config). + asn1_test_lib:compile("AA1", Config, [?NO_MAPS_MODULE]). testExtensionAdditionGroup(Config) -> test(Config, fun testExtensionAdditionGroup/3). @@ -1141,20 +1161,33 @@ END ok = asn1ct:compile(File, [{outdir, PrivDir}]). -timer_compile(Config, Rule) -> - asn1_test_lib:compile_all(["H235-SECURITY-MESSAGES", "H323-MESSAGES"], - Config, [no_ok_wrapper,Rule]). +timer_compile(Config, Opts0) -> + Files = ["H235-SECURITY-MESSAGES", "H323-MESSAGES"], + Opts = [no_ok_wrapper,?NO_MAPS_MODULE|Opts0], + asn1_test_lib:compile_all(Files, Config, Opts). testTimer_ber(Config) -> - timer_compile(Config, ber), + timer_compile(Config, [ber]), testTimer:go(). testTimer_per(Config) -> - timer_compile(Config, per), + timer_compile(Config, [per]), testTimer:go(). testTimer_uper(Config) -> - timer_compile(Config, uper), + timer_compile(Config, [uper]), + testTimer:go(). + +testTimer_ber_maps(Config) -> + timer_compile(Config, [ber,maps]), + testTimer:go(). + +testTimer_per_maps(Config) -> + timer_compile(Config, [per,maps]), + testTimer:go(). + +testTimer_uper_maps(Config) -> + timer_compile(Config, [uper,maps]), testTimer:go(). %% Test of multiple-line comment, OTP-8043 @@ -1163,9 +1196,11 @@ testComment(Config) -> asn1_test_lib:roundtrip('Comment', 'Seq', {'Seq',12,true}). testName2Number(Config) -> - N2NOptions = [{n2n,Type} || Type <- ['CauseMisc', 'CauseProtocol', - 'CauseRadioNetwork', - 'CauseTransport','CauseNas']], + N2NOptions0 = [{n2n,Type} || + Type <- ['CauseMisc', 'CauseProtocol', + 'CauseRadioNetwork', + 'CauseTransport','CauseNas']], + N2NOptions = [?NO_MAPS_MODULE|N2NOptions0], asn1_test_lib:compile("S1AP-IEs", Config, N2NOptions), 0 = 'S1AP-IEs':name2num_CauseMisc('control-processing-overload'), @@ -1175,8 +1210,9 @@ testName2Number(Config) -> %% Test that n2n option generates name2num and num2name functions supporting %% values not within the extension root if the enumeration type has an %% extension marker. - N2NOptionsExt = [{n2n, 'NoExt'}, {n2n, 'Ext'}, {n2n, 'Ext2'}], + N2NOptionsExt = [?NO_MAPS_MODULE,{n2n,'NoExt'},{n2n,'Ext'},{n2n,'Ext2'}], asn1_test_lib:compile("EnumN2N", Config, N2NOptionsExt), + %% Previously, name2num and num2name was not generated if the type didn't %% have an extension marker: 0 = 'EnumN2N':name2num_NoExt('blue'), @@ -1194,9 +1230,11 @@ testName2Number(Config) -> ok. ticket_7407(Config) -> - asn1_test_lib:compile("EUTRA-extract-7407", Config, [uper]), + Opts = [uper,?NO_MAPS_MODULE], + asn1_test_lib:compile("EUTRA-extract-7407", Config, Opts), ticket_7407_code(true), - asn1_test_lib:compile("EUTRA-extract-7407", Config, [uper,no_final_padding]), + asn1_test_lib:compile("EUTRA-extract-7407", Config, + [no_final_padding|Opts]), ticket_7407_code(false). ticket_7407_code(FinalPadding) -> diff --git a/lib/asn1/test/asn1_SUITE_data/Maps.asn1 b/lib/asn1/test/asn1_SUITE_data/Maps.asn1 new file mode 100644 index 0000000000..fd5f373e45 --- /dev/null +++ b/lib/asn1/test/asn1_SUITE_data/Maps.asn1 @@ -0,0 +1,17 @@ +Maps DEFINITIONS AUTOMATIC TAGS ::= +BEGIN + +XY ::= SEQUENCE { x INTEGER DEFAULT 0, y INTEGER DEFAULT 0 } + +xy1 XY ::= { x 42, y 17 } +xy2 XY ::= { } +xy3 XY ::= { y 999 } + +S ::= SEQUENCE { + xy XY DEFAULT { x 100, y 100 }, + os OCTET STRING OPTIONAL +} + +s1 S ::= {} + +END diff --git a/lib/asn1/test/asn1_SUITE_data/SeqExtension.asn1 b/lib/asn1/test/asn1_SUITE_data/SeqExtension.asn1 index 5fda19303a..e866ef2f4f 100644 --- a/lib/asn1/test/asn1_SUITE_data/SeqExtension.asn1 +++ b/lib/asn1/test/asn1_SUITE_data/SeqExtension.asn1 @@ -48,6 +48,17 @@ SeqExt6 ::= SEQUENCE [[ i6 [106] INTEGER, i7 [107] INTEGER ]] } +SeqExt7 ::= SEQUENCE +{ + -- The spaces between the ellipsis and the comma will prevent them + -- from being removed. + ... , + [[ a INTEGER (0..65535) OPTIONAL, + b OCTET STRING OPTIONAL, + c BOOLEAN + ]] +} + SeqExt1X ::= XSeqExt1 SeqExt2X ::= XSeqExt2 diff --git a/lib/asn1/test/asn1_SUITE_data/nbapsystem/NBAP-PDU-Discriptions.asn b/lib/asn1/test/asn1_SUITE_data/nbapsystem/NBAP-PDU-Descriptions.asn index b9be9934e4..12a4475422 100644 --- a/lib/asn1/test/asn1_SUITE_data/nbapsystem/NBAP-PDU-Discriptions.asn +++ b/lib/asn1/test/asn1_SUITE_data/nbapsystem/NBAP-PDU-Descriptions.asn @@ -4,7 +4,7 @@ --
-- **************************************************************
-NBAP-PDU-Discriptions {
+NBAP-PDU-Descriptions {
itu-t (0) identified-organization (4) etsi (0) mobileDomain (0)
umts-Access (20) modules (3) nbap (2) version1 (1) nbap-PDU-Descriptions (0) }
diff --git a/lib/asn1/test/asn1_SUITE_data/test_records.erl b/lib/asn1/test/asn1_SUITE_data/test_records.erl index 9fd07c1449..afb1c8c80b 100644 --- a/lib/asn1/test/asn1_SUITE_data/test_records.erl +++ b/lib/asn1/test/asn1_SUITE_data/test_records.erl @@ -25,7 +25,7 @@ -define(line,put(test_server_loc,{?MODULE,?LINE}),). --include("NBAP-PDU-Discriptions.hrl"). +-include("NBAP-PDU-Descriptions.hrl"). -include("NBAP-PDU-Contents.hrl"). -include("NBAP-Containers.hrl"). -include("NBAP-CommonDataTypes.hrl"). diff --git a/lib/asn1/test/asn1_test_lib.erl b/lib/asn1/test/asn1_test_lib.erl index dc614db4f2..a79958d229 100644 --- a/lib/asn1/test/asn1_test_lib.erl +++ b/lib/asn1/test/asn1_test_lib.erl @@ -25,7 +25,8 @@ hex_to_bin/1, match_value/2, parallel/0, - roundtrip/3,roundtrip/4,roundtrip_enc/3,roundtrip_enc/4]). + roundtrip/3,roundtrip/4,roundtrip_enc/3,roundtrip_enc/4, + map_roundtrip/3]). -include_lib("common_test/include/ct.hrl"). @@ -94,15 +95,58 @@ module(F0) -> list_to_atom(F). %% filename:join(CaseDir, F ++ ".beam"). -compile_file(File, Options) -> +compile_file(File, Options0) -> + Options = [warnings_as_errors|Options0], try - ok = asn1ct:compile(File, [warnings_as_errors|Options]) + ok = asn1ct:compile(File, Options), + ok = compile_maps(File, Options) catch _:Reason -> ct:print("Failed to compile ~s\n~p", [File,Reason]), error end. +compile_maps(File, Options) -> + unload_map_mod(File), + Incompat = [abs,compact_bit_string,legacy_bit_string, + legacy_erlang_types,maps,asn1_test_lib_no_maps], + case lists:any(fun(E) -> lists:member(E, Incompat) end, Options) of + true -> + ok; + false -> + compile_maps_1(File, Options) + end. + +compile_maps_1(File, Options) -> + ok = asn1ct:compile(File, [maps,no_ok_wrapper,noobj|Options]), + OutDir = proplists:get_value(outdir, Options), + Base0 = filename:rootname(filename:basename(File)), + Base = case filename:extension(Base0) of + ".set" -> + filename:rootname(Base0); + _ -> + Base0 + end, + ErlBase = Base ++ ".erl", + ErlFile = filename:join(OutDir, ErlBase), + {ok,Erl0} = file:read_file(ErlFile), + Erl = re:replace(Erl0, <<"-module\\('">>, "&maps_"), + MapsErlFile = filename:join(OutDir, "maps_" ++ ErlBase), + ok = file:write_file(MapsErlFile, Erl), + {ok,_} = compile:file(MapsErlFile, [report,{outdir,OutDir},{i,OutDir}]), + ok. + +unload_map_mod(File0) -> + File1 = filename:basename(File0), + File2 = filename:rootname(File1, ".asn"), + File3 = filename:rootname(File2, ".asn1"), + File4 = filename:rootname(File3, ".py"), + File = filename:rootname(File4, ".set"), + MapMod = list_to_atom("maps_"++File), + code:delete(MapMod), + code:purge(MapMod), + ok. + compile_erlang(Mod, Config, Options) -> DataDir = proplists:get_value(data_dir, Config), CaseDir = proplists:get_value(case_dir, Config), @@ -147,24 +191,60 @@ roundtrip(Mod, Type, Value) -> roundtrip(Mod, Type, Value, Value). roundtrip(Mod, Type, Value, ExpectedValue) -> - {ok,Encoded} = Mod:encode(Type, Value), - {ok,ExpectedValue} = Mod:decode(Type, Encoded), - test_ber_indefinite(Mod, Type, Encoded, ExpectedValue), - ok. + roundtrip_enc(Mod, Type, Value, ExpectedValue). roundtrip_enc(Mod, Type, Value) -> roundtrip_enc(Mod, Type, Value, Value). roundtrip_enc(Mod, Type, Value, ExpectedValue) -> - {ok,Encoded} = Mod:encode(Type, Value), - {ok,ExpectedValue} = Mod:decode(Type, Encoded), + case Mod:encode(Type, Value) of + {ok,Encoded} -> + {ok,ExpectedValue} = Mod:decode(Type, Encoded); + Encoded when is_binary(Encoded) -> + ExpectedValue = Mod:decode(Type, Encoded) + end, + map_roundtrip(Mod, Type, Encoded), test_ber_indefinite(Mod, Type, Encoded, ExpectedValue), Encoded. +map_roundtrip(Mod, Type, Encoded) -> + MapMod = list_to_atom("maps_"++atom_to_list(Mod)), + try MapMod:maps() of + true -> + map_roundtrip_1(MapMod, Type, Encoded) + catch + error:undef -> + ok + end. + %%% %%% Internal functions. %%% +map_roundtrip_1(Mod, Type, Encoded) -> + Decoded = Mod:decode(Type, Encoded), + case Mod:encode(Type, Decoded) of + Encoded -> + ok; + OtherEncoding -> + case is_named_bitstring(Decoded) of + true -> + %% In BER, named BIT STRINGs with different number of + %% trailing zeroes decode to the same value. + ok; + false -> + error({encode_mismatch,Decoded,Encoded,OtherEncoding}) + end + end, + ok. + +is_named_bitstring([H|T]) -> + is_atom(H) andalso is_named_bitstring(T); +is_named_bitstring([]) -> + true; +is_named_bitstring(_) -> + false. + hex2num(C) when $0 =< C, C =< $9 -> C - $0; hex2num(C) when $A =< C, C =< $F -> C - $A + 10; hex2num(C) when $a =< C, C =< $f -> C - $a + 10. @@ -179,7 +259,12 @@ test_ber_indefinite(Mod, Type, Encoded, ExpectedValue) -> case Mod:encoding_rule() of ber -> Indefinite = iolist_to_binary(ber_indefinite(Encoded)), - {ok,ExpectedValue} = Mod:decode(Type, Indefinite); + case Mod:decode(Type, Indefinite) of + {ok,ExpectedValue} -> + ok; + ExpectedValue -> + ok + end; _ -> ok end. diff --git a/lib/asn1/test/h323test.erl b/lib/asn1/test/h323test.erl index 935af0ba09..41a9159335 100644 --- a/lib/asn1/test/h323test.erl +++ b/lib/asn1/test/h323test.erl @@ -27,6 +27,8 @@ run(per) -> run(); run(_Rules) -> ok. run() -> + roundtrip('EndpointType', endpoint()), + roundtrip('Alerting-UUIE', alerting_uuie()), roundtrip('H323-UserInformation', alerting_val(), alerting_enc()), roundtrip('H323-UserInformation', connect_val(), connect_enc()), general_string(), @@ -36,18 +38,24 @@ alerting_val() -> {'H323-UserInformation', {'H323-UU-PDU', {alerting, - {'Alerting-UUIE', - {0,0,8,2250,0,2}, - {'EndpointType',asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE, - asn1_NOVALUE,asn1_NOVALUE, - {'TerminalInfo',asn1_NOVALUE}, - false,false}, - asn1_NOVALUE, - {'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}}, + alerting_uuie()}, asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE}, asn1_NOVALUE}. +endpoint() -> + {'EndpointType',asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE, + asn1_NOVALUE,asn1_NOVALUE, + {'TerminalInfo',asn1_NOVALUE}, + false,false}. + +alerting_uuie() -> + {'Alerting-UUIE', + {0,0,8,2250,0,2}, + endpoint(), + asn1_NOVALUE, + {'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}. + alerting_enc() -> "0380060008914a0002020120110000000000000000000000000000000000". @@ -82,6 +90,9 @@ general_string() -> UI = <<109,64,1,57>>, {ok, _V} = 'MULTIMEDIA-SYSTEM-CONTROL':decode(Type, UI). +roundtrip(T, V) -> + asn1_test_lib:roundtrip('H323-MESSAGES', T, V). + roundtrip(T, V, HexString) -> Enc = asn1_test_lib:hex_to_bin(HexString), Enc = asn1_test_lib:roundtrip_enc('H323-MESSAGES', T, V), diff --git a/lib/asn1/test/testContextSwitchingTypes.erl b/lib/asn1/test/testContextSwitchingTypes.erl index 10012908a9..5688d8afd6 100644 --- a/lib/asn1/test/testContextSwitchingTypes.erl +++ b/lib/asn1/test/testContextSwitchingTypes.erl @@ -90,5 +90,6 @@ check_object_identifier(Tuple) when is_tuple(Tuple) -> enc_dec(T, V0) -> M = 'ContextSwitchingTypes', {ok,Enc} = M:encode(T, V0), + asn1_test_lib:map_roundtrip(M, T, Enc), {ok,V} = M:decode(T, Enc), V. diff --git a/lib/asn1/test/testInfObj.erl b/lib/asn1/test/testInfObj.erl index 5a9f47d865..c519c70cdf 100644 --- a/lib/asn1/test/testInfObj.erl +++ b/lib/asn1/test/testInfObj.erl @@ -197,5 +197,6 @@ roundtrip(M, T, V) -> enc_dec(M, T, V0) -> {ok,Enc} = M:encode(T, V0), + asn1_test_lib:map_roundtrip(M, T, Enc), {ok,V} = M:decode(T, Enc), V. diff --git a/lib/asn1/test/testMaps.erl b/lib/asn1/test/testMaps.erl new file mode 100644 index 0000000000..45dd2255ba --- /dev/null +++ b/lib/asn1/test/testMaps.erl @@ -0,0 +1,50 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2017. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +%% +-module(testMaps). + +-export([main/1]). + +main(_) -> + M = 'Maps', + true = M:maps(), + + true = M:xy1() =:= #{x=>42,y=>17}, + true = M:xy2() =:= #{x=>0,y=>0}, + true = M:xy3() =:= #{x=>0,y=>999}, + true = M:s1() =:= #{xy=>#{x=>100,y=>100}}, + + roundtrip('XY', M:xy1()), + roundtrip('XY', M:xy2()), + roundtrip('XY', M:xy3()), + roundtrip('XY', #{}, #{x=>0,y=>0}), + + roundtrip('S', M:s1()), + roundtrip('S', #{}, #{xy=>#{x=>100,y=>100}}), + roundtrip('S', #{os=><<1,2,3>>}, #{xy=>#{x=>100,y=>100}, + os=><<1,2,3>>}), + + ok. + +roundtrip(Type, Value) -> + roundtrip(Type, Value, Value). + +roundtrip(Type, Value, Expected) -> + asn1_test_lib:roundtrip('Maps', Type, Value, Expected). diff --git a/lib/asn1/test/testMultipleLevels.erl b/lib/asn1/test/testMultipleLevels.erl index c610e59f3d..e9d83665aa 100644 --- a/lib/asn1/test/testMultipleLevels.erl +++ b/lib/asn1/test/testMultipleLevels.erl @@ -24,5 +24,7 @@ main(_) -> Data = {'Top',{short,"abc"},{long,"a long string follows here"}}, - {ok,B} = 'MultipleLevels':encode('Top', Data), - {ok,Data} = 'MultipleLevels':decode('Top', iolist_to_binary(B)). + roundtrip('Top', Data). + +roundtrip(T, V) -> + asn1_test_lib:roundtrip('MultipleLevels', T, V). diff --git a/lib/asn1/test/testNBAPsystem.erl b/lib/asn1/test/testNBAPsystem.erl index 1af283af42..8d61ca18ce 100644 --- a/lib/asn1/test/testNBAPsystem.erl +++ b/lib/asn1/test/testNBAPsystem.erl @@ -84,7 +84,7 @@ compile(Config, Options) -> M <- ["NBAP-CommonDataTypes.asn", "NBAP-IEs.asn", "NBAP-PDU-Contents.asn", - "NBAP-PDU-Discriptions.asn", + "NBAP-PDU-Descriptions.asn", "NBAP-Constants.asn", "NBAP-Containers.asn"]], asn1_test_lib:compile_all(Fs, Config, Options), @@ -98,16 +98,16 @@ test(_Erule,Config) -> ticket_5812(Config) -> Msg = v_5812(), - {ok,B2} = 'NBAP-PDU-Discriptions':encode('NBAP-PDU', Msg), + {ok,B2} = 'NBAP-PDU-Descriptions':encode('NBAP-PDU', Msg), V = <<0,28,74,0,3,48,0,0,1,0,123,64,41,0,0,0,126,64,35,95,208,2,89,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,145,0,1,205,0,0,0,0,2,98,64,1,128>>, ok = compare(V,B2), - {ok,Msg2} = 'NBAP-PDU-Discriptions':decode('NBAP-PDU', B2), + {ok,Msg2} = 'NBAP-PDU-Descriptions':decode('NBAP-PDU', B2), ok = check_record_names(Msg2,Config). enc_audit_req_msg() -> Msg = {initiatingMessage, audit_req_msg()}, - {ok,B} = 'NBAP-PDU-Discriptions':encode('NBAP-PDU', Msg), - {ok,_Msg} = 'NBAP-PDU-Discriptions':decode('NBAP-PDU', B), + {ok,B} = 'NBAP-PDU-Descriptions':encode('NBAP-PDU', Msg), + {ok,_Msg} = 'NBAP-PDU-Descriptions':decode('NBAP-PDU', B), {initiatingMessage, #'InitiatingMessage'{value=#'AuditRequest'{protocolIEs=[{_,114,ignore,_}], protocolExtensions = asn1_NOVALUE}}} = _Msg, @@ -116,8 +116,8 @@ enc_audit_req_msg() -> cell_setup_req_msg_test() -> Msg = {initiatingMessage, cell_setup_req_msg()}, - {ok,B} = 'NBAP-PDU-Discriptions':encode('NBAP-PDU', Msg), - {ok,_Msg} = 'NBAP-PDU-Discriptions':decode('NBAP-PDU', B), + {ok,B} = 'NBAP-PDU-Descriptions':encode('NBAP-PDU', Msg), + {ok,_Msg} = 'NBAP-PDU-Descriptions':decode('NBAP-PDU', B), io:format("Msg: ~P~n~n_Msg: ~P~n",[Msg,15,_Msg,15]), ok. diff --git a/lib/asn1/test/testRfcs.erl b/lib/asn1/test/testRfcs.erl index da7333ef98..20176e35eb 100644 --- a/lib/asn1/test/testRfcs.erl +++ b/lib/asn1/test/testRfcs.erl @@ -35,22 +35,27 @@ compile(Config, Erules, Options0) -> asn1_test_lib:compile_all(Specs, Config, [Erules,{i,CaseDir}|Options]). test() -> - {1,3,6,1,5,5,7,48,1,2} = - IdPkixOcspNonce = - 'OCSP-2009':'id-pkix-ocsp-nonce'(), - roundtrip('OCSP-2009', 'OCSPRequest', - {'OCSPRequest', - {'TBSRequest', - 0, - {rfc822Name,"name string"}, - [{'Request', - {'CertID',{'_',{2,9,3,4,5},asn1_NOVALUE}, - <<"POTATOHASH">>,<<"HASHBROWN">>,42}, - [{'_',IdPkixOcspNonce,true,<<34,159,16,57,199>>}]}], - asn1_NOVALUE}, - asn1_NOVALUE}), - otp_7759(), - ok. + M = 'OCSP-2009', + case M:maps() of + false -> + {1,3,6,1,5,5,7,48,1,2} = + IdPkixOcspNonce = + 'OCSP-2009':'id-pkix-ocsp-nonce'(), + roundtrip('OCSP-2009', 'OCSPRequest', + {'OCSPRequest', + {'TBSRequest', + 0, + {rfc822Name,"name string"}, + [{'Request', + {'CertID',{'_',{2,9,3,4,5},asn1_NOVALUE}, + <<"POTATOHASH">>,<<"HASHBROWN">>,42}, + [{'_',IdPkixOcspNonce,true,<<34,159,16,57,199>>}]}], + asn1_NOVALUE}, + asn1_NOVALUE}), + otp_7759(records); + true -> + otp_7759(maps) + end. roundtrip(Module, Type, Value0) -> Enc = Module:encode(Type, Value0), @@ -58,7 +63,7 @@ roundtrip(Module, Type, Value0) -> asn1_test_lib:match_value(Value0, Value1), ok. -otp_7759() -> +otp_7759(Pack) -> %% The release note for asn-1.6.6 says: %% Decode of an open_type when the value was empty tagged %% type encoded with indefinite length failed. @@ -66,10 +71,15 @@ otp_7759() -> Encoded = encoded_msg(), ContentInfo = Mod:decode('ContentInfo', Encoded), io:format("~p\n", [ContentInfo]), - {'ContentInfo',_Id,PKCS7_content} = ContentInfo, - X = Mod:decode('SignedData', PKCS7_content), + Content = case ContentInfo of + {'ContentInfo',_Id,Content0} when Pack =:= records -> + Content0; + #{'content-type':=_,'pkcs7-content':=Content0} + when Pack =:= maps -> + Content0 + end, + X = Mod:decode('SignedData', Content), io:format("~p\n", [X]), - io:nl(), ok. encoded_msg() -> diff --git a/lib/asn1/test/testSeqExtension.erl b/lib/asn1/test/testSeqExtension.erl index f7885cb002..be1d1c2490 100644 --- a/lib/asn1/test/testSeqExtension.erl +++ b/lib/asn1/test/testSeqExtension.erl @@ -31,6 +31,7 @@ -record('SeqExt4',{bool, int}). -record('SeqExt5',{name, shoesize}). -record('SeqExt6',{i1,i2,i3,i4,i5,i6,i7}). +-record('SeqExt7',{a=asn1_NOVALUE,b=asn1_NOVALUE,c}). -record('SuperSeq',{s1,s2,s3,s4,s5,s6,i}). main(Erule, DataDir, Opts) -> @@ -45,8 +46,35 @@ main(Erule, DataDir, Opts) -> roundtrip('SeqExt4', #'SeqExt4'{bool=true,int=12345}), roundtrip('SeqExt4', #'SeqExt4'{bool=false,int=123456}), + case Erule of + ber -> + %% BER currently does not handle Extension Addition Groups + %% correctly. + ok; + _ -> + v_roundtrip3('SeqExt5', #'SeqExt5'{name=asn1_NOVALUE, + shoesize=asn1_NOVALUE}, + Erule, #{per=>"00", + uper=>"00"}), + v_roundtrip3('SeqExt7', #'SeqExt7'{c=asn1_NOVALUE}, + Erule, #{per=>"00", + uper=>"00"}) + end, roundtrip('SeqExt5', #'SeqExt5'{name = <<"Arne">>,shoesize=47}), + v_roundtrip3('SeqExt7', #'SeqExt7'{c=false}, + Erule, #{per=>"80800100", + uper=>"80808000"}), + v_roundtrip3('SeqExt7', #'SeqExt7'{c=true}, + Erule, #{per=>"80800120", + uper=>"80809000"}), + v_roundtrip3('SeqExt7', #'SeqExt7'{a=777,b = <<16#AA>>,c=false}, + Erule, #{per=>"808006C0 030901AA 00", + uper=>"8082E061 20354000"}), + v_roundtrip3('SeqExt7', #'SeqExt7'{a=8888,c=false}, + Erule, #{per=>"80800480 22B800", + uper=>"8081C457 0000"}), + %% Encode a value with this version of the specification. BigInt = 128638468966, SuperSeq = #'SuperSeq'{s1=#'SeqExt1'{}, @@ -106,6 +134,7 @@ main(Erule, DataDir, Opts) -> v_roundtrip2(Erule, 'SeqExt130', list_to_tuple(['SeqExt130'| lists:duplicate(129, asn1_NOVALUE)++[199]])), + ok. roundtrip(Type, Value) -> @@ -118,6 +147,15 @@ v_roundtrip2(Erule, Type, Value) -> roundtrip2(Type, Value) -> asn1_test_lib:roundtrip_enc('SeqExtension2', Type, Value). +v_roundtrip3(Type, Value, Erule, Map) -> + case maps:find(Erule, Map) of + {ok,Hex} -> + Encoded = asn1_test_lib:hex_to_bin(Hex), + Encoded = asn1_test_lib:roundtrip_enc('SeqExtension', Type, Value); + error -> + asn1_test_lib:roundtrip('SeqExtension', Type, Value) + end. + v(ber, 'SeqExt66') -> "30049F41 017D"; v(per, 'SeqExt66') -> "C0420000 00000000 00004001 FA"; v(uper, 'SeqExt66') -> "D0800000 00000000 00101FA0"; diff --git a/lib/asn1/test/testTCAP.erl b/lib/asn1/test/testTCAP.erl index 422ae1f0fc..a6f0f9fad7 100644 --- a/lib/asn1/test/testTCAP.erl +++ b/lib/asn1/test/testTCAP.erl @@ -92,5 +92,6 @@ test_asn1config() -> enc_dec(T, V0) -> M = 'TCAPPackage', {ok,Enc} = M:encode(T, V0), + asn1_test_lib:map_roundtrip(M, T, Enc), {ok,V} = M:decode(T, Enc), V. diff --git a/lib/asn1/test/testTimer.erl b/lib/asn1/test/testTimer.erl index bd8da85735..3edeb1b712 100644 --- a/lib/asn1/test/testTimer.erl +++ b/lib/asn1/test/testTimer.erl @@ -25,7 +25,42 @@ -define(times, 5000). -val() -> +go() -> + Module = 'H323-MESSAGES', + Type = 'H323-UserInformation', + Value = case Module:maps() of + false -> val_records(); + true -> val_maps() + end, + Bytes = Module:encode(Type, Value), + Value = Module:decode(Type, Bytes), + + {ValWr,done} = timer:tc(fun() -> encode(?times, Module, Type, Value) end), + 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), + io:format("ASN.1 decoding: ~p micro~n", [ValRead /?times]), + + 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) -> + Module:encode(Type, Value), + encode(N-1, Module, Type, Value). + +decode(0, _Module, _Type, _Value) -> + done; +decode(N, Module, Type, Value) -> + Module:decode(Type, Value), + decode(N-1, Module, Type, Value). + +val_records() -> {'H323-UserInformation',{'H323-UU-PDU', {callProceeding, {'CallProceeding-UUIE', @@ -126,34 +161,66 @@ val() -> {'H323-UserInformation_user-data',24,<<"O">>}}. -go() -> - Module = 'H323-MESSAGES', - Type = 'H323-UserInformation', - Value = val(), - Bytes = Module:encode(Type, Value), - Value = Module:decode(Type, Bytes), - - {ValWr,done} = timer:tc(fun() -> encode(?times, Module, Type, Value) end), - 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), - io:format("ASN.1 decoding: ~p micro~n", [ValRead /?times]), - - 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) -> - Module:encode(Type, Value), - encode(N-1, Module, Type, Value). - -decode(0, _Module, _Type, _Value) -> - done; -decode(N, Module, Type, Value) -> - Module:decode(Type, Value), - decode(N-1, Module, Type, Value). +val_maps() -> +#{'h323-uu-pdu' => #{h245Control => [], + h245Tunneling => true, + 'h323-message-body' => {callProceeding,#{callIdentifier => #{guid => <<"OCTET STRINGOCTE">>}, + cryptoTokens => [{cryptoGKPwdEncr,#{algorithmOID => {1,18,467,467}, + encryptedData => <<"OC">>, + paramS => #{iv8 => <<"OCTET ST">>, + ranInt => -7477016}}}, + {cryptoGKPwdEncr,#{algorithmOID => {1,19,486,486}, + encryptedData => <<>>, + paramS => #{iv8 => <<"OCTET ST">>, + ranInt => -2404513}}}], + destinationInfo => #{gatekeeper => #{nonStandardData => #{data => <<"O">>, + nonStandardIdentifier => {object,{0,10,260}}}}, + gateway => #{nonStandardData => #{data => <<"O">>, + nonStandardIdentifier => {object,{0,13,326}}}, + protocol => [{h320,#{dataRatesSupported => [#{channelMultiplier => 78, + channelRate => 1290470518, + nonStandardData => #{data => <<"O">>, + nonStandardIdentifier => {object,{0,11,295}}}}], + nonStandardData => #{data => <<"O">>, + nonStandardIdentifier => {object,{0,11,282}}}, + supportedPrefixes => [#{nonStandardData => #{data => <<"O">>, + nonStandardIdentifier => {object,{0,12,312}}}, + prefix => {'h323-ID',"BM"}}]}}]}, + mc => true, + mcu => #{nonStandardData => #{data => <<"OC">>, + nonStandardIdentifier => {object,{1,13,340,340}}}}, + nonStandardData => #{data => <<"O">>,nonStandardIdentifier => {object,{0,9,237}}}, + terminal => #{nonStandardData => #{data => <<"OC">>, + nonStandardIdentifier => {object,{1,14,353,354}}}}, + undefinedNode => true, + vendor => #{productId => <<"OC">>, + vendor => #{manufacturerCode => 16282, + t35CountryCode => 62, + t35Extension => 63}, + versionId => <<"OC">>}}, + fastStart => [], + h245Address => {ipxAddress,#{netnum => <<"OCTE">>, + node => <<"OCTET ">>, + port => <<"OC">>}}, + h245SecurityMode => {noSecurity,'NULL'}, + protocolIdentifier => {0,8,222}, + tokens => [#{certificate => #{certificate => <<"OC">>,type => {1,16,405,406}}, + challenge => <<"OCTET STR">>, + dhkey => #{generator => <<1:1>>,halfkey => <<1:1>>,modSize => <<1:1>>}, + generalID => "BMP", + nonStandard => #{data => <<"OC">>,nonStandardIdentifier => {1,16,414,415}}, + password => "BM", + random => -26430296, + timeStamp => 1667517741}, + #{certificate => #{certificate => <<"OC">>,type => {1,17,442,443}}, + challenge => <<"OCTET STRI">>, + dhkey => #{generator => <<1:1>>,halfkey => <<1:1>>,modSize => <<1:1>>}, + generalID => "BMP", + nonStandard => #{data => <<"OC">>,nonStandardIdentifier => {1,18,452,452}}, + password => "BMP", + random => -16356110, + timeStamp => 1817656756}]}}, + h4501SupplementaryService => [], + nonStandardControl => [], + nonStandardData => #{data => <<>>,nonStandardIdentifier => {object,{0,3,84}}}}, + 'user-data' => #{'protocol-discriminator' => 24,'user-information' => <<"O">>}}. diff --git a/lib/asn1/test/testUniqueObjectSets.erl b/lib/asn1/test/testUniqueObjectSets.erl index 4d3ec94391..30cbceb577 100644 --- a/lib/asn1/test/testUniqueObjectSets.erl +++ b/lib/asn1/test/testUniqueObjectSets.erl @@ -27,6 +27,7 @@ seq_roundtrip(I, D0) -> M = 'UniqueObjectSets', try {ok,Enc} = M:encode('Seq', {'Seq',I,D0}), + asn1_test_lib:map_roundtrip(M, 'Seq', Enc), {ok,{'Seq',I,D}} = M:decode('Seq', Enc), D catch C:E -> diff --git a/lib/asn1/test/test_compile_options.erl b/lib/asn1/test/test_compile_options.erl index ac74470537..c15e61550c 100644 --- a/lib/asn1/test/test_compile_options.erl +++ b/lib/asn1/test/test_compile_options.erl @@ -24,8 +24,8 @@ -include_lib("common_test/include/ct.hrl"). --export([wrong_path/1,comp/2,path/1,ticket_6143/1,noobj/1, - record_name_prefix/1,verbose/1]). +-export([wrong_path/1,comp/2,path/1,noobj/1, + record_name_prefix/1,verbose/1,maps/1]). %% OTP-5689 wrong_path(Config) -> @@ -64,8 +64,6 @@ path(Config) -> file:set_cwd(CWD), ok. -ticket_6143(Config) -> asn1_test_lib:compile("AA1", Config, []). - noobj(Config) -> DataDir = proplists:get_value(data_dir,Config), OutDir = proplists:get_value(priv_dir,Config), @@ -130,6 +128,28 @@ verbose(Config) when is_list(Config) -> [] = test_server:capture_get(), ok. +maps(Config) -> + DataDir = proplists:get_value(data_dir, Config), + OutDir = proplists:get_value(case_dir, Config), + InFile = filename:join(DataDir, "P-Record"), + + do_maps(ber, InFile, OutDir), + do_maps(per, InFile, OutDir), + do_maps(uper, InFile, OutDir). + +do_maps(Erule, InFile, OutDir) -> + Opts = [Erule,maps,{outdir,OutDir}], + ok = asn1ct:compile(InFile, Opts), + + %% Make sure that no .hrl files are generated. + [] = filelib:wildcard(filename:join(OutDir, "*.hrl")), + + %% Remove all generated files. + All = filelib:wildcard(filename:join(OutDir, "*")), + _ = [file:delete(N) || N <- All], + + ok. + outfiles_check(OutDir) -> outfiles_check(OutDir,outfiles1()). diff --git a/lib/dialyzer/test/plt_SUITE.erl b/lib/dialyzer/test/plt_SUITE.erl index 460d4e2240..fbfa979e1b 100644 --- a/lib/dialyzer/test/plt_SUITE.erl +++ b/lib/dialyzer/test/plt_SUITE.erl @@ -26,6 +26,8 @@ build_plt(Config) -> end. beam_tests(Config) when is_list(Config) -> + PrivDir = ?config(priv_dir, Config), + Plt = filename:join(PrivDir, "beam_tests.plt"), Prog = <<" -module(no_auto_import). @@ -42,10 +44,12 @@ beam_tests(Config) when is_list(Config) -> ">>, Opts = [no_auto_import], {ok, BeamFile} = compile(Config, Prog, no_auto_import, Opts), - [] = run_dialyzer(plt_build, [BeamFile], []), + [] = run_dialyzer(plt_build, [BeamFile], [{output_plt, Plt}]), ok. run_plt_check(Config) when is_list(Config) -> + PrivDir = ?config(priv_dir, Config), + Plt = filename:join(PrivDir, "run_plt_check.plt"), Mod1 = <<" -module(run_plt_check1). ">>, @@ -56,7 +60,7 @@ run_plt_check(Config) when is_list(Config) -> {ok, BeamFile1} = compile(Config, Mod1, run_plt_check1, []), {ok, BeamFile2} = compile(Config, Mod2A, run_plt_check2, []), - [] = run_dialyzer(plt_build, [BeamFile1, BeamFile2], []), + [] = run_dialyzer(plt_build, [BeamFile1, BeamFile2], [{output_plt, Plt}]), Mod2B = <<" -module(run_plt_check2). @@ -70,11 +74,13 @@ run_plt_check(Config) when is_list(Config) -> % callgraph warning as run_plt_check2:call/1 makes a call to unexported % function run_plt_check1:call/1. - [_] = run_dialyzer(plt_check, [], []), + [_] = run_dialyzer(plt_check, [], [{init_plt, Plt}]), ok. run_succ_typings(Config) when is_list(Config) -> + PrivDir = ?config(priv_dir, Config), + Plt = filename:join(PrivDir, "run_succ_typings.plt"), Mod1A = <<" -module(run_succ_typings1). @@ -84,7 +90,7 @@ run_succ_typings(Config) when is_list(Config) -> ">>, {ok, BeamFile1} = compile(Config, Mod1A, run_succ_typings1, []), - [] = run_dialyzer(plt_build, [BeamFile1], []), + [] = run_dialyzer(plt_build, [BeamFile1], [{output_plt, Plt}]), Mod1B = <<" -module(run_succ_typings1). @@ -107,9 +113,11 @@ run_succ_typings(Config) when is_list(Config) -> {ok, BeamFile2} = compile(Config, Mod2, run_succ_typings2, []), % contract types warning as run_succ_typings2:call/0 makes a call to % run_succ_typings1:call/0, which returns a (not b) in the PLT. - [_] = run_dialyzer(succ_typings, [BeamFile2], [{check_plt, false}]), + [_] = run_dialyzer(succ_typings, [BeamFile2], + [{check_plt, false}, {init_plt, Plt}]), % warning not returned as run_succ_typings1 is updated in the PLT. - [] = run_dialyzer(succ_typings, [BeamFile2], [{check_plt, true}]), + [] = run_dialyzer(succ_typings, [BeamFile2], + [{check_plt, true}, {init_plt, Plt}]), ok. @@ -252,12 +260,9 @@ remove_plt(Config) -> ok. bad_dialyzer_attr(Config) -> - PrivDir = ?config(priv_dir, Config), - Prog1 = <<"-module(dial). -dialyzer({no_return, [undef/0]}).">>, {ok, Beam1} = compile(Config, Prog1, dial, []), - Plt = filename:join(PrivDir, "bad_attr.plt"), {dialyzer_error, "Analysis failed with error:\n" "Could not scan the following file(s):\n" diff --git a/lib/hipe/main/hipe.erl b/lib/hipe/main/hipe.erl index 90ef84ca51..06facae5c1 100644 --- a/lib/hipe/main/hipe.erl +++ b/lib/hipe/main/hipe.erl @@ -441,7 +441,7 @@ compile(Name, File, Opts0) when is_atom(Name) -> ?error_msg("Cannot get Core Erlang code from BEAM binary.",[]), ?EXIT({cant_compile_core_from_binary}); true -> - case filename:find_src(filename:rootname(File, ".beam")) of + case filelib:find_source(filename:rootname(File,".beam") ++ ".beam") of {error, _} -> ?error_msg("Cannot find source code for ~p.", [File]), ?EXIT({cant_find_source_code}); diff --git a/lib/inets/doc/src/notes.xml b/lib/inets/doc/src/notes.xml index 398fc7e5b6..5c3b5a2d3c 100644 --- a/lib/inets/doc/src/notes.xml +++ b/lib/inets/doc/src/notes.xml @@ -33,7 +33,22 @@ <file>notes.xml</file> </header> - <section><title>Inets 6.3.4</title> + <section><title>Inets 6.3.5</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Correct misstakes in ftp client introduced in inets-6.3.4</p> + <p> + Own Id: OTP-14203 Aux Id: OTP-13982 </p> + </item> + </list> + </section> + +</section> + +<section><title>Inets 6.3.4</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/inets/src/ftp/ftp.erl b/lib/inets/src/ftp/ftp.erl index 911f5b71a7..23d6483291 100644 --- a/lib/inets/src/ftp/ftp.erl +++ b/lib/inets/src/ftp/ftp.erl @@ -1477,10 +1477,7 @@ handle_info({Trpt, Socket, Data}, #state{dsock = {Trpt,Socket}} = State0) when T handle_info({Cls, Socket}, #state{dsock = {Trpt,Socket}, caller = {recv_file, Fd}} = State) when {Cls,Trpt}=={tcp_closed,tcp} ; {Cls,Trpt}=={ssl_closed,ssl} -> - case file_close(Fd) of - ok -> ok; - {error,einval} -> ok - end, + file_close(Fd), progress_report({transfer_size, 0}, State), activate_ctrl_connection(State), {noreply, State#state{dsock = undefined, data = <<>>}}; @@ -2066,10 +2063,7 @@ handle_ctrl_result({pos_prel, _}, #state{caller = {recv_file, _}} = State0) -> end; handle_ctrl_result({Status, _}, #state{caller = {recv_file, Fd}} = State) -> - case file_close(Fd) of - ok -> ok; - {error, einval} -> ok - end, + file_close(Fd), close_data_connection(State), ctrl_result_response(Status, State#state{dsock = undefined}, {error, epath}); @@ -2345,7 +2339,7 @@ accept_data_connection(#state{mode = passive} = State) -> send_ctrl_message(_S=#state{csock = Socket, verbose = Verbose}, Message) -> verbose(lists:flatten(Message),Verbose,send), ?DBG('<--ctrl ~p ---- ~s~p~n',[Socket,Message,_S]), - ok = send_message(Socket, Message). + _ = send_message(Socket, Message). send_data_message(_S=#state{dsock = Socket}, Message) -> ?DBG('<==data ~p ==== ~s~n~p~n',[Socket,Message,_S]), @@ -2366,37 +2360,44 @@ send_message({tcp, Socket}, Message) -> send_message({ssl, Socket}, Message) -> ssl:send(Socket, Message). -activate_ctrl_connection(#state{csock = Socket, ctrl_data = {<<>>, _, _}}) -> - ok = activate_connection(Socket); -activate_ctrl_connection(#state{csock = Socket}) -> - ok = activate_connection(Socket), +activate_ctrl_connection(#state{csock = CSock, ctrl_data = {<<>>, _, _}}) -> + activate_connection(CSock); +activate_ctrl_connection(#state{csock = CSock}) -> + activate_connection(CSock), %% We have already received at least part of the next control message, %% that has been saved in ctrl_data, process this first. - self() ! {socket_type(Socket), unwrap_socket(Socket), <<>>}, + self() ! {socket_type(CSock), unwrap_socket(CSock), <<>>}, ok. +activate_data_connection(#state{dsock = DSock} = State) -> + activate_connection(DSock), + State. + +activate_connection(Socket) -> + ignore_return_value( + case socket_type(Socket) of + tcp -> inet:setopts(unwrap_socket(Socket), [{active, once}]); + ssl -> ssl:setopts(unwrap_socket(Socket), [{active, once}]) + end). + + +ignore_return_value(_) -> ok. + unwrap_socket({tcp,Socket}) -> Socket; unwrap_socket({ssl,Socket}) -> Socket. socket_type({tcp,_Socket}) -> tcp; socket_type({ssl,_Socket}) -> ssl. -activate_data_connection(#state{dsock = Socket} = State) -> - ok = activate_connection(Socket), - State. - -activate_connection({tcp, Socket}) -> inet:setopts(Socket, [{active, once}]); -activate_connection({ssl, Socket}) -> ssl:setopts(Socket, [{active, once}]). - close_ctrl_connection(#state{csock = undefined}) -> ok; close_ctrl_connection(#state{csock = Socket}) -> close_connection(Socket). close_data_connection(#state{dsock = undefined}) -> ok; close_data_connection(#state{dsock = Socket}) -> close_connection(Socket). -close_connection({lsock,Socket}) -> gen_tcp:close(Socket); -close_connection({tcp, Socket}) -> gen_tcp:close(Socket); -close_connection({ssl, Socket}) -> ssl:close(Socket). +close_connection({lsock,Socket}) -> ignore_return_value( gen_tcp:close(Socket) ); +close_connection({tcp, Socket}) -> ignore_return_value( gen_tcp:close(Socket) ); +close_connection({ssl, Socket}) -> ignore_return_value( ssl:close(Socket) ). %% ------------ FILE HANDLING ---------------------------------------- send_file(#state{tls_upgrading_data_connection = {true, CTRL, _}} = State, Fd) -> @@ -2408,7 +2409,7 @@ send_file(State, Fd) -> progress_report({binary, Bin}, State), send_file(State, Fd); {ok, _, _} -> - ok = file_close(Fd), + file_close(Fd), close_data_connection(State), progress_report({transfer_size, 0}, State), activate_ctrl_connection(State), @@ -2423,7 +2424,7 @@ file_open(File, Option) -> file:open(File, [raw, binary, Option]). file_close(Fd) -> - file:close(Fd). + ignore_return_value( file:close(Fd) ). file_read(Fd) -> case file:read(Fd, ?FILE_BUFSIZE) of diff --git a/lib/inets/vsn.mk b/lib/inets/vsn.mk index eef5abd610..9591ab22ed 100644 --- a/lib/inets/vsn.mk +++ b/lib/inets/vsn.mk @@ -19,6 +19,6 @@ # %CopyrightEnd% APPLICATION = inets -INETS_VSN = 6.3.4 +INETS_VSN = 6.3.5 PRE_VSN = APP_VSN = "$(APPLICATION)-$(INETS_VSN)$(PRE_VSN)" diff --git a/lib/kernel/doc/src/kernel_app.xml b/lib/kernel/doc/src/kernel_app.xml index c581fa9d1e..b342fff0d3 100644 --- a/lib/kernel/doc/src/kernel_app.xml +++ b/lib/kernel/doc/src/kernel_app.xml @@ -433,6 +433,28 @@ MaxT = TickTime + TickTime / 4</code> return as soon as possible for <c>application_controller</c> to terminate properly.</p> </item> + <tag><c>source_search_rules = [DirRule] | [SuffixRule] </c></tag> + <item> + <marker id="source_search_rules"></marker> + <p>Where:</p> + <list type="bulleted"> + <item><c>DirRule = {ObjDirSuffix,SrcDirSuffix}</c></item> + <item><c>SuffixRule = {ObjSuffix,SrcSuffix,[DirRule]}</c></item> + <item><c>ObjDirSuffix = string()</c></item> + <item><c>SrcDirSuffix = string()</c></item> + <item><c>ObjSuffix = string()</c></item> + <item><c>SrcSuffix = string()</c></item> + </list> + <p>Specifies a list of rules for use by <c>filelib:find_file/2</c> and + <c>filelib:find_source/2</c>. If this is set to some other value + than the empty list, it replaces the default rules. Rules can be + simple pairs of directory suffixes, such as <c>{"ebin", + "src"}</c>, which are used by <c>filelib:find_file/2</c>, or + triples specifying separate directory suffix rules depending on + file name extensions, for example <c>[{".beam", ".erl", [{"ebin", + "src"}]}</c>, which are used by <c>filelib:find_source/2</c>. Both + kinds of rules can be mixed in the list.</p> + </item> </taglist> </section> diff --git a/lib/observer/src/cdv_bin_cb.erl b/lib/observer/src/cdv_bin_cb.erl index 0cea1fdcf0..200c728a62 100644 --- a/lib/observer/src/cdv_bin_cb.erl +++ b/lib/observer/src/cdv_bin_cb.erl @@ -58,7 +58,7 @@ binary_to_term_fun(Bin) -> try binary_to_term(Bin) of Term -> plain_html(io_lib:format("~p",[Term])) catch error:badarg -> - Warning = "This binary can not be coverted to an Erlang term", + Warning = "This binary can not be converted to an Erlang term", observer_html_lib:warning(Warning) end end. diff --git a/lib/sasl/doc/src/systools.xml b/lib/sasl/doc/src/systools.xml index fa503fa573..4ca4a08329 100644 --- a/lib/sasl/doc/src/systools.xml +++ b/lib/sasl/doc/src/systools.xml @@ -268,7 +268,7 @@ <fsummary>Creates a release package.</fsummary> <type> <v>Name = string()</v> - <v>Opt = {dirs,[IncDir]} | {path,[Dir]} | {variables,[Var]} | {var_tar,VarTar} | {erts,Dir} | src_tests | exref | {exref,[App]} | silent | {outdir,Dir}</v> + <v>Opt = {dirs,[IncDir]} | {path,[Dir]} | {variables,[Var]} | {var_tar,VarTar} | {erts,Dir} | src_tests | exref | {exref,[App]} | silent | {outdir,Dir} | | no_warn_sasl | warnings_as_errors</v> <v> Dir = string()</v> <v> IncDir = src | include | atom()</v> <v> Var = {VarName,PreFix}</v> @@ -297,6 +297,10 @@ directory unless <c>Name</c> contains a path. If option <c>{outdir,Dir}</c> is specified, it is located in <c>Dir</c> instead.</p> + <p>If SASL is not included as an application in + the <c>.rel</c> file, a warning is issued because such a + release cannot be used in an upgrade. To turn off this + warning, add option <c>no_warn_sasl</c>.</p> <p>By default, the release package contains the directories <c>lib/App-Vsn/ebin</c> and <c>lib/App-Vsn/priv</c> for each included application. If more directories are to be included, diff --git a/lib/sasl/src/systools_make.erl b/lib/sasl/src/systools_make.erl index 6a16c8689e..587bd02cb2 100644 --- a/lib/sasl/src/systools_make.erl +++ b/lib/sasl/src/systools_make.erl @@ -94,7 +94,11 @@ make_script(RelName, Output, Flags) when is_list(RelName), Warnings = wsasl(Flags, Warnings0), case systools_lib:werror(Flags, Warnings) of true -> - return(ok,Warnings,Flags); + Warnings1 = [W || {warning,W}<-Warnings], + return({error,?MODULE, + {warnings_treated_as_errors,Warnings1}}, + Warnings, + Flags); false -> case generate_script(Output,Release,Appls,Flags) of ok -> @@ -115,7 +119,6 @@ make_script(RelName, _Output, Flags) when is_list(Flags) -> make_script(RelName, _Output, Flags) -> badarg(Flags,[RelName, Flags]). - wsasl(Options, Warnings) -> case lists:member(no_warn_sasl,Options) of true -> lists:delete({warning,missing_sasl},Warnings); @@ -148,21 +151,10 @@ get_outdir(Flags) -> return(ok,Warnings,Flags) -> case member(silent,Flags) of true -> - case systools_lib:werror(Flags, Warnings) of - true -> - error; - false -> - {ok,?MODULE,Warnings} - end; + {ok,?MODULE,Warnings}; _ -> - case member(warnings_as_errors,Flags) of - true -> - io:format("~ts",[format_warning(Warnings, true)]), - error; - false -> - io:format("~ts",[format_warning(Warnings)]), - ok - end + io:format("~ts",[format_warning(Warnings)]), + ok end; return({error,Mod,Error},_,Flags) -> case member(silent,Flags) of @@ -300,6 +292,8 @@ add_apply_upgrade(Script,Args) -> %% {variables,[{Name,AbsString}]} %% {machine, jam | beam | vee} %% {var_tar, include | ownfile | omit} +%% no_warn_sasl +%% warnings_as_errors %% %% The tar file contains: %% lib/App-Vsn/ebin @@ -332,13 +326,23 @@ make_tar(RelName, Flags) when is_list(RelName), is_list(Flags) -> Path = make_set(Path1 ++ code:get_path()), ModTestP = {member(src_tests, Flags),xref_p(Flags)}, case get_release(RelName, Path, ModTestP, machine(Flags)) of - {ok, Release, Appls, Warnings} -> - case catch mk_tar(RelName, Release, Appls, Flags, Path1) of - ok -> - return(ok,Warnings,Flags); - Error -> - return(Error,Warnings,Flags) - end; + {ok, Release, Appls, Warnings0} -> + Warnings = wsasl(Flags, Warnings0), + case systools_lib:werror(Flags, Warnings) of + true -> + Warnings1 = [W || {warning,W}<-Warnings], + return({error,?MODULE, + {warnings_treated_as_errors,Warnings1}}, + Warnings, + Flags); + false -> + case catch mk_tar(RelName, Release, Appls, Flags, Path1) of + ok -> + return(ok,Warnings,Flags); + Error -> + return(Error,Warnings,Flags) + end + end; Error -> return(Error,[],Flags) end; @@ -2113,90 +2117,80 @@ cas([Y | Args], X) -> %% Check Options for make_tar check_args_tar(Args) -> - cat(Args, {undef, undef, undef, undef, undef, undef, undef, undef, undef, undef, []}). + cat(Args, []). -cat([], {_Path,_Sil,_Dirs,_Erts,_Test,_Var,_VarTar,_Mach,_Xref,_XrefApps, X}) -> +cat([], X) -> X; %%% path --------------------------------------------------------------- -cat([{path, P} | Args], {Path, Sil, Dirs, Erts, Test, - Var, VarTar, Mach, Xref, XrefApps, X}) when is_list(P) -> +cat([{path, P} | Args], X) when is_list(P) -> case check_path(P) of ok -> - cat(Args, {P, Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X}); + cat(Args, X); error -> - cat(Args, {Path, Sil, Dirs, Erts, Test, - Var, VarTar, Mach, Xref, XrefApps, X++[{path,P}]}) + cat(Args, X++[{path,P}]) end; %%% silent ------------------------------------------------------------- -cat([silent | Args], {Path, _Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X}) -> - cat(Args, {Path, silent, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X}); +cat([silent | Args], X) -> + cat(Args, X); %%% dirs --------------------------------------------------------------- -cat([{dirs, D} | Args], {Path, Sil, Dirs, Erts, Test, - Var, VarTar, Mach, Xref, XrefApps, X}) -> +cat([{dirs, D} | Args], X) -> case check_dirs(D) of ok -> - cat(Args, {Path, Sil, D, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X}); + cat(Args, X); error -> - cat(Args, {Path, Sil, Dirs, Erts, Test, - Var, VarTar, Mach, Xref, XrefApps, X++[{dirs, D}]}) + cat(Args, X++[{dirs, D}]) end; %%% erts --------------------------------------------------------------- -cat([{erts, E} | Args], {Path, Sil, Dirs, _Erts, Test, - Var, VarTar, Mach, Xref, XrefApps, X}) when is_list(E)-> - cat(Args, {Path, Sil, Dirs, E, Test, Var, VarTar, Mach, Xref, XrefApps, X}); +cat([{erts, E} | Args], X) when is_list(E)-> + cat(Args, X); %%% src_tests ---------------------------------------------------- -cat([src_tests | Args], {Path, Sil, Dirs, Erts, _Test, Var, VarTar, Mach, Xref, XrefApps, X}) -> - cat(Args, {Path, Sil, Dirs, Erts, src_tests, Var, VarTar, Mach, - Xref, XrefApps, X}); +cat([src_tests | Args], X) -> + cat(Args, X); %%% variables ---------------------------------------------------------- -cat([{variables, V} | Args], {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X}) when is_list(V) -> +cat([{variables, V} | Args], X) when is_list(V) -> case check_vars(V) of ok -> - cat(Args, {Path, Sil, Dirs, Erts, Test, V, VarTar, Mach, Xref, XrefApps, X}); + cat(Args, X); error -> - cat(Args, {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, - Xref, XrefApps, X++[{variables, V}]}) + cat(Args, X++[{variables, V}]) end; %%% var_tar ------------------------------------------------------------ -cat([{var_tar, VT} | Args], {Path, Sil, Dirs, Erts, Test, - Var, _VarTar, Mach, Xref, XrefApps, X}) when VT == include -> - cat(Args, {Path, Sil, Dirs, Erts, Test, Var, include, Mach, Xref, XrefApps, X}); -cat([{var_tar, VT} | Args], {Path, Sil, Dirs, Erts, Test, - Var, _VarTar, Mach, Xref, XrefApps, X}) when VT == ownfile -> - cat(Args, {Path, Sil, Dirs, Erts, Test, Var, ownfile, Mach, Xref, XrefApps, X}); -cat([{var_tar, VT} | Args], {Path, Sil, Dirs, Erts, Test, - Var, _VarTar, Mach, Xref, XrefApps, X}) when VT == omit -> - cat(Args, {Path, Sil, Dirs, Erts, Test, Var, omit, Mach, Xref, XrefApps, X}); +cat([{var_tar, VT} | Args], X) when VT == include; + VT == ownfile; + VT == omit -> + cat(Args, X); %%% machine ------------------------------------------------------------ -cat([{machine, M} | Args], {Path, Sil, Dirs, Erts, Test, - Var, VarTar, Mach, Xref, XrefApps, X}) when is_atom(M) -> - cat(Args, {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X}); +cat([{machine, M} | Args], X) when is_atom(M) -> + cat(Args, X); %%% exref -------------------------------------------------------------- -cat([exref | Args], {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, _Xref, XrefApps, X}) -> - cat(Args, {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, exref, XrefApps, X}); +cat([exref | Args], X) -> + cat(Args, X); %%% exref Apps --------------------------------------------------------- -cat([{exref, Apps} | Args], {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X}) when is_list(Apps) -> +cat([{exref, Apps} | Args], X) when is_list(Apps) -> case check_apps(Apps) of ok -> - cat(Args, {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, - Xref, Apps, X}); + cat(Args, X); error -> - cat(Args, {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, - Xref, XrefApps, X++[{exref, Apps}]}) + cat(Args, X++[{exref, Apps}]) end; %%% outdir Dir --------------------------------------------------------- -cat([{outdir, Dir} | Args], {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X}) when is_list(Dir) -> - cat(Args, {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, - Xref, XrefApps, X}); +cat([{outdir, Dir} | Args], X) when is_list(Dir) -> + cat(Args, X); %%% otp_build (secret, not documented) --------------------------------- -cat([otp_build | Args], {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X}) -> - cat(Args, {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X}); +cat([otp_build | Args], X) -> + cat(Args, X); +%%% warnings_as_errors ---- +cat([warnings_as_errors | Args], X) -> + cat(Args, X); +%%% no_warn_sasl ---- +cat([no_warn_sasl | Args], X) -> + cat(Args, X); %%% no_module_tests (kept for backwards compatibility, but ignored) ---- -cat([no_module_tests | Args], {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X}) -> - cat(Args, {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X}); +cat([no_module_tests | Args], X) -> + cat(Args, X); %%% ERROR -------------------------------------------------------------- -cat([Y | Args], {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X}) -> - cat(Args, {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X++[Y]}). +cat([Y | Args], X) -> + cat(Args, X++[Y]). check_path([]) -> ok; @@ -2296,6 +2290,9 @@ format_error({delete,File,Error}) -> [File,file:format_error(Error)]); format_error({tar_error,What}) -> form_tar_err(What); +format_error({warnings_treated_as_errors,Warnings}) -> + io_lib:format("Warnings being treated as errors:~n~ts", + [map(fun(W) -> form_warn("",W) end, Warnings)]); format_error(ListOfErrors) when is_list(ListOfErrors) -> format_errors(ListOfErrors); format_error(E) -> io_lib:format("~p~n",[E]). @@ -2352,24 +2349,15 @@ form_tar_err({add, File, Error}) -> %% Format warning format_warning(Warnings) -> - format_warning(Warnings, false). - -format_warning(Warnings, Werror) -> - Prefix = case Werror of - true -> - ""; - false -> - "*WARNING* " - end, - map(fun({warning,W}) -> form_warn(Prefix, W) end, Warnings). - -form_warn(Prefix, {source_not_found,{Mod,_,App,_,_}}) -> + map(fun({warning,W}) -> form_warn("*WARNING* ", W) end, Warnings). + +form_warn(Prefix, {source_not_found,{Mod,App,_}}) -> io_lib:format("~ts~w: Source code not found: ~w.erl~n", [Prefix,App,Mod]); form_warn(Prefix, {{parse_error, File},{_,_,App,_,_}}) -> io_lib:format("~ts~w: Parse error: ~p~n", [Prefix,App,File]); -form_warn(Prefix, {obj_out_of_date,{Mod,_,App,_,_}}) -> +form_warn(Prefix, {obj_out_of_date,{Mod,App,_}}) -> io_lib:format("~ts~w: Object code (~w) out of date~n", [Prefix,App,Mod]); form_warn(Prefix, {exref_undef, Undef}) -> @@ -2379,8 +2367,8 @@ form_warn(Prefix, {exref_undef, Undef}) -> end, map(F, Undef); form_warn(Prefix, missing_sasl) -> - io_lib:format("~ts: Missing application sasl. " + io_lib:format("~tsMissing application sasl. " "Can not upgrade with this release~n", [Prefix]); form_warn(Prefix, What) -> - io_lib:format("~ts ~p~n", [Prefix,What]). + io_lib:format("~ts~p~n", [Prefix,What]). diff --git a/lib/sasl/src/systools_relup.erl b/lib/sasl/src/systools_relup.erl index 28534dc0c8..7e1844b400 100644 --- a/lib/sasl/src/systools_relup.erl +++ b/lib/sasl/src/systools_relup.erl @@ -155,36 +155,12 @@ mk_relup(TopRelFile, BaseUpRelDcs, BaseDnRelDcs) -> mk_relup(TopRelFile, BaseUpRelDcs, BaseDnRelDcs, Opts) -> case check_opts(Opts) of [] -> - R = (catch do_mk_relup(TopRelFile,BaseUpRelDcs,BaseDnRelDcs, - add_code_path(Opts), Opts)), - case {get_opt(silent, Opts), get_opt(noexec, Opts)} of - {false, false} -> - case R of - {ok, _Res, _Mod, Ws} -> - print_warnings(Ws, Opts), - case systools_lib:werror(Opts, Ws) of - true -> - error; - false -> - ok - end; - Other -> - print_error(Other), - error - end; - _ -> - case R of - {ok, _Res, _Mod, Ws} -> - case systools_lib:werror(Opts, Ws) of - true -> - error; - false -> - R - end; - R -> - R - end - end; + R = try do_mk_relup(TopRelFile,BaseUpRelDcs,BaseDnRelDcs, + add_code_path(Opts), Opts) + catch throw:Error -> + Error + end, + done_mk_relup(Opts, R); BadArg -> erlang:error({badarg, BadArg}) end. @@ -224,17 +200,45 @@ do_mk_relup(TopRelFile, BaseUpRelDcs, BaseDnRelDcs, Path, Opts) -> {Dn, Ws2} = foreach_baserel_dn(TopRel, TopApps, BaseDnRelDcs, Path, Opts, Ws1), Relup = {TopRel#release.vsn, Up, Dn}, - case systools_lib:werror(Opts, Ws2) of - true -> - ok; - false -> - write_relup_file(Relup, Opts) - end, - {ok, Relup, ?MODULE, Ws2}; + + {ok, Relup, Ws2}; Other -> - throw(Other) + Other end. +done_mk_relup(Opts, {ok,Relup,Ws}) -> + WAE = get_opt(warnings_as_errors,Opts), + Silent = get_opt(silent,Opts), + Noexec = get_opt(noexec,Opts), + + if WAE andalso Ws=/=[] -> + return_error(Silent, + {error,?MODULE,{warnings_treated_as_errors, Ws}}); + not Noexec -> + case write_relup_file(Relup,Opts) of + ok -> + return_ok(Silent,Relup,Ws); + Error -> + return_error(Silent,Error) + end; + true -> % noexec + return_ok(true,Relup,Ws) + end; +done_mk_relup(Opts, Error) -> + return_error(get_opt(silent,Opts) orelse get_opt(noexec,Opts), Error). + +return_error(true, Error) -> + Error; +return_error(false, Error) -> + print_error(Error), + error. + +return_ok(true,Relup,Ws) -> + {ok,Relup,?MODULE,Ws}; +return_ok(false,_Relup,Ws) -> + print_warnings(Ws), + ok. + %%----------------------------------------------------------------- %% foreach_baserel_up(Rel, TopApps, BaseRelDcs, Path, Opts, Ws) -> Ret %% foreach_baserel_dn(Rel, TopApps, BaseRelDcs, Path, Opts, Ws) -> Ret @@ -529,33 +533,18 @@ to_list(X) when is_list(X) -> X. %% Writes a relup file. %% write_relup_file(Relup, Opts) -> - case get_opt(noexec, Opts) of - true -> - ok; - _ -> - Filename = case get_opt(outdir, Opts) of - OutDir when is_list(OutDir) -> - filename:join(filename:absname(OutDir), - "relup"); - false -> - "relup"; - Badarg -> - throw({error, ?MODULE, {badarg, {outdir,Badarg}}}) - end, - - case file:open(Filename, [write]) of - {ok, Fd} -> - io:format(Fd, "~p.~n", [Relup]), - case file:close(Fd) of - ok -> ok; - {error,Reason} -> - throw({error, ?MODULE, - {file_problem, {"relup", {close,Reason}}}}) - end; - {error, Reason} -> - throw({error, ?MODULE, - {file_problem, {"relup", {open, Reason}}}}) - end + Filename = filename:join(filename:absname(get_opt(outdir,Opts)), + "relup"), + case file:open(Filename, [write]) of + {ok, Fd} -> + io:format(Fd, "~p.~n", [Relup]), + case file:close(Fd) of + ok -> ok; + {error,Reason} -> + {error, ?MODULE, {file_problem, {"relup", {close,Reason}}}} + end; + {error, Reason} -> + {error, ?MODULE, {file_problem, {"relup", {open, Reason}}}} end. add_code_path(Opts) -> @@ -593,10 +582,9 @@ default(path) -> false; default(noexec) -> false; default(silent) -> false; default(restart_emulator) -> false; -default(outdir) -> false. +default(outdir) -> "."; +default(warnings_as_errors) -> false. -print_error({'EXIT', Err}) -> - print_error(Err); print_error({error, Mod, Error}) -> S = apply(Mod, format_error, [Error]), io:format(S, []); @@ -614,24 +602,20 @@ format_error({missing_sasl,Release}) -> io_lib:format("No sasl application in release ~ts, ~ts. " "Can not be upgraded.", [Release#release.name, Release#release.vsn]); +format_error({warnings_treated_as_errors, Warnings}) -> + io_lib:format("Warnings being treated as errors:~n~ts", + [[format_warning("",W) || W <- Warnings]]); format_error(Error) -> - io:format("~p~n", [Error]). + io_lib:format("~p~n", [Error]). -print_warnings(Ws, Opts) when is_list(Ws) -> - lists:foreach(fun(W) -> print_warning(W, Opts) end, Ws); -print_warnings(W, Opts) -> - print_warning(W, Opts). +print_warnings(Ws) when is_list(Ws) -> + lists:foreach(fun(W) -> print_warning(W) end, Ws); +print_warnings(W) -> + print_warning(W). -print_warning(W, Opts) -> - Prefix = case lists:member(warnings_as_errors, Opts) of - true -> - ""; - false -> - "*WARNING* " - end, - S = format_warning(Prefix, W), - io:format("~ts", [S]). +print_warning(W) -> + io:format("~ts", [format_warning(W)]). format_warning(W) -> format_warning("*WARNING* ", W). @@ -639,6 +623,8 @@ format_warning(W) -> format_warning(Prefix, {erts_vsn_changed, {Rel1, Rel2}}) -> io_lib:format("~tsThe ERTS version changed between ~p and ~p~n", [Prefix, Rel1, Rel2]); +format_warning(Prefix, pre_R15_emulator_upgrade) -> + io_lib:format("~tsUpgrade from an OTP version earlier than R15. New code should be compiled with the old emulator.~n",[Prefix]); format_warning(Prefix, What) -> io_lib:format("~ts~p~n",[Prefix, What]). diff --git a/lib/sasl/test/systools_SUITE.erl b/lib/sasl/test/systools_SUITE.erl index dd5f277a77..0c98232467 100644 --- a/lib/sasl/test/systools_SUITE.erl +++ b/lib/sasl/test/systools_SUITE.erl @@ -29,6 +29,8 @@ -module(systools_SUITE). +-compile(export_all). + %%-define(debug, true). -include_lib("common_test/include/ct.hrl"). @@ -39,31 +41,6 @@ -include_lib("kernel/include/file.hrl"). --export([all/0,suite/0,groups/0,init_per_group/2,end_per_group/2]). - --export([script_options/1, normal_script/1, unicode_script/1, - unicode_script/2, no_mod_vsn_script/1, - wildcard_script/1, variable_script/1, no_sasl_script/1, - no_dot_erlang_script/1, - abnormal_script/1, src_tests_script/1, crazy_script/1, - included_script/1, included_override_script/1, - included_fail_script/1, included_bug_script/1, exref_script/1, - duplicate_modules_script/1, - otp_3065_circular_dependenies/1, included_and_used_sort_script/1]). --export([tar_options/1, normal_tar/1, no_mod_vsn_tar/1, system_files_tar/1, - system_files_tar/2, invalid_system_files_tar/1, - invalid_system_files_tar/2, variable_tar/1, - src_tests_tar/1, var_tar/1, exref_tar/1, link_tar/1, - otp_9507_path_ebin/1]). --export([normal_relup/1, restart_relup/1, abnormal_relup/1, no_sasl_relup/1, - no_appup_relup/1, bad_appup_relup/1, app_start_type_relup/1, - regexp_relup/1]). --export([normal_hybrid/1,hybrid_no_old_sasl/1,hybrid_no_new_sasl/1]). --export([otp_6226_outdir/1, app_file_defaults/1]). --export([init_per_suite/1, end_per_suite/1, - init_per_testcase/2, end_per_testcase/2]). --export([delete_tree/1]). - -import(lists, [foldl/3]). -define(default_timeout, ?t:minutes(20)). @@ -91,7 +68,8 @@ groups() -> {tar, [], [tar_options, normal_tar, no_mod_vsn_tar, system_files_tar, invalid_system_files_tar, variable_tar, - src_tests_tar, var_tar, exref_tar, link_tar, otp_9507_path_ebin]}, + src_tests_tar, var_tar, exref_tar, link_tar, no_sasl_tar, + otp_9507_path_ebin]}, {relup, [], [normal_relup, restart_relup, abnormal_relup, no_sasl_relup, no_appup_relup, bad_appup_relup, app_start_type_relup, regexp_relup @@ -238,6 +216,7 @@ normal_script(Config) when is_list(Config) -> %% Check the same but w. silent flag {ok, _, []} = systools:make_script(LatestName, [silent]), + {ok, _, []} = systools:make_script(LatestName, [silent,warnings_as_errors]), %% Use the local option ok = systools:make_script(LatestName, [local]), @@ -456,9 +435,16 @@ no_sasl_script(Config) when is_list(Config) -> {ok, _ , [{warning,missing_sasl}]} = systools:make_script(LatestName,[{path, P},silent]), + {error, systools_make, {warnings_treated_as_errors,[missing_sasl]}} = + systools:make_script(LatestName,[{path, P},silent,warnings_as_errors]), + {ok, _ , []} = systools:make_script(LatestName,[{path, P},silent, no_warn_sasl]), + {ok, _ , []} = + systools:make_script(LatestName,[{path, P},silent, no_warn_sasl, + warnings_as_errors]), + ok = file:set_cwd(OldDir), ok. @@ -525,7 +511,9 @@ src_tests_script(Config) when is_list(Config) -> ok = file:delete(BootFile), false = filelib:is_regular(BootFile), %% With warnings_as_errors and src_tests option, an error should be issued - error = + {error, systools_make, + {warnings_treated_as_errors, [{obj_out_of_date,_}, + {source_not_found,_}]}} = systools:make_script(LatestName, [silent, {path, N}, src_tests, warnings_as_errors]), error = @@ -745,7 +733,7 @@ exref_script(Config) when is_list(Config) -> ok = file:set_cwd(LatestDir), - {ok, _, _} = systools:make_script(LatestName, [{path,P}, silent]), + {ok, _, []} = systools:make_script(LatestName, [{path,P}, silent]), %% Complete exref {ok, _, W1} = @@ -894,10 +882,10 @@ normal_tar(Config) when is_list(Config) -> ok = file:set_cwd(LatestDir), - {ok, _, _} = systools:make_script(LatestName, [silent, {path, P}]), + {ok, _, []} = systools:make_script(LatestName, [silent, {path, P}]), ok = systools:make_tar(LatestName, [{path, P}]), ok = check_tar(fname([lib,'db-2.1',ebin,'db.app']), LatestName), - {ok, _, _} = systools:make_tar(LatestName, [{path, P}, silent]), + {ok, _, []} = systools:make_tar(LatestName, [{path, P}, silent]), ok = check_tar(fname([lib,'fe-3.1',ebin,'fe.app']), LatestName), ok = file:set_cwd(OldDir), @@ -918,10 +906,10 @@ no_mod_vsn_tar(Config) when is_list(Config) -> ok = file:set_cwd(LatestDir), - {ok, _, _} = systools:make_script(LatestName, [silent, {path, P}]), + {ok, _, []} = systools:make_script(LatestName, [silent, {path, P}]), ok = systools:make_tar(LatestName, [{path, P}]), ok = check_tar(fname([lib,'db-3.1',ebin,'db.app']), LatestName), - {ok, _, _} = systools:make_tar(LatestName, [{path, P}, silent]), + {ok, _, []} = systools:make_tar(LatestName, [{path, P}, silent]), ok = check_tar(fname([lib,'fe-3.1',ebin,'fe.app']), LatestName), ok = file:set_cwd(OldDir), @@ -945,11 +933,11 @@ system_files_tar(Config) -> ok = file:write_file("sys.config","[].\n"), ok = file:write_file("relup","{\"LATEST\",[],[]}.\n"), - {ok, _, _} = systools:make_script(LatestName, [silent, {path, P}]), + {ok, _, []} = systools:make_script(LatestName, [silent, {path, P}]), ok = systools:make_tar(LatestName, [{path, P}]), ok = check_tar(fname(["releases","LATEST","sys.config"]), LatestName), ok = check_tar(fname(["releases","LATEST","relup"]), LatestName), - {ok, _, _} = systools:make_tar(LatestName, [{path, P}, silent]), + {ok, _, []} = systools:make_tar(LatestName, [{path, P}, silent]), ok = check_tar(fname(["releases","LATEST","sys.config"]), LatestName), ok = check_tar(fname(["releases","LATEST","relup"]), LatestName), @@ -978,7 +966,7 @@ invalid_system_files_tar(Config) -> ok = file:set_cwd(LatestDir), - {ok, _, _} = systools:make_script(LatestName, [silent, {path, P}]), + {ok, _, []} = systools:make_script(LatestName, [silent, {path, P}]), %% Add dummy relup and sys.config - faulty sys.config ok = file:write_file("sys.config","[]\n"), %!!! syntax error - missing '.' @@ -1036,7 +1024,7 @@ variable_tar(Config) when is_list(Config) -> ok = file:set_cwd(LatestDir), - {ok, _, _} = systools:make_script(LatestName, + {ok, _, []} = systools:make_script(LatestName, [silent, {path, P}, {variables,[{"TEST", LibDir}]}]), @@ -1045,7 +1033,7 @@ variable_tar(Config) when is_list(Config) -> {variables,[{"TEST", LibDir}]}]), ok = check_var_tar("TEST", LatestName), - {ok, _, _} = systools:make_tar(LatestName, + {ok, _, []} = systools:make_tar(LatestName, [{path, P}, silent, {variables,[{"TEST", LibDir}]}]), ok = check_var_tar("TEST", LatestName), @@ -1174,7 +1162,7 @@ var_tar(Config) when is_list(Config) -> ok = file:set_cwd(LatestDir), - {ok, _, _} = systools:make_script(LatestName, + {ok, _, []} = systools:make_script(LatestName, [silent, {path, P}, {variables,[{"TEST", LibDir}]}]), @@ -1218,7 +1206,7 @@ exref_tar(Config) when is_list(Config) -> ok = file:set_cwd(LatestDir), - {ok, _, _} = systools:make_script(LatestName, [silent, {path, P}]), + {ok, _, []} = systools:make_script(LatestName, [silent, {path, P}]), %% Complete exref {ok, _, W1} = @@ -1248,7 +1236,41 @@ exref_tar(Config) when is_list(Config) -> ok = file:set_cwd(OldDir), ok. +%% make_tar: Create tar without sasl appl. Check warning. +no_sasl_tar(Config) when is_list(Config) -> + {ok, OldDir} = file:get_cwd(), + {LatestDir, LatestName} = create_script(latest1_no_sasl,Config), + + DataDir = filename:absname(?copydir), + LibDir = fname([DataDir, d_normal, lib]), + P = [fname([LibDir, '*', ebin]), + fname([DataDir, lib, kernel, ebin]), + fname([DataDir, lib, stdlib, ebin]), + fname([DataDir, lib, sasl, ebin])], + + ok = file:set_cwd(LatestDir), + + {ok, _, _} = systools:make_script(LatestName, [silent, {path, P}]), + ok = systools:make_tar(LatestName, [{path, P}]), + {ok, _, [{warning,missing_sasl}]} = + systools:make_tar(LatestName, [{path, P}, silent]), + {ok, _, []} = + systools:make_tar(LatestName, [{path, P}, silent, no_warn_sasl]), + {ok, _, []} = + systools:make_tar(LatestName, [{path, P}, silent, no_warn_sasl, + warnings_as_errors]), + TarFile = LatestName ++ ".tar.gz", + true = filelib:is_regular(TarFile), + ok = file:delete(TarFile), + {error, systools_make, {warnings_treated_as_errors,[missing_sasl]}} = + systools:make_tar(LatestName, [{path, P}, silent, warnings_as_errors]), + error = + systools:make_tar(LatestName, [{path, P}, warnings_as_errors]), + false = filelib:is_regular(TarFile), + + ok = file:set_cwd(OldDir), + ok. %% make_tar: OTP-9507 - make_tar failed when path given as just 'ebin'. otp_9507_path_ebin(Config) when is_list(Config) -> @@ -1268,7 +1290,7 @@ otp_9507_path_ebin(Config) when is_list(Config) -> fname([DataDir, lib, kernel, ebin]), fname([DataDir, lib, stdlib, ebin]), fname([DataDir, lib, sasl, ebin])], - {ok, _, _} = systools:make_script(RelName, [silent, {path, P1}]), + {ok, _, []} = systools:make_script(RelName, [silent, {path, P1}]), ok = systools:make_tar(RelName, [{path, P1}]), Content1 = tar_contents(RelName), @@ -1309,7 +1331,7 @@ normal_relup(Config) when is_list(Config) -> ok = systools:make_relup(LatestName, [LatestName1], [LatestName1], [{path, P}]), ok = check_relup([{db, "2.1"}], [{db, "1.0"}]), - {ok, _, _, []} = + {ok, Relup, _, []} = systools:make_relup(LatestName, [LatestName1], [LatestName1], [{path, P}, silent]), ok = check_relup([{db, "2.1"}], [{db, "1.0"}]), @@ -1322,7 +1344,9 @@ normal_relup(Config) when is_list(Config) -> error = systools:make_relup(LatestName, [LatestName2], [LatestName1], [{path, P}, warnings_as_errors]), - error = + {error, systools_relup, + {warnings_treated_as_errors,[pre_R15_emulator_upgrade, + {erts_vsn_changed, _}]}} = systools:make_relup(LatestName, [LatestName2], [LatestName1], [{path, P}, silent, warnings_as_errors]), @@ -1341,6 +1365,14 @@ normal_relup(Config) when is_list(Config) -> %% relup file should exist now true = filelib:is_regular("relup"), + %% file should not be written if noexec option is used. + %% delete before running tests. + ok = file:delete("relup"), + {ok,Relup,_,[]} = + systools:make_relup(LatestName, [LatestName1], [LatestName1], + [{path, P}, noexec]), + false = filelib:is_regular("relup"), + ok = file:set_cwd(OldDir), ok. diff --git a/lib/ssh/src/ssh_transport.erl b/lib/ssh/src/ssh_transport.erl index 02209d5dfd..5d178a202d 100644 --- a/lib/ssh/src/ssh_transport.erl +++ b/lib/ssh/src/ssh_transport.erl @@ -84,11 +84,6 @@ default_algorithms(kex) -> 'diffie-hellman-group1-sha1' % Gone in OpenSSH 7.3.p1 ]); -default_algorithms(public_key) -> - supported_algorithms(public_key, [ - 'ssh-dss' % Gone in OpenSSH 7.3.p1 - ]); - default_algorithms(cipher) -> supported_algorithms(cipher, same(['AEAD_AES_128_GCM', 'AEAD_AES_256_GCM'])); diff --git a/lib/stdlib/doc/src/c.xml b/lib/stdlib/doc/src/c.xml index 55a77d1bc5..7666699183 100644 --- a/lib/stdlib/doc/src/c.xml +++ b/lib/stdlib/doc/src/c.xml @@ -52,13 +52,27 @@ <func> <name name="c" arity="1"/> <name name="c" arity="2"/> - <fsummary>Compile and load code in a file.</fsummary> + <name name="c" arity="3"/> + <fsummary>Compile and load a file or module.</fsummary> <desc> - <p>Compiles and then purges and loads the code for a file. - <c><anno>Options</anno></c> defaults to <c>[]</c>. Compilation is - equivalent to:</p> - <code type="none"> -compile:file(<anno>File</anno>, <anno>Options</anno> ++ [report_errors, report_warnings])</code> + <p>Compiles and then purges and loads the code for a module. + <c><anno>Module</anno></c> can be either a module name or a source + file path, with or without <c>.erl</c> extension. + <c><anno>Options</anno></c> defaults to <c>[]</c>.</p> + <p>If <c><anno>Module</anno></c> is an atom and is not the path of a + source file, then the code path is searched to locate the object + file for the module and extract its original compiler options and + source path. If the source file is not found in the original + location, <seealso + marker="filelib#find_source/1"><c>filelib:find_source/1</c></seealso> + is used to search for it relative to the directory of the object + file.</p> + <p>The source file is compiled with the the original + options appended to the given <c><anno>Options</anno></c>, the + output replacing the old object file if and only if compilation + succeeds. A function <c><anno>Filter</anno></c> can be specified + for removing elements from from the original compiler options + before the new options are added.</p> <p>Notice that purging the code means that any processes lingering in old code for the module are killed without warning. For more information, see <c>code/3</c>.</p> diff --git a/lib/stdlib/doc/src/filelib.xml b/lib/stdlib/doc/src/filelib.xml index 7c6380ce28..ad73fc254a 100644 --- a/lib/stdlib/doc/src/filelib.xml +++ b/lib/stdlib/doc/src/filelib.xml @@ -60,6 +60,12 @@ <datatype> <name name="filename_all"/> </datatype> + <datatype> + <name name="find_file_rule"/> + </datatype> + <datatype> + <name name="find_source_rule"/> + </datatype> </datatypes> <funcs> @@ -226,7 +232,51 @@ filelib:wildcard("lib/**/*.{erl,hrl}")</code> directory.</p> </desc> </func> + + <func> + <name name="find_file" arity="2"/> + <name name="find_file" arity="3"/> + <fsummary>Find a file relative to a given directory.</fsummary> + <desc> + <p>Looks for a file of the given name by applying suffix rules to + the given directory path. For example, a rule <c>{"ebin", "src"}</c> + means that if the directory path ends with <c>"ebin"</c>, the + corresponding path ending in <c>"src"</c> should be searched.</p> + <p>If <c><anno>Rules</anno></c> is left out or is an empty list, the + default system rules are used. See also the Kernel application + parameter <seealso + marker="kernel:kernel_app#source_search_rules"><c>source_search_rules</c></seealso>.</p> + </desc> + </func> + <func> + <name name="find_source" arity="1"/> + <fsummary>Find the source file for a given object file.</fsummary> + <desc> + <p>Equivalent to <c>find_source(Base, Dir)</c>, where <c>Dir</c> is + <c>filename:dirname(<anno>FilePath</anno>)</c> and <c>Base</c> is + <c>filename:basename(<anno>FilePath</anno>)</c>.</p> + </desc> + </func> + <func> + <name name="find_source" arity="2"/> + <name name="find_source" arity="3"/> + <fsummary>Find a source file relative to a given directory.</fsummary> + <desc> + <p>Applies file extension specific rules to find the source file for + a given object file relative to the object directory. For example, + for a file with the extension <c>.beam</c>, the default rule is to + look for a file with a corresponding extension <c>.erl</c> by + replacing the suffix <c>"ebin"</c> of the object directory path with + <c>"src"</c>. + The file search is done through <seealso + marker="#find_file/3"><c>find_file/3</c></seealso>. The directory of + the object file is always tried before any other directory specified + by the rules.</p> + <p>If <c><anno>Rules</anno></c> is left out or is an empty list, the + default system rules are used. See also the Kernel application + parameter <seealso + marker="kernel:kernel_app#source_search_rules"><c>source_search_rules</c></seealso>.</p> + </desc> + </func> </funcs> </erlref> - - diff --git a/lib/stdlib/doc/src/filename.xml b/lib/stdlib/doc/src/filename.xml index 2a413835d0..7acef51ca1 100644 --- a/lib/stdlib/doc/src/filename.xml +++ b/lib/stdlib/doc/src/filename.xml @@ -356,10 +356,12 @@ true <p>Finds the source filename and compiler options for a module. The result can be fed to <seealso marker="compiler:compile#file/2"> <c>compile:file/2</c></seealso> to compile the file again.</p> - <warning><p>It is not recommended to use this function. If possible, - use the <seealso marker="beam_lib"><c>beam_lib(3)</c></seealso> - module to extract the abstract code format from the Beam file and - compile that instead.</p></warning> + <warning> + <p>This function is deprecated. Use <seealso marker="filelib#find_source/1"> + <c>filelib:find_source/1</c></seealso> instead for finding source files.</p> + <p>If possible, use the <seealso marker="beam_lib"><c>beam_lib(3)</c></seealso> + module to extract the compiler options and the abstract code + format from the Beam file and compile that instead.</p></warning> <p>Argument <c><anno>Beam</anno></c>, which can be a string or an atom, specifies either the module name or the path to the source code, with or without extension <c>".erl"</c>. In either diff --git a/lib/stdlib/doc/src/shell.xml b/lib/stdlib/doc/src/shell.xml index d6e8036d4e..f52bc39deb 100644 --- a/lib/stdlib/doc/src/shell.xml +++ b/lib/stdlib/doc/src/shell.xml @@ -165,12 +165,12 @@ <item> <p>Evaluates <c>shell_default:help()</c>.</p> </item> - <tag><c>c(File)</c></tag> + <tag><c>c(Mod)</c></tag> <item> - <p>Evaluates <c>shell_default:c(File)</c>. This compiles - and loads code in <c>File</c> and purges old versions of - code, if necessary. Assumes that the file and module names - are the same.</p> + <p>Evaluates <c>shell_default:c(Mod)</c>. This compiles and + loads the module <c>Mod</c> and purges old versions of the + code, if necessary. <c>Mod</c> can be either a module name or a + a source file path, with or without <c>.erl</c> extension.</p> </item> <tag><c>catch_exception(Bool)</c></tag> <item> diff --git a/lib/stdlib/src/c.erl b/lib/stdlib/src/c.erl index d36630214c..d3f9a9c7af 100644 --- a/lib/stdlib/src/c.erl +++ b/lib/stdlib/src/c.erl @@ -23,7 +23,7 @@ %% Avoid warning for local function error/2 clashing with autoimported BIF. -compile({no_auto_import,[error/2]}). --export([help/0,lc/1,c/1,c/2,nc/1,nc/2, nl/1,l/1,i/0,i/1,ni/0, +-export([help/0,lc/1,c/1,c/2,c/3,nc/1,nc/2, nl/1,l/1,i/0,i/1,ni/0, y/1, y/2, lc_batch/0, lc_batch/1, i/3,pid/3,m/0,m/1,mm/0,lm/0, @@ -44,7 +44,7 @@ help() -> io:put_chars(<<"bt(Pid) -- stack backtrace for a process\n" - "c(File) -- compile and load code in <File>\n" + "c(Mod) -- compile and load module or file <Mod>\n" "cd(Dir) -- change working directory\n" "flush() -- flush any messages sent to the shell\n" "help() -- help info\n" @@ -72,32 +72,222 @@ help() -> "xm(M) -- cross reference check a module\n" "y(File) -- generate a Yecc parser\n">>). -%% c(FileName) -%% Compile a file/module. +%% c(Module) +%% Compile a module/file. --spec c(File) -> {'ok', Module} | 'error' when - File :: file:name(), - Module :: module(). +-spec c(Module) -> {'ok', ModuleName} | 'error' when + Module :: file:name(), + ModuleName :: module(). -c(File) -> c(File, []). +c(Module) -> c(Module, []). --spec c(File, Options) -> {'ok', Module} | 'error' when - File :: file:name(), +-spec c(Module, Options) -> {'ok', ModuleName} | 'error' when + Module :: file:name(), Options :: [compile:option()], - Module :: module(). + ModuleName :: module(). + +c(Module, Opts) when is_atom(Module) -> + %% either a module name or a source file name (possibly without + %% suffix); if such a source file exists, it is used to compile from + %% scratch with the given options, otherwise look for an object file + Suffix = case filename:extension(Module) of + "" -> src_suffix(Opts); + S -> S + end, + SrcFile = filename:rootname(Module, Suffix) ++ Suffix, + case filelib:is_file(SrcFile) of + true -> + compile_and_load(SrcFile, Opts); + false -> + c(Module, Opts, fun (_) -> true end) + end; +c(Module, Opts) -> + %% we never interpret a string as a module name, only as a file + compile_and_load(Module, Opts). + +%% This tries to find an existing object file and use its compile_info and +%% source path to recompile the module, overwriting the old object file. +%% The Filter parameter is applied to the old compile options + +-spec c(Module, Options, Filter) -> {'ok', ModuleName} | 'error' when + Module :: atom(), + Options :: [compile:option()], + Filter :: fun ((compile:option()) -> boolean()), + ModuleName :: module(). + +c(Module, Options, Filter) when is_atom(Module) -> + case find_beam(Module) of + BeamFile when is_list(BeamFile) -> + c(Module, Options, Filter, BeamFile); + Error -> + {error, Error} + end. + +c(Module, Options, Filter, BeamFile) -> + case compile_info(Module, BeamFile) of + Info when is_list(Info) -> + case find_source(BeamFile, Info) of + SrcFile when is_list(SrcFile) -> + c(SrcFile, Options, Filter, BeamFile, Info); + Error -> + Error + end; + Error -> + Error + end. + +c(SrcFile, NewOpts, Filter, BeamFile, Info) -> + %% Filter old options; also remove options that will be replaced. + %% Write new beam over old beam unless other outdir is specified. + F = fun (Opt) -> not is_outdir_opt(Opt) andalso Filter(Opt) end, + Options = (NewOpts ++ [{outdir,filename:dirname(BeamFile)}] + ++ lists:filter(F, old_options(Info))), + format("Recompiling ~s\n", [SrcFile]), + safe_recompile(SrcFile, Options, BeamFile). + +old_options(Info) -> + case lists:keyfind(options, 1, Info) of + {options, Opts} -> Opts; + false -> [] + end. + +%% prefer the source path in the compile info if the file exists, +%% otherwise do a standard source search relative to the beam file +find_source(BeamFile, Info) -> + case lists:keyfind(source, 1, Info) of + {source, SrcFile} -> + case filelib:is_file(SrcFile) of + true -> SrcFile; + false -> find_source(BeamFile) + end; + _ -> + find_source(BeamFile) + end. + +find_source(BeamFile) -> + case filelib:find_source(BeamFile) of + {ok, SrcFile} -> SrcFile; + _ -> {error, no_source} + end. -c(File, Opts0) when is_list(Opts0) -> - Opts = [report_errors,report_warnings|Opts0], +%% find the beam file for a module, preferring the path reported by code:which() +%% if it still exists, or otherwise by searching the code path +find_beam(Module) when is_atom(Module) -> + case code:which(Module) of + Beam when is_list(Beam), Beam =/= "" -> + case erlang:module_loaded(Module) of + false -> + Beam; % code:which/1 found this in the path + true -> + case filelib:is_file(Beam) of + true -> Beam; + false -> find_beam_1(Module) % file moved? + end + end; + Other when Other =:= ""; Other =:= cover_compiled -> + %% module is loaded but not compiled directly from source + find_beam_1(Module); + Error -> + Error + end. + +find_beam_1(Module) -> + File = atom_to_list(Module) ++ code:objfile_extension(), + case code:where_is_file(File) of + Beam when is_list(Beam) -> + Beam; + Error -> + Error + end. + +%% get the compile_info for a module +%% -will report the info for the module in memory, if loaded +%% -will try to find and examine the beam file if not in memory +%% -will not cause a module to become loaded by accident +compile_info(Module, Beam) when is_atom(Module) -> + case erlang:module_loaded(Module) of + true -> + %% getting the compile info for a loaded module should normally + %% work, but return an empty info list if it fails + try erlang:get_module_info(Module, compile) + catch _:_ -> [] + end; + false -> + case beam_lib:chunks(Beam, [compile_info]) of + {ok, {_Module, [{compile_info, Info}]}} -> + Info; + Error -> + Error + end + end. + +%% compile module, backing up any existing target file and restoring the +%% old version if compilation fails (this should only be used when we have +%% an old beam file that we want to preserve) +safe_recompile(File, Options, BeamFile) -> + %% Note that it's possible that because of options such as 'to_asm', + %% the compiler might not actually write a new beam file at all + Backup = BeamFile ++ ".bak", + case file:rename(BeamFile, Backup) of + Status when Status =:= ok; Status =:= {error,enoent} -> + case compile_and_load(File, Options) of + {ok, _} = Result -> + _ = if Status =:= ok -> file:delete(Backup); + true -> ok + end, + Result; + Error -> + _ = if Status =:= ok -> file:rename(Backup, BeamFile); + true -> ok + end, + Error + end; + Error -> + Error + end. + +%% Compile the file and load the resulting object code (if any). +%% Automatically ensures that there is an outdir option, by default the +%% directory of File, and that a 'from' option will be passed to match the +%% actual source suffix if needed (unless already specified). +compile_and_load(File, Opts0) when is_list(Opts0) -> + Opts = [report_errors, report_warnings + | ensure_from(filename:extension(File), + ensure_outdir(filename:dirname(File), Opts0))], case compile:file(File, Opts) of {ok,Mod} -> %Listing file. - machine_load(Mod, File, Opts); + purge_and_load(Mod, File, Opts); {ok,Mod,_Ws} -> %Warnings maybe turned on. - machine_load(Mod, File, Opts); + purge_and_load(Mod, File, Opts); Other -> %Errors go here Other end; -c(File, Opt) -> - c(File, [Opt]). +compile_and_load(File, Opt) -> + compile_and_load(File, [Opt]). + +ensure_from(Suffix, Opts0) -> + case lists:partition(fun is_from_opt/1, Opts0++from_opt(Suffix)) of + {[Opt|_], Opts} -> [Opt | Opts]; + {[], Opts} -> Opts + end. + +ensure_outdir(Dir, Opts0) -> + {[Opt|_], Opts} = lists:partition(fun is_outdir_opt/1, + Opts0++[{outdir,Dir}]), + [Opt | Opts]. + +is_outdir_opt({outdir, _}) -> true; +is_outdir_opt(_) -> false. + +is_from_opt(from_core) -> true; +is_from_opt(from_asm) -> true; +is_from_opt(from_beam) -> true; +is_from_opt(_) -> false. + +from_opt(".core") -> [from_core]; +from_opt(".S") -> [from_asm]; +from_opt(".beam") -> [from_beam]; +from_opt(_) -> []. %%% Obtain the 'outdir' option from the argument. Return "." if no %%% such option was given. @@ -113,18 +303,29 @@ outdir([Opt|Rest]) -> outdir(Rest) end. +%% mimic how suffix is selected in compile:file(). +src_suffix([from_core|_]) -> ".core"; +src_suffix([from_asm|_]) -> ".S"; +src_suffix([from_beam|_]) -> ".beam"; +src_suffix([_|Opts]) -> src_suffix(Opts); +src_suffix([]) -> ".erl". + %%% We have compiled File with options Opts. Find out where the -%%% output file went to, and load it. -machine_load(Mod, File, Opts) -> +%%% output file went and load it, purging any old version. +purge_and_load(Mod, File, Opts) -> Dir = outdir(Opts), - File2 = filename:join(Dir, filename:basename(File, ".erl")), + Base = filename:basename(File, src_suffix(Opts)), + OutFile = filename:join(Dir, Base), case compile:output_generated(Opts) of true -> - Base = atom_to_list(Mod), - case filename:basename(File, ".erl") of + case atom_to_list(Mod) of Base -> code:purge(Mod), - check_load(code:load_abs(File2,Mod), Mod); + %% Note that load_abs() adds the object file suffix + case code:load_abs(OutFile, Mod) of + {error, _R}=Error -> Error; + _ -> {ok, Mod} + end; _OtherMod -> format("** Module name '~p' does not match file name '~tp' **~n", [Mod,File]), @@ -135,13 +336,6 @@ machine_load(Mod, File, Opts) -> ok end. -%%% This function previously warned if the loaded module was -%%% loaded from some other place than current directory. -%%% Now, loading from other than current directory is supposed to work. -%%% so this function does nothing special. -check_load({error, _R} = Error, _) -> Error; -check_load(_, Mod) -> {ok, Mod}. - %% Compile a list of modules %% enables the nice unix shell cmd %% erl -s c lc f1 f2 f3 @d c1=v1 @c2 @i IDir @o ODir -s erlang halt diff --git a/lib/stdlib/src/edlin_expand.erl b/lib/stdlib/src/edlin_expand.erl index 5f821caef0..a1a97af4c5 100644 --- a/lib/stdlib/src/edlin_expand.erl +++ b/lib/stdlib/src/edlin_expand.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2016. All Rights Reserved. +%% Copyright Ericsson AB 2005-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -101,44 +101,77 @@ match(Prefix, Alts, Extra0) -> %% Return the list of names L in multiple columns. format_matches(L) -> - S = format_col(lists:sort(L), []), + {S1, Dots} = format_col(lists:sort(L), []), + S = case Dots of + true -> + {_, Prefix} = longest_common_head(vals(L)), + PrefixLen = length(Prefix), + case PrefixLen =< 3 of + true -> S1; % Do not replace the prefix with "...". + false -> + LeadingDotsL = leading_dots(L, PrefixLen), + {S2, _} = format_col(lists:sort(LeadingDotsL), []), + S2 + end; + false -> S1 + end, ["\n" | S]. format_col([], _) -> []; -format_col(L, Acc) -> format_col(L, field_width(L), 0, Acc). - -format_col(X, Width, Len, Acc) when Width + Len > 79 -> - format_col(X, Width, 0, ["\n" | Acc]); -format_col([A|T], Width, Len, Acc0) -> - H = case A of - %% If it's a tuple {string(), integer()}, we assume it's an - %% arity, and meant to be printed. - {H0, I} when is_integer(I) -> - H0 ++ "/" ++ integer_to_list(I); - {H1, _} -> H1; - H2 -> H2 - end, - Acc = [io_lib:format("~-*ts", [Width,H]) | Acc0], - format_col(T, Width, Len+Width, Acc); -format_col([], _, _, Acc) -> - lists:reverse(Acc, "\n"). - -field_width(L) -> field_width(L, 0). - -field_width([{H,_}|T], W) -> +format_col(L, Acc) -> + LL = 79, + format_col(L, field_width(L, LL), 0, Acc, LL, false). + +format_col(X, Width, Len, Acc, LL, Dots) when Width + Len > LL -> + format_col(X, Width, 0, ["\n" | Acc], LL, Dots); +format_col([A|T], Width, Len, Acc0, LL, Dots) -> + {H0, R} = format_val(A), + Hmax = LL - length(R), + {H, NewDots} = + case length(H0) > Hmax of + true -> {io_lib:format("~-*ts", [Hmax - 3, H0]) ++ "...", true}; + false -> {H0, Dots} + end, + Acc = [io_lib:format("~-*ts", [Width, H ++ R]) | Acc0], + format_col(T, Width, Len+Width, Acc, LL, NewDots); +format_col([], _, _, Acc, _LL, Dots) -> + {lists:reverse(Acc, "\n"), Dots}. + +format_val({H, I}) when is_integer(I) -> + %% If it's a tuple {string(), integer()}, we assume it's an + %% arity, and meant to be printed. + {H, "/" ++ integer_to_list(I)}; +format_val({H, _}) -> + {H, ""}; +format_val(H) -> + {H, ""}. + +field_width(L, LL) -> field_width(L, 0, LL). + +field_width([{H,_}|T], W, LL) -> case length(H) of - L when L > W -> field_width(T, L); - _ -> field_width(T, W) + L when L > W -> field_width(T, L, LL); + _ -> field_width(T, W, LL) end; -field_width([H|T], W) -> +field_width([H|T], W, LL) -> case length(H) of - L when L > W -> field_width(T, L); - _ -> field_width(T, W) + L when L > W -> field_width(T, L, LL); + _ -> field_width(T, W, LL) end; -field_width([], W) when W < 40 -> +field_width([], W, LL) when W < LL - 3 -> W + 4; -field_width([], _) -> - 40. +field_width([], _, LL) -> + LL. + +vals([]) -> []; +vals([{S, _}|L]) -> [S|vals(L)]; +vals([S|L]) -> [S|vals(L)]. + +leading_dots([], _Len) -> []; +leading_dots([{H, I}|L], Len) -> + [{"..." ++ nthtail(Len, H), I}|leading_dots(L, Len)]; +leading_dots([H|L], Len) -> + ["..." ++ nthtail(Len, H)|leading_dots(L, Len)]. longest_common_head([]) -> no; diff --git a/lib/stdlib/src/filelib.erl b/lib/stdlib/src/filelib.erl index 7029389e2f..daa18da9aa 100644 --- a/lib/stdlib/src/filelib.erl +++ b/lib/stdlib/src/filelib.erl @@ -24,6 +24,7 @@ -export([fold_files/5, last_modified/1, file_size/1, ensure_dir/1]). -export([wildcard/3, is_dir/2, is_file/2, is_regular/2]). -export([fold_files/6, last_modified/2, file_size/2]). +-export([find_file/2, find_file/3, find_source/1, find_source/2, find_source/3]). %% For debugging/testing. -export([compile_wildcard/1]). @@ -517,3 +518,124 @@ eval_list_dir(Dir, erl_prim_loader) -> end; eval_list_dir(Dir, Mod) -> Mod:list_dir(Dir). + +%% Getting the rules to use for file search + +keep_dir_search_rules(Rules) -> + [T || {_,_}=T <- Rules]. + +keep_suffix_search_rules(Rules) -> + [T || {_,_,_}=T <- Rules]. + +get_search_rules() -> + case application:get_env(kernel, source_search_rules) of + undefined -> default_search_rules(); + {ok, []} -> default_search_rules(); + {ok, R} when is_list(R) -> R + end. + +default_search_rules() -> + [%% suffix-speficic rules for source search + {".beam", ".erl", erl_source_search_rules()}, + {".erl", ".yrl", []}, + {"", ".src", erl_source_search_rules()}, + {".so", ".c", c_source_search_rules()}, + {".o", ".c", c_source_search_rules()}, + {"", ".c", c_source_search_rules()}, + {"", ".in", basic_source_search_rules()}, + %% plain old directory rules, backwards compatible + {"", ""}, + {"ebin","src"}, + {"ebin","esrc"} + ]. + +basic_source_search_rules() -> + (erl_source_search_rules() + ++ c_source_search_rules()). + +erl_source_search_rules() -> + [{"ebin","src"}, {"ebin","esrc"}]. + +c_source_search_rules() -> + [{"priv","c_src"}, {"priv","src"}, {"bin","c_src"}, {"bin","src"}, {"", "src"}]. + +%% Looks for a file relative to a given directory + +-type find_file_rule() :: {ObjDirSuffix::string(), SrcDirSuffix::string()}. + +-spec find_file(filename(), filename()) -> + {ok, filename()} | {error, not_found}. +find_file(Filename, Dir) -> + find_file(Filename, Dir, []). + +-spec find_file(filename(), filename(), [find_file_rule()]) -> + {ok, filename()} | {error, not_found}. +find_file(Filename, Dir, []) -> + find_file(Filename, Dir, get_search_rules()); +find_file(Filename, Dir, Rules) -> + try_dir_rules(keep_dir_search_rules(Rules), Filename, Dir). + +%% Looks for a source file relative to the object file name and directory + +-type find_source_rule() :: {ObjExtension::string(), SrcExtension::string(), + [find_file_rule()]}. + +-spec find_source(filename()) -> + {ok, filename()} | {error, not_found}. +find_source(FilePath) -> + find_source(filename:basename(FilePath), filename:dirname(FilePath)). + +-spec find_source(filename(), filename()) -> + {ok, filename()} | {error, not_found}. +find_source(Filename, Dir) -> + find_source(Filename, Dir, []). + +-spec find_source(filename(), filename(), [find_source_rule()]) -> + {ok, filename()} | {error, not_found}. +find_source(Filename, Dir, []) -> + find_source(Filename, Dir, get_search_rules()); +find_source(Filename, Dir, Rules) -> + try_suffix_rules(keep_suffix_search_rules(Rules), Filename, Dir). + +try_suffix_rules(Rules, Filename, Dir) -> + Ext = filename:extension(Filename), + try_suffix_rules(Rules, filename:rootname(Filename, Ext), Dir, Ext). + +try_suffix_rules([{Ext,Src,Rules}|Rest], Root, Dir, Ext) + when is_list(Src), is_list(Rules) -> + case try_dir_rules(add_local_search(Rules), Root ++ Src, Dir) of + {ok, File} -> {ok, File}; + _Other -> + try_suffix_rules(Rest, Root, Dir, Ext) + end; +try_suffix_rules([_|Rest], Root, Dir, Ext) -> + try_suffix_rules(Rest, Root, Dir, Ext); +try_suffix_rules([], _Root, _Dir, _Ext) -> + {error, not_found}. + +%% ensuring we check the directory of the object file before any other directory +add_local_search(Rules) -> + Local = {"",""}, + [Local] ++ lists:filter(fun (X) -> X =/= Local end, Rules). + +try_dir_rules([{From, To}|Rest], Filename, Dir) + when is_list(From), is_list(To) -> + case try_dir_rule(Dir, Filename, From, To) of + {ok, File} -> {ok, File}; + error -> try_dir_rules(Rest, Filename, Dir) + end; +try_dir_rules([], _Filename, _Dir) -> + {error, not_found}. + +try_dir_rule(Dir, Filename, From, To) -> + case lists:suffix(From, Dir) of + true -> + NewDir = lists:sublist(Dir, 1, length(Dir)-length(From))++To, + Src = filename:join(NewDir, Filename), + case is_regular(Src) of + true -> {ok, Src}; + false -> error + end; + false -> + error + end. diff --git a/lib/stdlib/src/filename.erl b/lib/stdlib/src/filename.erl index c4586171ca..2a2f25dcd2 100644 --- a/lib/stdlib/src/filename.erl +++ b/lib/stdlib/src/filename.erl @@ -19,6 +19,9 @@ %% -module(filename). +-deprecated({find_src,1,next_major_release}). +-deprecated({find_src,2,next_major_release}). + %% Purpose: Provides generic manipulation of filenames. %% %% Generally, these functions accept filenames in the native format @@ -34,8 +37,8 @@ -export([absname/1, absname/2, absname_join/2, basename/1, basename/2, dirname/1, extension/1, join/1, join/2, pathtype/1, - rootname/1, rootname/2, split/1, nativename/1]). --export([find_src/1, find_src/2, flatten/1]). + rootname/1, rootname/2, split/1, flatten/1, nativename/1]). +-export([find_src/1, find_src/2]). % deprecated -export([basedir/2, basedir/3]). %% Undocumented and unsupported exports. @@ -750,8 +753,12 @@ separators() -> _ -> {false, false} end. - - +%% NOTE: The find_src/1/2 functions are deprecated; they try to do too much +%% at once and are not a good fit for this module. Parts of the code have +%% been moved to filelib:find_file/2 instead. Only this part of this +%% module is allowed to call the filelib module; such mutual dependency +%% should otherwise be avoided! This code should eventually be removed. +%% %% find_src(Module) -- %% find_src(Module, Rules) -- %% @@ -793,14 +800,7 @@ separators() -> | {'d', atom()}, ErrorReason :: 'non_existing' | 'preloaded' | 'interpreted'. find_src(Mod) -> - Default = [{"", ""}, {"ebin", "src"}, {"ebin", "esrc"}], - Rules = - case application:get_env(kernel, source_search_rules) of - undefined -> Default; - {ok, []} -> Default; - {ok, R} when is_list(R) -> R - end, - find_src(Mod, Rules). + find_src(Mod, []). -spec find_src(Beam, Rules) -> {SourceFile, Options} | {error, {ErrorReason, Module}} when @@ -816,44 +816,47 @@ find_src(Mod) -> ErrorReason :: 'non_existing' | 'preloaded' | 'interpreted'. find_src(Mod, Rules) when is_atom(Mod) -> find_src(atom_to_list(Mod), Rules); -find_src(File0, Rules) when is_list(File0) -> - Mod = list_to_atom(basename(File0, ".erl")), - File = rootname(File0, ".erl"), - case readable_file(File++".erl") of - true -> - try_file(File, Mod, Rules); - false -> - try_file(undefined, Mod, Rules) - end. - -try_file(File, Mod, Rules) -> +find_src(ModOrFile, Rules) when is_list(ModOrFile) -> + Extension = ".erl", + Mod = list_to_atom(basename(ModOrFile, Extension)), case code:which(Mod) of Possibly_Rel_Path when is_list(Possibly_Rel_Path) -> - {ok, Cwd} = file:get_cwd(), - Path = join(Cwd, Possibly_Rel_Path), - try_file(File, Path, Mod, Rules); + {ok, Cwd} = file:get_cwd(), + ObjPath = make_abs_path(Cwd, Possibly_Rel_Path), + find_src_1(ModOrFile, ObjPath, Mod, Extension, Rules); Ecode when is_atom(Ecode) -> % Ecode :: ecode() {error, {Ecode, Mod}} end. %% At this point, the Mod is known to be valid. %% If the source name is not known, find it. -%% Then get the compilation options. -%% Returns: {SrcFile, Options} +find_src_1(ModOrFile, ObjPath, Mod, Extension, Rules) -> + %% The documentation says this function must return the found path + %% without extension in all cases. Also, ModOrFile could be given with + %% or without extension. Hence the calls to rootname below. + ModOrFileRoot = rootname(ModOrFile, Extension), + case filelib:is_regular(ModOrFileRoot++Extension) of + true -> + find_src_2(ModOrFileRoot, Mod); + false -> + SrcName = basename(ObjPath, code:objfile_extension()) ++ Extension, + case filelib:find_file(SrcName, dirname(ObjPath), Rules) of + {ok, SrcFile} -> + find_src_2(rootname(SrcFile, Extension), Mod); + Error -> + Error + end + end. -try_file(undefined, ObjFilename, Mod, Rules) -> - case get_source_file(ObjFilename, Mod, Rules) of - {ok, File} -> try_file(File, ObjFilename, Mod, Rules); - Error -> Error - end; -try_file(Src, _ObjFilename, Mod, _Rules) -> +%% Get the compilation options and return {SrcFileRoot, Options} +find_src_2(SrcRoot, Mod) -> List = case Mod:module_info(compile) of none -> []; List0 -> List0 end, Options = proplists:get_value(options, List, []), {ok, Cwd} = file:get_cwd(), - AbsPath = make_abs_path(Cwd, Src), + AbsPath = make_abs_path(Cwd, SrcRoot), {AbsPath, filter_options(dirname(AbsPath), Options, [])}. %% Filters the options. @@ -884,42 +887,6 @@ filter_options(Base, [_|Rest], Result) -> filter_options(_Base, [], Result) -> Result. -%% Gets the source file given path of object code and module name. - -get_source_file(Obj, Mod, Rules) -> - source_by_rules(dirname(Obj), atom_to_list(Mod), Rules). - -source_by_rules(Dir, Base, [{From, To}|Rest]) -> - case try_rule(Dir, Base, From, To) of - {ok, File} -> {ok, File}; - error -> source_by_rules(Dir, Base, Rest) - end; -source_by_rules(_Dir, _Base, []) -> - {error, source_file_not_found}. - -try_rule(Dir, Base, From, To) -> - case lists:suffix(From, Dir) of - true -> - NewDir = lists:sublist(Dir, 1, length(Dir)-length(From))++To, - Src = join(NewDir, Base), - case readable_file(Src++".erl") of - true -> {ok, Src}; - false -> error - end; - false -> - error - end. - -readable_file(File) -> - case file:read_file_info(File) of - {ok, #file_info{type=regular, access=read}} -> - true; - {ok, #file_info{type=regular, access=read_write}} -> - true; - _Other -> - false - end. - make_abs_path(BasePath, Path) -> join(BasePath, Path). diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl index 5bf77a5160..2a0e3118d0 100644 --- a/lib/stdlib/src/otp_internal.erl +++ b/lib/stdlib/src/otp_internal.erl @@ -550,6 +550,13 @@ obsolete_1(overload, _, _) -> obsolete_1(rpc, safe_multi_server_call, A) when A =:= 2; A =:= 3 -> {removed, {rpc, multi_server_call, A}}; +%% Added in OTP 20. + +obsolete_1(filename, find_src, 1) -> + {deprecated, "deprecated; use filelib:find_source/1 instead"}; +obsolete_1(filename, find_src, 2) -> + {deprecated, "deprecated; use filelib:find_source/3 instead"}; + %% Removed in OTP 20. obsolete_1(erlang, hash, 2) -> diff --git a/lib/stdlib/src/shell_default.erl b/lib/stdlib/src/shell_default.erl index cd63ab28b5..a0c1d98513 100644 --- a/lib/stdlib/src/shell_default.erl +++ b/lib/stdlib/src/shell_default.erl @@ -23,7 +23,7 @@ -module(shell_default). --export([help/0,lc/1,c/1,c/2,nc/1,nl/1,l/1,i/0,pid/3,i/3,m/0,m/1,lm/0,mm/0, +-export([help/0,lc/1,c/1,c/2,c/3,nc/1,nl/1,l/1,i/0,pid/3,i/3,m/0,m/1,lm/0,mm/0, memory/0,memory/1,uptime/0, erlangrc/1,bi/1, regs/0, flush/0,pwd/0,ls/0,ls/1,cd/1, y/1, y/2, @@ -72,6 +72,7 @@ bi(I) -> c:bi(I). bt(Pid) -> c:bt(Pid). c(File) -> c:c(File). c(File, Opt) -> c:c(File, Opt). +c(File, Opt, Filter) -> c:c(File, Opt, Filter). cd(D) -> c:cd(D). erlangrc(X) -> c:erlangrc(X). flush() -> c:flush(). diff --git a/lib/stdlib/test/edlin_expand_SUITE.erl b/lib/stdlib/test/edlin_expand_SUITE.erl index 718d91c6a3..1f694ea549 100644 --- a/lib/stdlib/test/edlin_expand_SUITE.erl +++ b/lib/stdlib/test/edlin_expand_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2016. All Rights Reserved. +%% Copyright Ericsson AB 2010-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -21,7 +21,8 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_testcase/2, end_per_testcase/2, init_per_group/2,end_per_group/2]). --export([normal/1, quoted_fun/1, quoted_module/1, quoted_both/1, erl_1152/1]). +-export([normal/1, quoted_fun/1, quoted_module/1, quoted_both/1, erl_1152/1, + erl_352/1]). -include_lib("common_test/include/ct.hrl"). @@ -36,7 +37,7 @@ suite() -> {timetrap,{minutes,1}}]. all() -> - [normal, quoted_fun, quoted_module, quoted_both, erl_1152]. + [normal, quoted_fun, quoted_module, quoted_both, erl_1152, erl_352]. groups() -> []. @@ -153,6 +154,78 @@ erl_1152(Config) when is_list(Config) -> "\n"++"foo"++" "++[1089]++_ = do_format(["foo",[1089]]), ok. +erl_352(Config) when is_list(Config) -> + erl_352_test(3, 3), + + erl_352_test(3, 75), + erl_352_test(3, 76, [trailing]), + erl_352_test(4, 74), + erl_352_test(4, 75, [leading]), + erl_352_test(4, 76, [leading, trailing]), + + erl_352_test(75, 3), + erl_352_test(76, 3, [leading]), + erl_352_test(74, 4), + erl_352_test(75, 4, [leading]), + erl_352_test(76, 4, [leading]), + + erl_352_test(74, 74, [leading]), + erl_352_test(74, 75, [leading]), + erl_352_test(74, 76, [leading, trailing]). + +erl_352_test(PrefixLen, SuffixLen) -> + erl_352_test(PrefixLen, SuffixLen, []). + +erl_352_test(PrefixLen, SuffixLen, Dots) -> + io:format("\nPrefixLen = ~w, SuffixLen = ~w\n", [PrefixLen, SuffixLen]), + + PrefixM = lists:duplicate(PrefixLen, $p), + SuffixM = lists:duplicate(SuffixLen, $s), + LM = [PrefixM ++ S ++ SuffixM || S <- ["1", "2"]], + StrM = do_format(LM), + check_leading(StrM, "", PrefixM, SuffixM, Dots), + + PrefixF = lists:duplicate(PrefixLen, $p), + SuffixF = lists:duplicate(SuffixLen-2, $s), + LF = [{PrefixF ++ S ++ SuffixF, 1} || S <- ["1", "2"]], + StrF = do_format(LF), + true = check_leading(StrF, "/1", PrefixF, SuffixF, Dots), + + ok. + +check_leading(FormStr, ArityStr, Prefix, Suffix, Dots) -> + List = string:tokens(FormStr, "\n "), + io:format("~p\n", [List]), + true = lists:all(fun(L) -> length(L) < 80 end, List), + case lists:member(leading, Dots) of + true -> + true = lists:all(fun(L) -> + {"...", Rest} = lists:split(3, L), + check_trailing(Rest, ArityStr, + Suffix, Dots) + end, List); + false -> + true = lists:all(fun(L) -> + {Prefix, Rest} = + lists:split(length(Prefix), L), + check_trailing(Rest, ArityStr, + Suffix, Dots) + end, List) + end. + +check_trailing([I|Str], ArityStr, Suffix, Dots) -> + true = lists:member(I, [$1, $2]), + case lists:member(trailing, Dots) of + true -> + {Rest, "..." ++ ArityStr} = + lists:split(length(Str) - (3 + length(ArityStr)), Str), + true = lists:prefix(Rest, Suffix); + false -> + {Rest, ArityStr} = + lists:split(length(Str) - length(ArityStr), Str), + Rest =:= Suffix + end. + do_expand(String) -> edlin_expand:expand(lists:reverse(String)). diff --git a/lib/stdlib/test/filelib_SUITE.erl b/lib/stdlib/test/filelib_SUITE.erl index 4f8936edbf..87fba815d2 100644 --- a/lib/stdlib/test/filelib_SUITE.erl +++ b/lib/stdlib/test/filelib_SUITE.erl @@ -25,7 +25,8 @@ init_per_testcase/2,end_per_testcase/2, wildcard_one/1,wildcard_two/1,wildcard_errors/1, fold_files/1,otp_5960/1,ensure_dir_eexist/1,ensure_dir_symlink/1, - wildcard_symlink/1, is_file_symlink/1, file_props_symlink/1]). + wildcard_symlink/1, is_file_symlink/1, file_props_symlink/1, + find_source/1]). -import(lists, [foreach/2]). @@ -45,7 +46,8 @@ suite() -> all() -> [wildcard_one, wildcard_two, wildcard_errors, fold_files, otp_5960, ensure_dir_eexist, ensure_dir_symlink, - wildcard_symlink, is_file_symlink, file_props_symlink]. + wildcard_symlink, is_file_symlink, file_props_symlink, + find_source]. groups() -> []. @@ -503,3 +505,52 @@ file_props_symlink(Config) -> FileSize = filelib:file_size(Alias, erl_prim_loader), FileSize = filelib:file_size(Alias, prim_file) end. + +find_source(Config) when is_list(Config) -> + BeamFile = code:which(lists), + BeamName = filename:basename(BeamFile), + BeamDir = filename:dirname(BeamFile), + SrcName = filename:basename(BeamFile, ".beam") ++ ".erl", + + {ok, BeamFile} = filelib:find_file(BeamName, BeamDir), + {ok, BeamFile} = filelib:find_file(BeamName, BeamDir, []), + {ok, BeamFile} = filelib:find_file(BeamName, BeamDir, [{"",""},{"ebin","src"}]), + {error, not_found} = filelib:find_file(BeamName, BeamDir, [{"ebin","src"}]), + + {ok, SrcFile} = filelib:find_file(SrcName, BeamDir), + {ok, SrcFile} = filelib:find_file(SrcName, BeamDir, []), + {ok, SrcFile} = filelib:find_file(SrcName, BeamDir, [{"foo","bar"},{"ebin","src"}]), + {error, not_found} = filelib:find_file(SrcName, BeamDir, [{"",""}]), + + {ok, SrcFile} = filelib:find_source(BeamFile), + {ok, SrcFile} = filelib:find_source(BeamName, BeamDir), + {ok, SrcFile} = filelib:find_source(BeamName, BeamDir, + [{".erl",".yrl",[{"",""}]}, + {".beam",".erl",[{"ebin","src"}]}]), + {error, not_found} = filelib:find_source(BeamName, BeamDir, + [{".erl",".yrl",[{"",""}]}]), + + {ok, ParserErl} = filelib:find_source(code:which(erl_parse)), + {ok, ParserYrl} = filelib:find_source(ParserErl), + "lry." ++ _ = lists:reverse(ParserYrl), + {ok, ParserYrl} = filelib:find_source(ParserErl, + [{".beam",".erl",[{"ebin","src"}]}, + {".erl",".yrl",[{"",""}]}]), + + %% find_source automatically checks the local directory regardless of rules + {ok, ParserYrl} = filelib:find_source(ParserErl), + {ok, ParserYrl} = filelib:find_source(ParserErl, + [{".beam",".erl",[{"ebin","src"}]}]), + + %% find_file does not check the local directory unless in the rules + ParserYrlName = filename:basename(ParserYrl), + ParserYrlDir = filename:dirname(ParserYrl), + {ok, ParserYrl} = filelib:find_file(ParserYrlName, ParserYrlDir, + [{"",""}]), + {error, not_found} = filelib:find_file(ParserYrlName, ParserYrlDir, + [{"ebin","src"}]), + + %% local directory is in the default list for find_file + {ok, ParserYrl} = filelib:find_file(ParserYrlName, ParserYrlDir), + {ok, ParserYrl} = filelib:find_file(ParserYrlName, ParserYrlDir, []), + ok. diff --git a/lib/stdlib/test/filename_SUITE.erl b/lib/stdlib/test/filename_SUITE.erl index b7c4d3a6e5..54066021fb 100644 --- a/lib/stdlib/test/filename_SUITE.erl +++ b/lib/stdlib/test/filename_SUITE.erl @@ -421,8 +421,10 @@ t_nativename(Config) when is_list(Config) -> find_src(Config) when is_list(Config) -> {Source,_} = filename:find_src(file), ["file"|_] = lists:reverse(filename:split(Source)), - {_,_} = filename:find_src(init, [{".","."}, {"ebin","src"}]), - + {Source,_} = filename:find_src(file, [{"",""}, {"ebin","src"}]), + {Source,_} = filename:find_src(Source), + {Source,_} = filename:find_src(Source ++ ".erl"), + %% Try to find the source for a preloaded module. {error,{preloaded,init}} = filename:find_src(init), diff --git a/lib/stdlib/test/shell_SUITE.erl b/lib/stdlib/test/shell_SUITE.erl index 15ccdea284..4864bc3d72 100644 --- a/lib/stdlib/test/shell_SUITE.erl +++ b/lib/stdlib/test/shell_SUITE.erl @@ -282,7 +282,7 @@ restricted_local(Config) when is_list(Config) -> comm_err(<<"begin F=fun() -> hello end, foo(F) end.">>), "exception error: undefined shell command banan/1" = comm_err(<<"begin F=fun() -> hello end, banan(F) end.">>), - "{error,"++_ = t(<<"begin F=fun() -> hello end, c(F) end.">>), + "Recompiling "++_ = t(<<"c(shell_SUITE).">>), "exception exit: restricted shell does not allow l(" ++ _ = comm_err(<<"begin F=fun() -> hello end, l(F) end.">>), "exception error: variable 'F' is unbound" = diff --git a/lib/syntax_tools/src/igor.erl b/lib/syntax_tools/src/igor.erl index 72170ec5da..b92cd8d607 100644 --- a/lib/syntax_tools/src/igor.erl +++ b/lib/syntax_tools/src/igor.erl @@ -417,7 +417,7 @@ merge_files(Name, Files, Options) -> %% %% <dd>Specifies a list of rules for associating object files with %% source files, to be passed to the function -%% `filename:find_src/2'. This can be used to change the +%% `filelib:find_source/2'. This can be used to change the %% way Igor looks for source files. If this option is not specified, %% the default system rules are used. The first occurrence of this %% option completely overrides any later in the option list.</dd> @@ -462,7 +462,7 @@ merge_files(Name, Files, Options) -> %% @see merge/3 %% @see merge_files/3 %% @see merge_sources/3 -%% @see //stdlib/filename:find_src/2 +%% @see //stdlib/filelib:find_source/2 %% @see epp_dodger -spec merge_files(atom(), erl_syntax:forms(), [file:filename()], [option()]) -> @@ -2746,8 +2746,8 @@ read_module(Name, Options) -> %% It seems that we have no file - go on anyway, %% just to get a decent error message. read_module_1(Name, Options); - {Name1, _} -> - read_module_1(Name1 ++ ".erl", Options) + {ok, Name1} -> + read_module_1(Name1, Options) end end. @@ -2807,9 +2807,9 @@ check_forms([], _) -> ok. find_src(Name, undefined) -> - filename:find_src(filename(Name)); + filelib:find_source(filename(Name)); find_src(Name, Rules) -> - filename:find_src(filename(Name), Rules). + filelib:find_source(filename(Name), Rules). %% file_type(filename()) -> {value, Type} | none diff --git a/lib/tools/emacs/erlang-edoc.el b/lib/tools/emacs/erlang-edoc.el index 2801aa8ae7..d0dcc81028 100644 --- a/lib/tools/emacs/erlang-edoc.el +++ b/lib/tools/emacs/erlang-edoc.el @@ -36,7 +36,7 @@ "Tags that can be used anywhere within a module.") (defvar erlang-edoc-overview-tags - '("author" "copyright" "reference" "see" "since" "title" "version") + '("author" "copyright" "doc" "reference" "see" "since" "title" "version") "Tags that can be used in an overview file.") (defvar erlang-edoc-module-tags @@ -45,8 +45,8 @@ "Tags that can be used before a module declaration.") (defvar erlang-edoc-function-tags - '("deprecated" "doc" "equiv" "hidden" "private" "see" "since" "spec" - "throws" "type") + '("deprecated" "doc" "equiv" "hidden" "param" "private" "returns" + "see" "since" "spec" "throws" "type") "Tags that can be used before a function definition.") (defvar erlang-edoc-predefined-macros @@ -169,4 +169,10 @@ (jit-lock-refontify)) (provide 'erlang-edoc) + +;; Local variables: +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + ;;; erlang-edoc.el ends here diff --git a/lib/tools/emacs/erlang-eunit.el b/lib/tools/emacs/erlang-eunit.el index 3b85e6680a..38c40927f4 100644 --- a/lib/tools/emacs/erlang-eunit.el +++ b/lib/tools/emacs/erlang-eunit.el @@ -68,7 +68,7 @@ buffer and vice versa" ;;; (defun erlang-eunit-open-src-file-other-window (test-file-path) "Open the src file which corresponds to the an EUnit test file" - (find-file-other-window (erlang-eunit-src-filename test-file-path))) + (find-file-other-window (erlang-eunit-src-filename test-file-path))) ;;; Return the name and path of the EUnit test file ;;, (input may be either the source filename itself or the EUnit test filename) @@ -154,7 +154,7 @@ buffer and vice versa" ;;; Join filenames (defun filename-join (dir file) (if (or (= (elt file 0) ?/) - (= (car (last (append dir nil))) ?/)) + (= (car (last (append dir nil))) ?/)) (concat dir file) (concat dir "/" file))) @@ -299,7 +299,7 @@ With prefix arg, compiles for debug and runs tests with the verbose flag set." ;;; Compile source and EUnit test file and finally run EUnit tests for ;;; the current module (defun erlang-eunit-compile-and-test (test-fun test-args &optional under-cover) - "Compile the source and test files and run the EUnit test suite. + "Compile the source and test files and run the EUnit test suite. If under-cover is set to t, the module under test is compile for code coverage analysis. If under-cover is left out or not set, @@ -311,7 +311,7 @@ and the number of times each line is covered). With prefix arg, compiles for debug and runs tests with the verbose flag set." (erlang-eunit-record-recent-compile under-cover) (let ((src-filename (erlang-eunit-src-filename buffer-file-name)) - (test-filename (erlang-eunit-test-filename buffer-file-name))) + (test-filename (erlang-eunit-test-filename buffer-file-name))) ;; The purpose of out-maneuvering `save-some-buffers', as is done ;; below, is to ask the question about saving buffers only once, @@ -326,9 +326,9 @@ With prefix arg, compiles for debug and runs tests with the verbose flag set." ;; be placed in the source file instead. Any compilation error ;; will prevent the subsequent steps to be run (hence the `and') (and (erlang-eunit-compile-file src-filename under-cover) - (if (file-readable-p test-filename) - (erlang-eunit-compile-file test-filename) - t) + (if (file-readable-p test-filename) + (erlang-eunit-compile-file test-filename) + t) (apply test-fun test-args) (if under-cover (save-excursion @@ -381,16 +381,16 @@ With prefix arg, compiles for debug and runs tests with the verbose flag set." (goto-char compilation-parsing-end) (erlang-eunit-all-list-elems-fulfill-p (lambda (re) (let ((continue t) - (result t)) - (while continue ; ignore warnings, stop at errors - (if (re-search-forward re (point-max) t) - (if (erlang-eunit-is-compilation-warning) - t - (setq result nil) - (setq continue nil)) - (setq result t) - (setq continue nil))) - result)) + (result t)) + (while continue ; ignore warnings, stop at errors + (if (re-search-forward re (point-max) t) + (if (erlang-eunit-is-compilation-warning) + t + (setq result nil) + (setq continue nil)) + (setq result t) + (setq continue nil))) + result)) (mapcar (lambda (e) (car e)) erlang-error-regexp-alist)))) (defun erlang-eunit-is-compilation-warning () @@ -402,7 +402,7 @@ With prefix arg, compiles for debug and runs tests with the verbose flag set." (let ((matches-p t)) (while (and list matches-p) (if (not (funcall pred (car list))) - (setq matches-p nil)) + (setq matches-p nil)) (setq list (cdr list))) matches-p)) @@ -439,15 +439,21 @@ With prefix arg, compiles for debug and runs tests with the verbose flag set." (defun erlang-eunit-ensure-keymap-for-key (key-seq) (let ((prefix-keys (butlast (append key-seq nil))) - (prefix-seq "")) + (prefix-seq "")) (while prefix-keys (setq prefix-seq (concat prefix-seq (make-string 1 (car prefix-keys)))) (setq prefix-keys (cdr prefix-keys)) (if (not (keymapp (lookup-key (current-local-map) prefix-seq))) - (local-set-key prefix-seq (make-sparse-keymap)))))) + (local-set-key prefix-seq (make-sparse-keymap)))))) (add-hook 'erlang-mode-hook 'erlang-eunit-add-key-bindings) (provide 'erlang-eunit) -;; erlang-eunit ends here + +;; Local variables: +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;; erlang-eunit.el ends here diff --git a/lib/tools/emacs/erlang-pkg.el b/lib/tools/emacs/erlang-pkg.el index 4d0aa6fcd3..02d6bebbf4 100644 --- a/lib/tools/emacs/erlang-pkg.el +++ b/lib/tools/emacs/erlang-pkg.el @@ -1,3 +1,3 @@ (define-package "erlang" "2.7.0" - "Erlang major mode" - '()) + "Erlang major mode" + '((emacs "24.1"))) diff --git a/lib/tools/emacs/erlang-start.el b/lib/tools/emacs/erlang-start.el index 160057e179..c35f280bf4 100644 --- a/lib/tools/emacs/erlang-start.el +++ b/lib/tools/emacs/erlang-start.el @@ -39,7 +39,7 @@ ;; ;; Please state as exactly as possible: ;; - Version number of Erlang Mode (see the menu), Emacs, Erlang, -;; and of any other relevant software. +;; and of any other relevant software. ;; - What the expected result was. ;; - What you did, preferably in a repeatable step-by-step form. ;; - A description of the unexpected result. @@ -60,7 +60,7 @@ ;; (autoload 'erlang-mode "erlang" "Major mode for editing Erlang code." t) -(autoload 'erlang-version "erlang" +(autoload 'erlang-version "erlang" "Return the current version of Erlang mode." t) (autoload 'erlang-shell "erlang" "Start a new Erlang shell." t) (autoload 'run-erlang "erlang" "Start a new Erlang shell." t) @@ -68,7 +68,7 @@ (autoload 'erlang-compile "erlang" "Compile Erlang module in current buffer." t) -(autoload 'erlang-man-module "erlang" +(autoload 'erlang-man-module "erlang" "Find manual page for MODULE." t) (autoload 'erlang-man-function "erlang" "Find manual page for NAME, where NAME is module:function." t) @@ -108,25 +108,22 @@ A function suitable for `eldoc-documentation-function'.\n\n(fn)" nil nil) ;; ;; Associate files using interpreter "escript" with Erlang mode. -;; +;; ;;;###autoload (add-to-list 'interpreter-mode-alist (cons "escript" 'erlang-mode)) ;; ;; Ignore files ending in ".jam", ".vee", and ".beam" when performing -;; file completion. +;; file completion and in dired omit mode. ;; ;;;###autoload (let ((erl-ext '(".jam" ".vee" ".beam"))) (while erl-ext - (let ((cie completion-ignored-extensions)) - (while (and cie (not (string-equal (car cie) (car erl-ext)))) - (setq cie (cdr cie))) - (if (null cie) - (setq completion-ignored-extensions - (cons (car erl-ext) completion-ignored-extensions)))) + (add-to-list 'completion-ignored-extensions (car erl-ext)) + (when (boundp 'dired-omit-extensions) + (add-to-list 'dired-omit-extensions (car erl-ext))) (setq erl-ext (cdr erl-ext)))) @@ -136,4 +133,9 @@ A function suitable for `eldoc-documentation-function'.\n\n(fn)" nil nil) (provide 'erlang-start) +;; Local variables: +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + ;; erlang-start.el ends here. diff --git a/lib/tools/emacs/erlang-test.el b/lib/tools/emacs/erlang-test.el index ba6190d194..ea5d637199 100644 --- a/lib/tools/emacs/erlang-test.el +++ b/lib/tools/emacs/erlang-test.el @@ -2,7 +2,7 @@ ;;; Unit tests for erlang.el. -;; Author: Johan Claesson +;; Author: Johan Claesson ;; Created: 2016-05-07 ;; Keywords: erlang, languages @@ -28,6 +28,27 @@ ;;; Commentary: ;; This library require GNU Emacs 25 or later. +;; +;; There are two ways to run emacs unit tests. +;; +;; 1. Within a running emacs process. Load this file. Then to run +;; all defined test cases: +;; +;; M-x ert RET t RET +;; +;; To run only the erlang test cases: +;; +;; M-x ert RET "^erlang" RET +;; +;; +;; 2. In a new stand-alone emacs process. This process exits +;; when it executed the tests. For example: +;; +;; emacs -Q -batch -L . -l erlang.el -l erlang-test.el \ +;; -f ert-run-tests-batch-and-exit +;; +;; The -L option adds a directory to the load-path. It should be the +;; directory containing erlang.el and erlang-test.el. ;;; Code: @@ -59,11 +80,12 @@ concatenated to form an erlang file to test on.") tags-file-name tags-table-list tags-table-set-list + tags-add-tables + tags-completion-table erlang-buffer erlang-mode-hook prog-mode-hook - erlang-shell-mode-hook - tags-add-tables) + erlang-shell-mode-hook) (unwind-protect (progn (setq-default tags-file-name nil) @@ -71,11 +93,14 @@ concatenated to form an erlang file to test on.") (erlang-test-create-erlang-file erlang-file) (erlang-test-compile-tags erlang-file tags-file) (setq erlang-buffer (find-file-noselect erlang-file)) - (with-current-buffer erlang-buffer - (setq-local tags-file-name tags-file)) - ;; Setting global tags-file-name is a workaround for - ;; GNU Emacs bug#23164. - (setq tags-file-name tags-file) + (if (< emacs-major-version 26) + (progn + (with-current-buffer erlang-buffer + (setq-local tags-file-name tags-file)) + ;; Setting global tags-file-name is a workaround for + ;; GNU Emacs bug#23164. + (setq tags-file-name tags-file)) + (visit-tags-table tags-file t)) (erlang-test-complete-at-point tags-file) (erlang-test-completion-table) (erlang-test-xref-find-definitions erlang-file erlang-buffer)) @@ -117,12 +142,20 @@ concatenated to form an erlang file to test on.") for line = 1 then (1+ line) do (when tagname (switch-to-buffer erlang-buffer) - (xref-find-definitions tagname) - (erlang-test-verify-pos erlang-file line) - (xref-find-definitions (concat "erlang_test:" tagname)) - (erlang-test-verify-pos erlang-file line))) - (xref-find-definitions "erlang_test:") - (erlang-test-verify-pos erlang-file 1)) + (erlang-test-xref-jump tagname erlang-file line) + (erlang-test-xref-jump (concat "erlang_test:" tagname) + erlang-file line))) + (erlang-test-xref-jump "erlang_test:" erlang-file 1)) + +(defun erlang-test-xref-jump (id expected-file expected-line) + (goto-char (point-max)) + (insert "\n%% " id) + (save-buffer) + (if (fboundp 'xref-find-definitions) + (xref-find-definitions (erlang-id-to-string + (erlang-get-identifier-at-point))) + (error "xref-find-definitions not defined (too old emacs?)")) + (erlang-test-verify-pos expected-file expected-line)) (defun erlang-test-verify-pos (expected-file expected-line) (should (string-equal (file-truename expected-file) @@ -136,13 +169,13 @@ concatenated to form an erlang file to test on.") (setq-local tags-file-name tags-file) (insert "\nerlang_test:fun") (erlang-complete-tag) - (should (looking-back "erlang_test:function")) + (should (looking-back "erlang_test:function" (point-at-bol))) (insert "\nfun") (erlang-complete-tag) - (should (looking-back "function")) + (should (looking-back "function" (point-at-bol))) (insert "\nerlang_") (erlang-complete-tag) - (should (looking-back "erlang_test:")))) + (should (looking-back "erlang_test:" (point-at-bol))))) (ert-deftest erlang-test-compile-options () @@ -179,6 +212,30 @@ concatenated to form an erlang file to test on.") erlang)) +(ert-deftest erlang-test-parse-id () + (cl-loop for id-string in '("fun/10" + "qualified-function module:fun/10" + "record reko" + "macro _SYMBOL" + "macro MACRO/10" + "module modula" + "macro" + nil) + for id-list in '((nil nil "fun" 10) + (qualified-function "module" "fun" 10) + (record nil "reko" nil) + (macro nil "_SYMBOL" nil) + (macro nil "MACRO" 10) + (module nil "modula" nil) + (nil nil "macro" nil) + nil) + for id-list2 = (erlang-id-to-list id-string) + do (should (equal id-list id-list2)) + for id-string2 = (erlang-id-to-string id-list) + do (should (equal id-string id-string2)) + collect id-list2)) + + (provide 'erlang-test) ;;; erlang-test.el ends here diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el index 51f7e8e26c..59b20c552e 100644 --- a/lib/tools/emacs/erlang.el +++ b/lib/tools/emacs/erlang.el @@ -4,6 +4,8 @@ ;; Author: Anders Lindgren ;; Keywords: erlang, languages, processes ;; Date: 2011-12-11 +;; Version: 2.7.0 +;; Package-Requires: ((emacs "24.1")) ;; %CopyrightBegin% ;; @@ -24,7 +26,7 @@ ;; %CopyrightEnd% ;; -;; Lars Thors�n's modifications of 2000-06-07 included. +;; Lars Thorsén's modifications of 2000-06-07 included. ;; The original version of this package was written by Robert Virding. ;; ;;; Commentary: @@ -85,30 +87,15 @@ (defconst erlang-version "2.7" "The version number of Erlang mode.") -(defvar erlang-root-dir nil +(defcustom erlang-root-dir nil "The directory where the Erlang system is installed. The name should not contain the trailing slash. Should this variable be nil, no manual pages will show up in the -Erlang mode menu.") - -(eval-and-compile - (defconst erlang-emacs-major-version - (if (boundp 'emacs-major-version) - emacs-major-version - (string-match "\\([0-9]+\\)\\.\\([0-9]+\\)" emacs-version) - (erlang-string-to-int (substring emacs-version - (match-beginning 1) (match-end 1)))) - "Major version number of Emacs.")) - -(eval-and-compile - (defconst erlang-emacs-minor-version - (if (boundp 'emacs-minor-version) - emacs-minor-version - (string-match "\\([0-9]+\\)\\.\\([0-9]+\\)" emacs-version) - (erlang-string-to-int (substring emacs-version - (match-beginning 2) (match-end 2)))) - "Minor version number of Emacs.")) +Erlang mode menu." + :group 'erlang + :type '(restricted-sexp :match-alternatives (stringp 'nil)) + :safe (lambda (val) (or (eq nil val) (stringp val)))) (defconst erlang-xemacs-p (string-match "Lucid\\|XEmacs" emacs-version) "Non-nil when running under XEmacs or Lucid Emacs.") @@ -129,7 +116,7 @@ Never EVER set this variable!") erlang-menu-man-items erlang-menu-personal-items erlang-menu-version-items) - "*List of menu item list to combine to create Erlang mode menu. + "List of menu item list to combine to create Erlang mode menu. External programs which temporarily add menu items to the Erlang mode menu may use this variable. Please use the function `add-hook' to add @@ -238,7 +225,7 @@ This variable is added to the list of Erlang menus stored in The menu is in the form described by the variable `erlang-menu-base-items'.") (defvar erlang-mode-hook nil - "*Functions to run when Erlang mode is activated. + "Functions to run when Erlang mode is activated. This hook is used to change the behaviour of Erlang mode. It is normally used by the user to personalise the programming environment. @@ -272,7 +259,7 @@ To use the example, copy the following lines to your `~/.emacs' file: (imenu-add-to-menubar \"Imenu\")))") (defvar erlang-load-hook nil - "*Functions to run when Erlang mode is loaded. + "Functions to run when Erlang mode is loaded. This hook is used to change the behaviour of Erlang mode. It is normally used by the user to personalise the programming environment. @@ -304,17 +291,20 @@ manual pages can be retrieved (note that you must set the value of A useful function is `tempo-template-erlang-normal-header'. \(This function only exists when the `tempo' package is available.)") -(defvar erlang-check-module-name 'ask - "*Non-nil means check that module name and file name agrees when saving. +(defcustom erlang-check-module-name 'ask + "Non-nil means check that module name and file name agrees when saving. -If the value of this variable is the atom `ask', the user is -prompted. If the value is t the source is silently changed.") +If the value of this variable is the symbol `ask', the user is +prompted. If the value is t the source is silently changed." + :group 'erlang + :type '(choice (const :tag "Check on save" 'ask) + (const :tag "Don't check on save" t))) (defvar erlang-electric-commands '(erlang-electric-comma erlang-electric-semicolon erlang-electric-gt) - "*List of activated electric commands. + "List of activated electric commands. The list should contain the electric commands which should be active. Currently, the available electric commands are: @@ -328,8 +318,8 @@ are activated. To deactivate all electric commands, set this variable to nil.") -(defvar erlang-electric-newline-inhibit t - "*Set to non-nil to inhibit newline after electric command. +(defcustom erlang-electric-newline-inhibit t + "Set to non-nil to inhibit newline after electric command. This is useful since a lot of people press return after executing an electric command. @@ -339,28 +329,32 @@ list `erlang-electric-newline-inhibit-list'. Note that commands in this list are required to set the variable `erlang-electric-newline-inhibit' to nil when the newline shouldn't be -inhibited.") +inhibited." + :group 'erlang + :type 'boolean + :safe 'booleanp) (defvar erlang-electric-newline-inhibit-list '(erlang-electric-semicolon erlang-electric-comma erlang-electric-gt) - "*Commands which can inhibit the next newline.") + "Commands which can inhibit the next newline.") -(defvar erlang-electric-semicolon-insert-blank-lines nil - "*Number of blank lines inserted before header, or nil. +(defcustom erlang-electric-semicolon-insert-blank-lines nil + "Number of blank lines inserted before header, or nil. This variable controls the behaviour of `erlang-electric-semicolon' when a new function header is generated. When nil, no blank line is inserted between the current line and the new header. When bound to a number it represents the number of blank lines which should be -inserted.") +inserted." + :group 'erlang) (defvar erlang-electric-semicolon-criteria '(erlang-next-lines-empty-p erlang-at-keyword-end-p erlang-at-end-of-function-p) - "*List of functions controlling `erlang-electric-semicolon'. + "List of functions controlling `erlang-electric-semicolon'. The functions in this list are called, in order, whenever a semicolon is typed. Each function in the list is called with no arguments, and should return one of the following values: @@ -381,7 +375,7 @@ The test is performed by the function `erlang-test-criteria-list'.") erlang-at-keyword-end-p erlang-at-end-of-clause-p erlang-at-end-of-function-p) - "*List of functions controlling `erlang-electric-comma'. + "List of functions controlling `erlang-electric-comma'. The functions in this list are called, in order, whenever a comma is typed. Each function in the list is called with no arguments, and should return one of the following values: @@ -399,7 +393,7 @@ The test is performed by the function `erlang-test-criteria-list'.") '(erlang-stop-when-in-type-spec erlang-next-lines-empty-p erlang-at-end-of-function-p) - "*List of functions controlling the arrow aspect of `erlang-electric-gt'. + "List of functions controlling the arrow aspect of `erlang-electric-gt'. The functions in this list are called, in order, whenever a `>' is typed. Each function in the list is called with no arguments, and should return one of the following values: @@ -415,7 +409,7 @@ The test is performed by the function `erlang-test-criteria-list'.") (defvar erlang-electric-newline-criteria '(t) - "*List of functions controlling `erlang-electric-newline'. + "List of functions controlling `erlang-electric-newline'. The electric newline commands indents the next line. Should the current line begin with a comment the comment start is copied to @@ -435,8 +429,8 @@ list, it is treated as a function triggering the electric command. The test is performed by the function `erlang-test-criteria-list'.") -(defvar erlang-next-lines-empty-threshold 2 - "*Number of blank lines required to activate an electric command. +(defcustom erlang-next-lines-empty-threshold 2 + "Number of blank lines required to activate an electric command. Actually, this value controls the behaviour of the function `erlang-next-lines-empty-p' which normally is a member of the @@ -457,46 +451,67 @@ function `erlang-next-lines-empty-p' would be removed from the criteria lists. Note that even if `erlang-next-lines-empty-p' should not trigger an -electric command, other functions in the criteria list could.") +electric command, other functions in the criteria list could." + :group 'erlang + :type '(restricted-sexp :match-alternatives (integerp 'nil)) + :safe (lambda (val) (or (eq val nil) (integerp val)))) -(defvar erlang-new-clause-with-arguments nil - "*Non-nil means that the arguments are cloned when a clause is generated. +(defcustom erlang-new-clause-with-arguments nil + "Non-nil means that the arguments are cloned when a clause is generated. A new function header can be generated by calls to the function -`erlang-generate-new-clause' and by use of the electric semicolon.") +`erlang-generate-new-clause' and by use of the electric semicolon." + :group 'erlang + :type 'boolean + :safe 'booleanp) -(defvar erlang-compile-use-outdir t - "*When nil, go to the directory containing source file when compiling. +(defcustom erlang-compile-use-outdir t + "When nil, go to the directory containing source file when compiling. This is a workaround for a bug in the `outdir' option of compile. If the outdir is not in the current load path, Erlang doesn't load the object module after it has been compiled. To activate the workaround, place the following in your `~/.emacs' file: - (setq erlang-compile-use-outdir nil)") - -(defvar erlang-indent-level 4 - "*Indentation of Erlang calls/clauses within blocks.") -(put 'erlang-indent-level 'safe-local-variable 'integerp) - -(defvar erlang-icr-indent nil - "*Indentation of Erlang if/case/receive/ patterns. `nil' means - keeping default behavior. When non-nil, indent to th column of - if/case/receive.") - -(defvar erlang-indent-guard 2 - "*Indentation of Erlang guards.") -(put 'erlang-indent-guard 'safe-local-variable 'integerp) - -(defvar erlang-argument-indent 2 - "*Indentation of the first argument in a function call. + (setq erlang-compile-use-outdir nil)" + :group 'erlang + :type 'boolean + :safe 'booleanp) + +(defcustom erlang-indent-level 4 + "Indentation of Erlang calls/clauses within blocks." + :group 'erlang + :type 'integer + :safe 'integerp) + +(defcustom erlang-icr-indent nil + "Indentation of Erlang if/case/receive patterns. +nil means keeping default behavior. When non-nil, indent to the column of +if/case/receive." + :group 'erlang + :type 'boolean + :safe 'booleanp) + +(defcustom erlang-indent-guard 2 + "Indentation of Erlang guards." + :group 'erlang + :type 'integer + :safe 'integerp) + +(defcustom erlang-argument-indent 2 + "Indentation of the first argument in a function call. When nil, indent to the column after the `(' of the -function.") -(put 'erlang-argument-indent 'safe-local-variable '(lambda (val) (or (null val) (integerp val)))) - -(defvar erlang-tab-always-indent t - "*Non-nil means TAB in Erlang mode should always re-indent the current line, -regardless of where in the line point is when the TAB command is used.") +function." + :group 'erlang + :type '(restricted-sexp :match-alternatives (integerp 'nil)) + :safe (lambda (val) (or (eq val nil) (integerp val)))) + +(defcustom erlang-tab-always-indent t + "Non-nil means TAB in Erlang mode should always re-indent the current line, +regardless of where in the line point is when the TAB command is used." + :group 'erlang + :type 'boolean + :safe 'booleanp) (defvar erlang-man-inhibit (eq system-type 'windows-nt) "Inhibit the creation of the Erlang Manual Pages menu. @@ -509,7 +524,7 @@ there is no attempt to create the menu.") ("Man - Modules" "/man/man3" t) ("Man - Files" "/man/man4" t) ("Man - Applications" "/man/man6" t)) - "*The man directories displayed in the Erlang menu. + "The man directories displayed in the Erlang menu. Each item in the list should be a list with three elements, the first the name of the menu, the second the directory, and the last a flag. @@ -517,17 +532,17 @@ Should the flag the nil, the directory is absolute, should it be non-nil the directory is relative to the variable `erlang-root-dir'.") (defvar erlang-man-max-menu-size 35 - "*The maximum number of menu items in one menu allowed.") + "The maximum number of menu items in one menu allowed.") (defvar erlang-man-display-function 'erlang-man-display - "*Function used to display man page. + "Function used to display man page. The function is called with one argument, the name of the file containing the man page. Use this variable when the default function, `erlang-man-display', does not work on your system.") (defvar erlang-compile-extra-opts '() - "*Additional options to the compilation command. + "Additional options to the compilation command. This is an elisp list of options. Each option can be either: - an atom - a dotted pair @@ -539,7 +554,7 @@ Example: '(bin_opt_info (i . \"/path1/include\") (i . \"/path2/include\"))") (".xrl\\'" . inferior-erlang-compute-leex-compile-command) (".yrl\\'" . inferior-erlang-compute-yecc-compile-command) ("." . inferior-erlang-compute-erl-compile-command)) - "*Alist of filename patterns vs corresponding compilation functions. + "Alist of filename patterns vs corresponding compilation functions. Each element looks like (REGEXP . FUNCTION). Compiling a file whose name matches REGEXP specifies FUNCTION to use to compute the compilation command. The FUNCTION will be called with two arguments: module name and @@ -547,14 +562,14 @@ default compilation options, like output directory. The FUNCTION is expected to return a string.") (defvar erlang-leex-compile-opts '() - "*Options to pass to leex when compiling xrl files. + "Options to pass to leex when compiling xrl files. This is an elisp list of options. Each option can be either: - an atom - a dotted pair - a string") (defvar erlang-yecc-compile-opts '() - "*Options to pass to yecc when compiling yrl files. + "Options to pass to yecc when compiling yrl files. This is an elisp list of options. Each option can be either: - an atom - a dotted pair @@ -562,7 +577,7 @@ This is an elisp list of options. Each option can be either: (eval-and-compile (defvar erlang-regexp-modern-p - (if (> erlang-emacs-major-version 21) t nil) + (if (> emacs-major-version 21) t nil) "Non-nil when this version of Emacs uses a modern version of regexp. Supporting \_< and \_> This is determined by checking the version of Emacs used.")) @@ -608,6 +623,24 @@ The regexp must be surrounded with a pair of regexp parentheses.")) This is used to determine matches in complex regexps which contains `erlang-variable-regexp'.")) +(defconst erlang-module-function-regexp + (eval-when-compile + (concat erlang-atom-regexp ":" erlang-atom-regexp)) + "Regexp matching an erlang module:function.") + +(defconst erlang-name-regexp + (concat "\\(" + "\\(?:\\sw\\|\\s_\\)+" + "\\|" + erlang-atom-quoted-regexp + "\\)") + "Matches a name of a function, macro or record") + +(defconst erlang-id-regexp + (concat "\\(?:\\(qualified-function\\|record\\|macro\\|module\\) \\)?" + "\\(?:" erlang-atom-regexp ":\\)?" + erlang-name-regexp "?" + "\\(?:/\\([0-9]+\\)\\)?")) (eval-and-compile (defun erlang-regexp-opt (strings &optional paren) @@ -983,7 +1016,7 @@ resulting regexp is surrounded by \\_< and \\_>." "Regexp which should match beginning of a clause.") (defvar erlang-file-name-extension-regexp "\\.erl$" - "*Regexp which should match an Erlang file name. + "Regexp which should match an Erlang file name. This regexp is used when an Erlang module name is extracted from the name of an Erlang source file. @@ -997,7 +1030,7 @@ tags system should interpret tags on the form `module:tag' for files written in other languages than Erlang.") (defvar erlang-inferior-shell-split-window t - "*If non-nil, when starting an inferior shell, split windows. + "If non-nil, when starting an inferior shell, split windows. If nil, the inferior shell replaces the window. This is the traditional behaviour.") @@ -1043,7 +1076,7 @@ behaviour.") (unless inferior-erlang-use-cmm (define-key map "\C-x`" 'erlang-next-error)) map) - "*Keymap used in Erlang mode.") + "Keymap used in Erlang mode.") (defvar erlang-mode-abbrev-table nil "Abbrev table in use in Erlang-mode buffers.") (defvar erlang-mode-syntax-table nil @@ -1310,29 +1343,6 @@ replaced by `erlang-etags-tags-completion-table'.") ;;; Avoid errors while compiling this file. -;; `eval-when-compile' is not defined in Emacs 18. We define it as a -;; no-op. -(or (fboundp 'eval-when-compile) - (defmacro eval-when-compile (&rest rest) nil)) - -;; These umm...functions are new in Emacs 20. And, yes, until version -;; 19.27 Emacs backquotes were this ugly. - -(or (fboundp 'unless) - (defmacro unless (condition &rest body) - "(unless CONDITION BODY...): If CONDITION is false, do BODY, else return nil." - `((if (, condition) nil ,@body)))) - -(or (fboundp 'when) - (defmacro when (condition &rest body) - "(when CONDITION BODY...): If CONDITION is true, do BODY, else return nil." - `((if (, condition) (progn ,@body) nil)))) - -(or (fboundp 'char-before) - (defmacro char-before (&optional pos) - "Return the character in the current buffer just before POS." - `( (char-after (1- (or ,pos (point))))))) - ;; defvar some obsolete variables, which we still support for ;; backwards compatibility reasons. (eval-when-compile @@ -1360,20 +1370,11 @@ replaced by `erlang-etags-tags-completion-table'.") (defun erlang-version () "Return the current version of Erlang mode." (interactive) - (if (erlang-interactive-p) + (if (called-interactively-p 'interactive) (message "Erlang mode version %s, written by Anders Lindgren" erlang-version)) erlang-version) -(defun erlang-interactive-p () - (if (fboundp 'called-interactively-p) - (called-interactively-p 'interactive) - (funcall (symbol-function 'interactive-p)))) - -(unless (fboundp 'prog-mode) - (defun prog-mode () - (use-local-map (make-keymap)))) - ;;;###autoload (define-derived-mode erlang-mode prog-mode "Erlang" "Major mode for editing Erlang source files in Emacs. @@ -1462,40 +1463,43 @@ Other commands: (add-to-list 'auto-mode-alist (cons r 'erlang-mode))) (defun erlang-syntax-table-init () - (if (null erlang-mode-syntax-table) - (let ((table (make-syntax-table))) - (modify-syntax-entry ?\n ">" table) - (modify-syntax-entry ?\" "\"" table) - (modify-syntax-entry ?# "." table) - ;; (modify-syntax-entry ?$ "\\" table) ;; Creates problems with indention afterwards - ;; (modify-syntax-entry ?$ "'" table) ;; Creates syntax highlighting and indention problems - (modify-syntax-entry ?$ "/" table) ;; Misses the corner case "string that ends with $" - ;; we have to live with that for now..it is the best alternative - ;; that can be worked around with "string hat ends with \$" - (modify-syntax-entry ?% "<" table) - (modify-syntax-entry ?& "." table) - (modify-syntax-entry ?\' "\"" table) - (modify-syntax-entry ?* "." table) - (modify-syntax-entry ?+ "." table) - (modify-syntax-entry ?- "." table) - (modify-syntax-entry ?/ "." table) - (modify-syntax-entry ?: "." table) - (modify-syntax-entry ?< "." table) - (modify-syntax-entry ?= "." table) - (modify-syntax-entry ?> "." table) - (modify-syntax-entry ?\\ "\\" table) - (modify-syntax-entry ?_ "_" table) - (modify-syntax-entry ?| "." table) - (modify-syntax-entry ?^ "'" table) - - ;; Pseudo bit-syntax: Latin1 double angle quotes as parens. - ;;(modify-syntax-entry ?\253 "(?\273" table) - ;;(modify-syntax-entry ?\273 ")?\253" table) - - (setq erlang-mode-syntax-table table))) - + (erlang-ensure-syntax-table-is-initialized) (set-syntax-table erlang-mode-syntax-table)) +(defun erlang-ensure-syntax-table-is-initialized () + (unless erlang-mode-syntax-table + (let ((table (make-syntax-table))) + (modify-syntax-entry ?\n ">" table) + (modify-syntax-entry ?\" "\"" table) + (modify-syntax-entry ?# "." table) + ;; (modify-syntax-entry ?$ "\\" table) ;; Creates problems with indention afterwards + ;; (modify-syntax-entry ?$ "'" table) ;; Creates syntax highlighting and indention problems + (modify-syntax-entry ?$ "/" table) ;; Misses the corner case "string that ends with $" + ;; we have to live with that for now..it is the best alternative + ;; that can be worked around with "string that ends with \$" + (modify-syntax-entry ?% "<" table) + (modify-syntax-entry ?& "." table) + (modify-syntax-entry ?\' "\"" table) + (modify-syntax-entry ?* "." table) + (modify-syntax-entry ?+ "." table) + (modify-syntax-entry ?- "." table) + (modify-syntax-entry ?/ "." table) + (modify-syntax-entry ?: "." table) + (modify-syntax-entry ?< "." table) + (modify-syntax-entry ?= "." table) + (modify-syntax-entry ?> "." table) + (modify-syntax-entry ?\\ "\\" table) + (modify-syntax-entry ?_ "_" table) + (modify-syntax-entry ?| "." table) + (modify-syntax-entry ?^ "'" table) + + ;; Pseudo bit-syntax: Latin1 double angle quotes as parens. + ;;(modify-syntax-entry ?\253 "(?\273" table) + ;;(modify-syntax-entry ?\273 ")?\253" table) + + (setq erlang-mode-syntax-table table)))) + + (defun erlang-electric-init () ;; Set up electric character functions to work with @@ -1541,7 +1545,7 @@ Other commands: (make-local-variable 'indent-region-function) (setq indent-region-function 'erlang-indent-region) (set (make-local-variable 'comment-indent-function) 'erlang-comment-indent) - (if (<= erlang-emacs-major-version 18) + (if (<= emacs-major-version 18) (set (make-local-variable 'comment-indent-hook) 'erlang-comment-indent)) (set (make-local-variable 'parse-sexp-ignore-comments) t) (set (make-local-variable 'dabbrev-case-fold-search) nil) @@ -1778,7 +1782,7 @@ Please see the variable `erlang-menu-base-items'." (if (and popup (boundp 'mode-popup-menu)) (funcall (symbol-function 'set) 'mode-popup-menu erlang-xemacs-popup-menu)))) - ((>= erlang-emacs-major-version 19) + ((>= emacs-major-version 19) (define-key keymap (vector 'menu-bar (intern name)) (erlang-menu-make-keymap name items))) (t nil))) @@ -1961,7 +1965,9 @@ menu is left unchanged." The variable `erlang-man-dirs' contains entries describing the location of the manual pages." (interactive) - (if erlang-man-inhibit + (if (or erlang-man-inhibit + (and (boundp 'menu-bar-mode) + (not menu-bar-mode))) () (setq erlang-menu-man-items '(nil @@ -2000,7 +2006,7 @@ The format is described in the documentation of `erlang-man-dirs'." (setq dir (cond ((nth 2 (car dir-list)) ;; Relative to `erlang-root-dir'. (and (stringp erlang-root-dir) - (concat erlang-root-dir (nth 1 (car dir-list))))) + (erlang-man-dir (nth 1 (car dir-list))))) (t ;; Absolute (nth 1 (car dir-list))))) @@ -2018,6 +2024,8 @@ The format is described in the documentation of `erlang-man-dirs'." '(("Man Pages" (("Error! Why?" erlang-man-describe-error))))))) +(defun erlang-man-dir (subdir) + (concat erlang-root-dir "/lib/erlang/" subdir)) ;; Should the menu be to long, let's split it into a number of ;; smaller menus. Warning, this code contains beautiful @@ -2080,7 +2088,7 @@ menus is created." "Find manual page for MODULE, defaults to module of function under point. This function is aware of imported functions." (interactive - (list (let* ((mod (car-safe (erlang-get-function-under-point))) + (list (let* ((mod (erlang-default-module)) (input (read-string (format "Manual entry for module%s: " (if (or (null mod) (string= mod "")) @@ -2089,26 +2097,36 @@ This function is aware of imported functions." (if (string= input "") mod input)))) - (or module (setq module (car (erlang-get-function-under-point)))) - (if (or (null module) (string= module "")) - (error "No Erlang module name given")) + (setq module (or module + (erlang-default-module))) + (when (or (null module) (string= module "")) + (error "No Erlang module name given")) (let ((dir-list erlang-man-dirs) - (pat (concat "/" (regexp-quote module) "\\.\\([124-9]\\|3\\(erl\\)?\\)\\(\\.gz\\)?$")) + (pat (concat "/" (regexp-quote module) + "\\.\\([124-9]\\|3\\(erl\\)?\\)\\(\\.gz\\)?$")) (file nil) file-list) (while (and dir-list (null file)) - (setq file-list (erlang-man-get-files - (if (nth 2 (car dir-list)) - (concat erlang-root-dir (nth 1 (car dir-list))) - (nth 1 (car dir-list))))) - (while (and file-list (null file)) - (if (string-match pat (car file-list)) - (setq file (car file-list))) - (setq file-list (cdr file-list))) - (setq dir-list (cdr dir-list))) + (let ((dir (if (nth 2 (car dir-list)) + (erlang-man-dir (nth 1 (car dir-list))) + (nth 1 (car dir-list))))) + (when (file-directory-p dir) + (setq file-list (erlang-man-get-files dir)) + (while (and file-list (null file)) + (if (string-match pat (car file-list)) + (setq file (car file-list))) + (setq file-list (cdr file-list)))) + (setq dir-list (cdr dir-list)))) (if file (funcall erlang-man-display-function file) - (error "No manual page for module %s found" module)))) + ;; Did not found the manual file. Fallback to manual-entry. + (manual-entry module)))) + +(defun erlang-default-module () + (let ((id (erlang-get-identifier-at-point))) + (if (eq (erlang-id-kind id) 'qualified-function) + (erlang-id-module id) + (erlang-id-name id)))) ;; Warning, the function `erlang-man-function' is a hack! @@ -2128,37 +2146,28 @@ The entry for `function' is displayed. This function is aware of imported functions." (interactive - (list (let* ((mod-func (erlang-get-function-under-point)) - (mod (car-safe mod-func)) - (func (nth 1 mod-func)) + (list (let* ((default (erlang-default-function-or-module)) (input (read-string (format "Manual entry for `module:func' or `module'%s: " - (if (or (null mod) (string= mod "")) - "" - (format " (default %s:%s)" mod func)))))) + (if default + (format " (default %s)" default) + ""))))) (if (string= input "") - (if (and mod func) - (concat mod ":" func) - mod) + default input)))) - ;; Emacs 18 doesn't provide `man'... - (condition-case nil - (require 'man) - (error nil)) + (require 'man) + (setq name (or name + (erlang-default-function-or-module))) (let ((modname nil) (funcname nil)) - (cond ((null name) - (let ((mod-func (erlang-get-function-under-point))) - (setq modname (car-safe mod-func)) - (setq funcname (nth 1 mod-func)))) - ((string-match ":" name) + (cond ((string-match ":" name) (setq modname (substring name 0 (match-beginning 0))) (setq funcname (substring name (match-end 0) nil))) ((stringp name) (setq modname name))) - (if (or (null modname) (string= modname "")) - (error "No Erlang module name given")) + (when (or (null modname) (string= modname "")) + (error "No Erlang module name given")) (cond ((fboundp 'Man-notify-when-ready) ;; Emacs 19: The man command could possibly start an ;; asynchronous process, i.e. we must hook ourselves into @@ -2168,16 +2177,20 @@ This function is aware of imported functions." () (erlang-man-patch-notify) (setq erlang-man-function-name funcname)) - (condition-case nil + (condition-case err (erlang-man-module modname) - (error (setq erlang-man-function-name nil)))) + (error (setq erlang-man-function-name nil) + (signal (car err) (cdr err))))) (t (erlang-man-module modname) - (if funcname - (erlang-man-find-function - (or (get-buffer "*Manual Entry*") ; Emacs 18 - (current-buffer)) ; XEmacs - funcname)))))) + (when funcname + (erlang-man-find-function (current-buffer) funcname)))))) + +(defun erlang-default-function-or-module () + (let ((id (erlang-get-identifier-at-point))) + (if (eq (erlang-id-kind id) 'qualified-function) + (format "%s:%s" (erlang-id-module id) (erlang-id-name id)) + (erlang-id-name id)))) ;; Should the defadvice be at the top level, the package `advice' would @@ -2222,36 +2235,22 @@ command is executed asynchronously." (set-window-point win (point))) (message "Could not find function `%s'" func))))))) +(defvar erlang-man-file-regexp + "\\(.*\\)/man[^/]*/\\([^.]+\\)\\.\\([124-9]\\|3\\(erl\\)?\\)\\(\\.gz\\)?$") (defun erlang-man-display (file) "Display FILE as a `man' file. This is the default manual page display function. The variables `erlang-man-display-function' contains the function to be used." - ;; Emacs 18 doesn't `provide' man. - (condition-case nil - (require 'man) - (error nil)) + (require 'man) (if file (let ((process-environment (copy-sequence process-environment))) - (if (string-match "\\(.*\\)/man[^/]*/\\([^.]+\\)\\.\\([124-9]\\|3\\(erl\\)?\\)\\(\\.gz\\)?$" file) + (if (string-match erlang-man-file-regexp file) (let ((dir (substring file (match-beginning 1) (match-end 1))) (page (substring file (match-beginning 2) (match-end 2)))) - (if (fboundp 'setenv) - (setenv "MANPATH" dir) - ;; Emacs 18 - (setq process-environment (cons (concat "MANPATH=" dir) - process-environment))) - (cond ((not (and (not erlang-xemacs-p) - (= erlang-emacs-major-version 19) - (< erlang-emacs-minor-version 29))) - (manual-entry page)) - (t - ;; Emacs 19.28 and earlier versions of 19: - ;; The manual-entry command unconditionally prompts - ;; the user :-( - (funcall (symbol-function 'Man-getpage-in-background) - page)))) + (setenv "MANPATH" dir) + (manual-entry page)) (error "Can't find man page for %s\n" file))))) @@ -2394,7 +2393,7 @@ can contain other `tempo' attributes. Please see the function The first character of DD is space if the value is less than 10." (let ((date (current-time-string))) (format "%2d %s %s" - (erlang-string-to-int (substring date 8 10)) + (string-to-number (substring date 8 10)) (substring date 4 7) (substring date -4)))) @@ -2956,10 +2955,10 @@ Return nil if inside string, t if in a comment." ((eq (car stack-top) '->) ;; If in fun definition use standard indent level not double ;;(if (not (eq (car (car (cdr stack))) 'fun)) - ;; Removed it made multi clause fun's look to bad + ;; Removed it made multi clause fun's look too bad (setq off (+ erlang-indent-level (if (not erlang-icr-indent) erlang-indent-level - erlang-icr-indent))))) + erlang-icr-indent))))) (let ((base (erlang-indent-find-base stack indent-point off skip))) ;; Special cases (goto-char indent-point) @@ -3597,7 +3596,7 @@ corresponds to the order of the parsed Erlang list." (erlang-remove-quotes (erlang-buffer-substring (match-beginning 1) (match-end 1))) - (erlang-string-to-int + (string-to-number (erlang-buffer-substring (match-beginning (+ 1 erlang-atom-regexp-matches)) @@ -3696,34 +3695,50 @@ Normally used in conjunction with `erlang-beginning-of-clause', e.g.: (defun erlang-get-function-arity () "Return the number of arguments of function at point, or nil." - (and (looking-at (eval-when-compile - (concat "^" erlang-atom-regexp "\\s *("))) - (save-excursion - (goto-char (match-end 0)) - (condition-case nil - (let ((res 0) - (cont t)) - (while cont - (cond ((eobp) - (setq res nil) - (setq cont nil)) - ((looking-at "\\s *)") - (setq cont nil)) - ((looking-at "\\s *\\($\\|%\\)") - (forward-line 1)) - ((looking-at "\\s *<<[^>]*?>>") - (when (zerop res) - (setq res (+ 1 res))) - (goto-char (match-end 0))) - ((looking-at "\\s *,") - (setq res (+ 1 res)) - (goto-char (match-end 0))) - (t - (when (zerop res) - (setq res (+ 1 res))) - (forward-sexp 1)))) - res) - (error nil))))) + (erlang-get-arity-after-regexp (concat "^" erlang-atom-regexp "\\s *("))) + +(defun erlang-get-argument-list-arity () + "Return the number of arguments in argument list at point, or nil. +The point should be before the opening parenthesis of the +argument list before calling this function." + (erlang-get-arity-after-regexp "\\s *(")) + +(defun erlang-get-arity-after-regexp (regexp) + "Return the number of arguments in argument list after REGEXP, or nil." + (when (looking-at regexp) + (save-excursion + (goto-char (match-end 0)) + (erlang-get-arity)))) + +(defun erlang-get-arity () + "Return the number of arguments in argument list at point, or nil. +The point should be after the opening parenthesis of the argument +list before calling this function." + (condition-case nil + (let ((res 0) + (cont t)) + (while cont + (cond ((eobp) + (setq res nil) + (setq cont nil)) + ((looking-at "\\s *)") + (setq cont nil)) + ((looking-at "\\s *\\($\\|%\\)") + (forward-line 1)) + ((looking-at "\\s *<<[^>]*?>>") + (when (zerop res) + (setq res (+ 1 res))) + (goto-char (match-end 0))) + ((looking-at "\\s *,") + (setq res (+ 1 res)) + (goto-char (match-end 0))) + (t + (when (zerop res) + (setq res (+ 1 res))) + (forward-sexp 1)))) + res) + (error nil))) + (defun erlang-get-function-name-and-arity () "Return the name and arity of the function at point, or nil. @@ -3746,6 +3761,8 @@ The return value is a string of the form \"foo/1\"." (error nil))))) +;; Keeping erlang-get-function-under-point for backward compatibility. +;; It is used by erldoc.el and maybe other code out there. (defun erlang-get-function-under-point () "Return the module and function under the point, or nil. @@ -3755,44 +3772,141 @@ list of imported functions is searched. The following could be returned: (\"module\" \"function\") -- Both module and function name found. (nil \"function\") -- No module name was found. - nil -- No function name found + nil -- No function name found. + +See also `erlang-get-identifier-at-point'." + (let* ((id (erlang-get-identifier-at-point)) + (kind (erlang-id-kind id)) + (module (erlang-id-module id)) + (name (erlang-id-name id))) + (cond ((eq kind 'qualified-function) + (list module name)) + (name + (list nil name))))) + +(defun erlang-get-identifier-at-point () + "Return the erlang identifier at point, or nil. + +Should no explicit module name be present at the point, the +list of imported functions is searched. + +When an identifier is found return a list with 4 elements: + +1. Kind - One of the symbols qualified-function, record, macro, +module or nil. + +2. Module - Module name string or nil. In case of a +qualified-function a search fails if no entries with correct +module are found. For other kinds the module is just a +preference. If no matching entries are found the search will be +retried without regard to module. + +3. Name - String name of function, module, record or macro. -In the future the list may contain more elements." +4. Arity - Integer in case of functions and macros if the number +of arguments could be found, otherwise nil." (save-excursion - (let ((md (match-data)) - (res nil)) + (save-match-data (if (eq (char-syntax (following-char)) ? ) (skip-chars-backward " \t")) - (skip-chars-backward "a-zA-Z0-9_:'") - (cond ((looking-at (eval-when-compile - (concat erlang-atom-regexp ":" erlang-atom-regexp))) - (setq res (list - (erlang-remove-quotes - (erlang-buffer-substring - (match-beginning 1) (match-end 1))) - (erlang-remove-quotes - (erlang-buffer-substring - (match-beginning (1+ erlang-atom-regexp-matches)) - (match-end (1+ erlang-atom-regexp-matches))))))) - ((looking-at erlang-atom-regexp) - (let ((fk (erlang-remove-quotes - (erlang-buffer-substring - (match-beginning 0) (match-end 0)))) - (mod nil) - (imports (erlang-get-import))) - (while (and imports (null mod)) - (if (assoc fk (cdr (car imports))) - (setq mod (car (car imports))) - (setq imports (cdr imports)))) - (cond ((eq (preceding-char) ?#) - (setq fk (concat "-record(" fk))) - ((eq (preceding-char) ??) - (setq fk (concat "-define(" fk))) - ((and (null mod) (not (member fk erlang-int-bifs))) - (setq mod (erlang-get-module)))) - (setq res (list mod fk))))) - (store-match-data md) - res))) + (skip-chars-backward "[:word:]_:'") + (cond ((looking-at erlang-module-function-regexp) + (erlang-get-qualified-function-id-at-point)) + ((looking-at (concat erlang-atom-regexp ":")) + (erlang-get-module-id-at-point)) + ((looking-at erlang-name-regexp) + (erlang-get-some-other-id-at-point)))))) + +(defun erlang-get-qualified-function-id-at-point () + (let ((kind 'qualified-function) + (module (erlang-remove-quotes + (erlang-buffer-substring + (match-beginning 1) (match-end 1)))) + (name (erlang-remove-quotes + (erlang-buffer-substring + (match-beginning (1+ erlang-atom-regexp-matches)) + (match-end (1+ erlang-atom-regexp-matches))))) + (arity (progn + (goto-char (match-end 0)) + (erlang-get-argument-list-arity)))) + (list kind module name arity))) + +(defun erlang-get-module-id-at-point () + (let ((kind 'module) + (module nil) + (name (erlang-remove-quotes + (erlang-buffer-substring (match-beginning 1) + (match-end 1)))) + (arity nil)) + (list kind module name arity))) + +(defun erlang-get-some-other-id-at-point () + (let ((name (erlang-remove-quotes + (erlang-buffer-substring + (match-beginning 0) (match-end 0)))) + (imports (erlang-get-import)) + kind module arity) + (while (and imports (null module)) + (if (assoc name (cdr (car imports))) + (setq module (car (car imports))) + (setq imports (cdr imports)))) + (cond ((eq (preceding-char) ?#) + (setq kind 'record)) + ((eq (preceding-char) ??) + (setq kind 'macro)) + ((and (null module) (not (member name erlang-int-bifs))) + (setq module (erlang-get-module)))) + (setq arity (progn + (goto-char (match-end 0)) + (erlang-get-argument-list-arity))) + (list kind module name arity))) + +(defmacro erlang-with-id (slots id-string &rest body) + (declare (indent 2)) + (let ((id-var (make-symbol "id"))) + `(let* ((,id-var (erlang-id-to-list ,id-string)) + ,@(mapcar (lambda (slot) + (list slot + (list (intern (format "erlang-id-%s" slot)) + id-var))) + slots)) + ,@body))) + +(defun erlang-id-to-string (id) + (when id + (erlang-with-id (kind module name arity) id + (format "%s%s%s%s" + (if kind (format "%s " kind) "") + (if module (format "%s:" module) "") + name + (if arity (format "/%s" arity) ""))))) + +(defun erlang-id-to-list (id) + (if (listp id) + id + (save-match-data + (erlang-ensure-syntax-table-is-initialized) + (with-syntax-table erlang-mode-syntax-table + (let (case-fold-search) + (when (string-match erlang-id-regexp id) + (list (when (match-string 1 id) + (intern (match-string 1 id))) + (match-string 2 id) + (match-string 3 id) + (when (match-string 4 id) + (string-to-number (match-string 4 id)))))))))) + +(defun erlang-id-kind (id) + (car (erlang-id-to-list id))) + +(defun erlang-id-module (id) + (nth 1 (erlang-id-to-list id))) + +(defun erlang-id-name (id) + (nth 2 (erlang-id-to-list id))) + +(defun erlang-id-arity (id) + (nth 3 (erlang-id-to-list id))) ;; TODO: Escape single quotes inside the string without @@ -3822,10 +3936,10 @@ In the future the list may contain more elements." "Returns non-nil if there is an exported function in the current buffer between point and MAX." (block nil - (while (and (not erlang-inhibit-exported-function-name-face) - (erlang-match-next-function max)) - (when (erlang-last-match-exported-p) - (return (match-data)))))) + (while (and (not erlang-inhibit-exported-function-name-face) + (erlang-match-next-function max)) + (when (erlang-last-match-exported-p) + (return (match-data)))))) (defun erlang-match-next-function (max) "Searches forward in current buffer for the next erlang function, @@ -4084,7 +4198,7 @@ non-whitespace characters following the point on the current line." nil))) -(defun erlang-electric-arrow\ off (&optional arg) +(defun erlang-electric-arrow (&optional arg) "Insert a '>'-sign and possibly a new indented line. This command is only `electric' when the `>' is part of an `->' arrow. @@ -4310,8 +4424,8 @@ This function is designed to be a member of a criteria list." (looking-at "end[^_a-zA-Z0-9]"))) -;; Erlang tags support which is aware of erlang modules. -;; +;;; Erlang tags support which is aware of erlang modules. + ;; Not yet implemented under XEmacs. (Hint: The Emacs 19 etags ;; package works under XEmacs.) @@ -4369,7 +4483,7 @@ This function only works under Emacs 18 and Emacs 19. Currently, It is not implemented under XEmacs. (Hint: The Emacs 19 etags module works under XEmacs.)" (interactive) - (cond ((= erlang-emacs-major-version 18) + (cond ((= emacs-major-version 18) (require 'tags) (erlang-tags-define-keys (current-local-map)) (setq erlang-tags-installed t)) @@ -4409,20 +4523,6 @@ works under XEmacs.)" (erlang-menu-substitute erlang-menu-base-items erlang-tags-function-alist) (erlang-menu-init)) - -(defun erlang-find-tag-default () - "Return the default tag. -Search `-import' list of imported functions. -Single quotes are been stripped away." - (let ((mod-func (erlang-get-function-under-point))) - (cond ((null mod-func) - nil) - ((null (car mod-func)) - (nth 1 mod-func)) - (t - (concat (car mod-func) ":" (nth 1 mod-func)))))) - - ;; Return `t' since it is used inside `tags-loop-form'. ;;;###autoload (defun erlang-find-tag (modtagname &optional next-p regexp-p) @@ -4609,7 +4709,7 @@ Tags can be given on the forms `tag', `module:', `module:tag'." (list nil (if (< (prefix-numeric-value current-prefix-arg) 0) '- t)) - (let* ((default (erlang-find-tag-default)) + (let* ((default (erlang-default-function-or-module)) (prompt (if default (format "%s(default %s) " prompt default) prompt)) @@ -4633,7 +4733,7 @@ Tags can be given on the forms `tag', `module:', `module:tag'." ;; Make sure our functions are installed in TAGS files loaded ;; into Emacs while searching. (cond - ((>= erlang-emacs-major-version 20) + ((>= emacs-major-version 20) (setq erlang-tags-orig-format-functions (symbol-value 'tags-table-format-functions)) (funcall (symbol-function 'set) 'tags-table-format-functions @@ -4711,7 +4811,7 @@ Tags can be given on the forms `tag', `module:', `module:tag'." (defun erlang-tags-remove-module-check () "Remove our own tags search functions." (cond - ((>= erlang-emacs-major-version 20) + ((>= emacs-major-version 20) (funcall (symbol-function 'set) 'tags-table-format-functions erlang-tags-orig-format-functions) @@ -4961,6 +5061,14 @@ about Erlang modules." ;; It adds awareness of the module:tag syntax in a similar way that is ;; done above for the old etags commands. +(defvar erlang-current-arity nil + "The arity of the function currently being searched. + +There is no information about arity in the TAGS file. +Consecutive functions with same name but different arity will +only get one entry in the TAGS file. Matching TAGS entries are +therefore selected without regarding arity. The arity is +considered first when it is time to jump to the definition.") (defun erlang-etags--xref-backend () 'erlang-etags) @@ -4970,13 +5078,14 @@ about Erlang modules." (and (erlang-soft-require 'xref) (erlang-soft-require 'cl-generic) + (erlang-soft-require 'eieio) ;; The purpose of using eval here is to avoid compilation - ;; warnings in emacsen without cl-defmethod. + ;; warnings in emacsen without cl-defmethod etc. (eval '(progn (cl-defmethod xref-backend-identifier-at-point ((_backend (eql erlang-etags))) - (erlang-find-tag-default)) + (erlang-id-to-string (erlang-get-identifier-at-point))) (cl-defmethod xref-backend-definitions ((_backend (eql erlang-etags)) identifier) @@ -4989,42 +5098,99 @@ about Erlang modules." (cl-defmethod xref-backend-identifier-completion-table ((_backend (eql erlang-etags))) (let ((erlang-replace-etags-tags-completion-table t)) - (tags-completion-table)))))) - - + (tags-completion-table))) + + (defclass erlang-xref-location (xref-etags-location) ()) + + (defun erlang-convert-xrefs (xrefs) + (mapcar (lambda (xref) + (oset xref location (erlang-make-location + (oref xref location))) + xref) + xrefs)) + + (defun erlang-make-location (etags-location) + (with-slots (tag-info file) etags-location + (make-instance 'erlang-xref-location :tag-info tag-info + :file file))) + + (cl-defmethod xref-location-marker ((locus erlang-xref-location)) + (with-slots (tag-info file) locus + (with-current-buffer (find-file-noselect file) + (save-excursion + (or (erlang-goto-tag-location-by-arity tag-info) + (etags-goto-tag-location tag-info)) + ;; Reset erlang-current-arity. We want to jump to + ;; correct arity in the first attempt. That is now + ;; done. Possible remaining jumps will be from + ;; entries in the *xref* buffer and then we want to + ;; ignore the arity. (Alternatively we could remove + ;; all but one xref entry per file when we know the + ;; arity). + (setq erlang-current-arity nil) + (point-marker))))) + + (defun erlang-xref-context (xref) + (with-slots (tag-info) (xref-item-location xref) + (car tag-info)))))) + + +(defun erlang-goto-tag-location-by-arity (tag-info) + (when erlang-current-arity + (let* ((tag-text (car tag-info)) + (tag-pos (cdr (cdr tag-info))) + (tag-line (car (cdr tag-info))) + (regexp (erlang-tag-info-regexp tag-text)) + (startpos (or tag-pos + (when tag-line + (goto-char (point-min)) + (forward-line (1- tag-line)) + (point)) + (point-min)))) + (setq startpos (max (- startpos 2000) + (point-min))) + (goto-char startpos) + (let ((pos (or (erlang-search-by-arity regexp) + (unless (eq startpos (point-min)) + (goto-char (point-min)) + (erlang-search-by-arity regexp))))) + (when pos + (goto-char pos) + t))))) + +(defun erlang-tag-info-regexp (tag-text) + (concat "^" + (regexp-quote tag-text) + ;; Erlang function entries in TAGS includes the opening + ;; parenthesis for the argument list. Erlang macro entries + ;; do not. Add it here in order to end up in correct + ;; position for erlang-get-arity. + (if (string-prefix-p "-define" tag-text) + "\\s-*(" + ""))) + +(defun erlang-search-by-arity (regexp) + (let (pos) + (while (and (null pos) + (re-search-forward regexp nil t)) + (when (eq erlang-current-arity (save-excursion (erlang-get-arity))) + (setq pos (point-at-bol)))) + pos)) (defun erlang-xref-find-definitions (identifier &optional is-regexp) - (let ((id-list (split-string identifier ":"))) - (cond - ;; Handle "tag" - ((null (cdr id-list)) - (erlang-xref-find-definitions-tag identifier is-regexp)) - ;; Handle "module:" - ((string-equal (cadr id-list) "") - (erlang-xref-find-definitions-module (car id-list))) - ;; Handle "module:tag" - (t - (erlang-xref-find-definitions-module-tag (car id-list) - (cadr id-list) - is-regexp))))) - -(defun erlang-xref-find-definitions-tag (tag is-regexp) - "Find all definitions of TAG and reorder them so that -definitions in the currently visited file comes first." - (when (fboundp 'etags--xref-find-definitions) - (let* ((current-file (and (buffer-file-name) - (file-truename (buffer-file-name)))) - (xrefs (etags--xref-find-definitions tag is-regexp)) - local-xrefs non-local-xrefs) - (while xrefs - (if (string-equal (erlang-xref-truename-file (car xrefs)) - current-file) - (push (car xrefs) local-xrefs) - (push (car xrefs) non-local-xrefs)) - (setq xrefs (cdr xrefs))) - (append (reverse local-xrefs) - (reverse non-local-xrefs))))) + (erlang-with-id (kind module name arity) identifier + (setq erlang-current-arity arity) + (cond ((eq kind 'module) + (erlang-xref-find-definitions-module name)) + (module + (erlang-xref-find-definitions-module-tag module + name + (eq kind + 'qualified-function) + is-regexp)) + (t + (erlang-xref-find-definitions-tag kind name is-regexp))))) (defun erlang-xref-find-definitions-module (module) (and (fboundp 'xref-make) @@ -5048,17 +5214,58 @@ definitions in the currently visited file comes first." (setq files (cdr files)))))) (nreverse xrefs)))) -(defun erlang-xref-find-definitions-module-tag (module tag is-regexp) - "Find all definitions of TAG and filter away definitions -outside of MODULE." - (when (fboundp 'etags--xref-find-definitions) - (let ((xrefs (etags--xref-find-definitions tag is-regexp)) - xrefs-in-module) - (while xrefs - (when (string-equal module (erlang-xref-module (car xrefs))) - (push (car xrefs) xrefs-in-module)) - (setq xrefs (cdr xrefs))) - xrefs-in-module))) + +(defun erlang-xref-find-definitions-module-tag (module + tag + is-qualified + is-regexp) + "Find definitions of TAG and filter away definitions outside of +MODULE. If IS-QUALIFIED is nil and no definitions was found inside +the MODULE then return any definitions found outside. If +IS-REGEXP is non-nil then TAG is a regexp." + (and (fboundp 'etags--xref-find-definitions) + (fboundp 'erlang-convert-xrefs) + (let ((xrefs (erlang-convert-xrefs + (etags--xref-find-definitions tag is-regexp))) + xrefs-in-module) + (dolist (xref xrefs) + (when (string-equal module (erlang-xref-module xref)) + (push xref xrefs-in-module))) + (cond (is-qualified xrefs-in-module) + (xrefs-in-module xrefs-in-module) + (t xrefs))))) + +(defun erlang-xref-find-definitions-tag (kind tag is-regexp) + "Find all definitions of TAG and reorder them so that +definitions in the currently visited file comes first." + (and (fboundp 'etags--xref-find-definitions) + (fboundp 'erlang-convert-xrefs) + (let* ((current-file (and (buffer-file-name) + (file-truename (buffer-file-name)))) + (regexp (erlang-etags-regexp kind tag is-regexp)) + (xrefs (erlang-convert-xrefs + (etags--xref-find-definitions regexp t))) + local-xrefs non-local-xrefs) + (while xrefs + (let ((xref (car xrefs))) + (if (string-equal (erlang-xref-truename-file xref) + current-file) + (push xref local-xrefs) + (push xref non-local-xrefs)) + (setq xrefs (cdr xrefs)))) + (append (reverse local-xrefs) + (reverse non-local-xrefs))))) + +(defun erlang-etags-regexp (kind tag is-regexp) + (let ((tag-regexp (if is-regexp + tag + (regexp-quote tag)))) + (cond ((eq kind 'record) + (concat "-record\\s-*(\\s-*" tag-regexp)) + ((eq kind 'macro) + (concat "-define\\s-*(\\s-*" tag-regexp)) + (t tag-regexp)))) + (defun erlang-xref-module (xref) (erlang-get-module-from-file-name (erlang-xref-file xref))) @@ -5174,7 +5381,7 @@ future, a new shell on an already running host will be started." (defvar erlang-shell-mode-hook nil - "*User functions to run when an Erlang shell is started. + "User functions to run when an Erlang shell is started. This hook is used to change the behaviour of Erlang mode. It is normally used by the user to personalise the programming environment. @@ -5190,7 +5397,7 @@ Erlang source file is loaded into Emacs.") (defvar erlang-input-ring-file-name "~/.erlang_history" - "*When non-nil, file name used to store Erlang shell history information.") + "When non-nil, file name used to store Erlang shell history information.") (defun erlang-shell-mode () @@ -5290,7 +5497,7 @@ Selects Comint or Compilation mode command as appropriate." ;;; (defvar inferior-erlang-display-buffer-any-frame nil - "*When nil, `inferior-erlang-display-buffer' use only selected frame. + "When nil, `inferior-erlang-display-buffer' use only selected frame. When t, all frames are searched. When 'raise, the frame is raised.") (defvar inferior-erlang-shell-type 'newshell @@ -5303,10 +5510,10 @@ nil, the default shell is used. This variable influence the setting of other variables.") (defvar inferior-erlang-machine "erl" - "*The name of the Erlang shell.") + "The name of the Erlang shell.") (defvar inferior-erlang-machine-options '() - "*The options used when activating the Erlang shell. + "The options used when activating the Erlang shell. This must be a list of strings.") @@ -5317,7 +5524,7 @@ This must be a list of strings.") "The name of the inferior Erlang buffer.") (defvar inferior-erlang-prompt-timeout 60 - "*Number of seconds before `inferior-erlang-wait-prompt' timeouts. + "Number of seconds before `inferior-erlang-wait-prompt' timeouts. The time specified is waited after every output made by the inferior Erlang shell. When this variable is t, we assume that we always have @@ -5383,7 +5590,7 @@ editing control characters: (setq inferior-erlang-process (get-buffer-process inferior-erlang-buffer)) - (if (> 21 erlang-emacs-major-version) ; funcalls to avoid compiler warnings + (if (> 21 emacs-major-version) ; funcalls to avoid compiler warnings (funcall (symbol-function 'set-process-query-on-exit-flag) inferior-erlang-process nil) (funcall (symbol-function 'process-kill-without-query) inferior-erlang-process)) @@ -5454,7 +5661,7 @@ frame will become deselected before the next command." (defun inferior-erlang-window (&optional all-frames) "Return the window containing the inferior Erlang, or nil." (and (inferior-erlang-running-p) - (if (and all-frames (>= erlang-emacs-major-version 19)) + (if (and all-frames (>= emacs-major-version 19)) (get-buffer-window inferior-erlang-buffer t) (get-buffer-window inferior-erlang-buffer)))) @@ -5551,7 +5758,7 @@ Return the position after the newly inserted command." (boundp 'comint-last-output-start)) (save-excursion (goto-char - (if (erlang-interactive-p) + (if (called-interactively-p 'interactive) (symbol-value 'comint-last-input-end) (symbol-value 'comint-last-output-start))) (while (progn (skip-chars-forward "^\C-h") @@ -5570,7 +5777,7 @@ Return the position after the newly inserted command." (let ((pmark (process-mark (get-buffer-process (current-buffer))))) (save-excursion (goto-char - (if (erlang-interactive-p) + (if (called-interactively-p 'interactive) (symbol-value 'comint-last-input-end) (symbol-value 'comint-last-output-start))) (while (re-search-forward "\r+$" pmark t) @@ -5938,12 +6145,6 @@ it assumes that NEWDEF is loaded." (ad-unadvise 'Man-notify-when-ready) (ad-unadvise 'set-visited-file-name))))) - -(defun erlang-string-to-int (string) - (if (fboundp 'string-to-number) - (string-to-number string) - (funcall (symbol-function 'string-to-int) string))) - ;; The end... (provide 'erlang) @@ -5951,7 +6152,7 @@ it assumes that NEWDEF is loaded." (run-hooks 'erlang-load-hook) ;; Local variables: -;; coding: iso-8859-1 +;; coding: utf-8 ;; indent-tabs-mode: nil ;; End: diff --git a/lib/tools/emacs/erldoc.el b/lib/tools/emacs/erldoc.el index cb355374d9..e1fd661348 100644 --- a/lib/tools/emacs/erldoc.el +++ b/lib/tools/emacs/erldoc.el @@ -23,8 +23,8 @@ ;; Crawl Erlang/OTP HTML documentation and generate lookup tables. ;; ;; This package depends on `cl-lib', `pcase' and -;; `libxml-parse-html-region'; emacs 24+ compiled with libxml2 should -;; work. On emacs 24.1 and 24.2 do `M-x package-install RET cl-lib +;; `libxml-parse-html-region'. Emacs 24+ compiled with libxml2 should +;; work. On Emacs 24.1 and 24.2 do `M-x package-install RET cl-lib ;; RET' to install `cl-lib'. ;; ;; Please customise `erldoc-man-index' to point to your local OTP @@ -505,4 +505,10 @@ up the indexing." (browse-url (cdr (assoc topic (erldoc-user-guides))))) (provide 'erldoc) + +;; Local variables: +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + ;;; erldoc.el ends here diff --git a/otp_versions.table b/otp_versions.table index 6ca9636c37..dbc656a543 100644 --- a/otp_versions.table +++ b/otp_versions.table @@ -1,3 +1,4 @@ +OTP-19.2.3 : erts-8.2.2 inets-6.3.5 # asn1-4.0.4 common_test-1.13 compiler-7.0.3 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7.2 debugger-4.2.1 dialyzer-3.0.3 diameter-1.12.1 edoc-0.8.1 eldap-1.2.2 erl_docgen-0.6.1 erl_interface-3.9.2 et-1.6 eunit-2.3.2 gs-1.6.2 hipe-3.15.3 ic-4.4.2 jinterface-1.7.1 kernel-5.1.1 megaco-3.18.1 mnesia-4.14.3 observer-2.3 odbc-2.12 orber-3.8.2 os_mon-2.4.1 otp_mibs-1.1.1 parsetools-2.1.4 percept-0.9 public_key-1.3 reltool-0.7.2 runtime_tools-1.11 sasl-3.0.2 snmp-5.2.4 ssh-4.4 ssl-8.1 stdlib-3.2 syntax_tools-2.1.1 tools-2.9 typer-0.9.11 wx-1.8 xmerl-1.3.12 : OTP-19.2.2 : mnesia-4.14.3 # asn1-4.0.4 common_test-1.13 compiler-7.0.3 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7.2 debugger-4.2.1 dialyzer-3.0.3 diameter-1.12.1 edoc-0.8.1 eldap-1.2.2 erl_docgen-0.6.1 erl_interface-3.9.2 erts-8.2.1 et-1.6 eunit-2.3.2 gs-1.6.2 hipe-3.15.3 ic-4.4.2 inets-6.3.4 jinterface-1.7.1 kernel-5.1.1 megaco-3.18.1 observer-2.3 odbc-2.12 orber-3.8.2 os_mon-2.4.1 otp_mibs-1.1.1 parsetools-2.1.4 percept-0.9 public_key-1.3 reltool-0.7.2 runtime_tools-1.11 sasl-3.0.2 snmp-5.2.4 ssh-4.4 ssl-8.1 stdlib-3.2 syntax_tools-2.1.1 tools-2.9 typer-0.9.11 wx-1.8 xmerl-1.3.12 : OTP-19.2.1 : erts-8.2.1 # asn1-4.0.4 common_test-1.13 compiler-7.0.3 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7.2 debugger-4.2.1 dialyzer-3.0.3 diameter-1.12.1 edoc-0.8.1 eldap-1.2.2 erl_docgen-0.6.1 erl_interface-3.9.2 et-1.6 eunit-2.3.2 gs-1.6.2 hipe-3.15.3 ic-4.4.2 inets-6.3.4 jinterface-1.7.1 kernel-5.1.1 megaco-3.18.1 mnesia-4.14.2 observer-2.3 odbc-2.12 orber-3.8.2 os_mon-2.4.1 otp_mibs-1.1.1 parsetools-2.1.4 percept-0.9 public_key-1.3 reltool-0.7.2 runtime_tools-1.11 sasl-3.0.2 snmp-5.2.4 ssh-4.4 ssl-8.1 stdlib-3.2 syntax_tools-2.1.1 tools-2.9 typer-0.9.11 wx-1.8 xmerl-1.3.12 : OTP-19.2 : common_test-1.13 compiler-7.0.3 crypto-3.7.2 dialyzer-3.0.3 edoc-0.8.1 erl_docgen-0.6.1 erl_interface-3.9.2 erts-8.2 eunit-2.3.2 hipe-3.15.3 inets-6.3.4 kernel-5.1.1 mnesia-4.14.2 observer-2.3 odbc-2.12 parsetools-2.1.4 public_key-1.3 runtime_tools-1.11 sasl-3.0.2 ssh-4.4 ssl-8.1 stdlib-3.2 syntax_tools-2.1.1 tools-2.9 wx-1.8 # asn1-4.0.4 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 debugger-4.2.1 diameter-1.12.1 eldap-1.2.2 et-1.6 gs-1.6.2 ic-4.4.2 jinterface-1.7.1 megaco-3.18.1 orber-3.8.2 os_mon-2.4.1 otp_mibs-1.1.1 percept-0.9 reltool-0.7.2 snmp-5.2.4 typer-0.9.11 xmerl-1.3.12 : diff --git a/scripts/build-otp b/scripts/build-otp new file mode 100755 index 0000000000..388fa8c276 --- /dev/null +++ b/scripts/build-otp @@ -0,0 +1,20 @@ +#!/bin/bash + +function do_and_log { + log="scripts/latest-log.$$" + echo -n "$1... " + if ./otp_build $2 $3 >$log 2>&1; then + echo "done." + else + echo "failed." + tail -n 200 $log + echo "*** Failed ***" + exit 1 + fi +} + +do_and_log "Autoconfing" autoconf +do_and_log "Configuring" configure +do_and_log "Building OTP" boot -a + +exit 0 |