diff options
Diffstat (limited to 'lib/stdlib')
39 files changed, 1764 insertions, 968 deletions
diff --git a/lib/stdlib/doc/src/beam_lib.xml b/lib/stdlib/doc/src/beam_lib.xml index b9286f1402..27308e02f3 100644 --- a/lib/stdlib/doc/src/beam_lib.xml +++ b/lib/stdlib/doc/src/beam_lib.xml @@ -347,9 +347,10 @@ chunkref() = chunkname() | chunkid()</code> </type> <desc> <p>Compares the contents of two BEAM files. If the module names - are the same, and the chunks with the identifiers - <c>"Code"</c>, <c>"ExpT"</c>, <c>"ImpT"</c>, <c>"StrT"</c>, - and <c>"Atom"</c> have the same contents in both files, + are the same, and all chunks except for the <c>"CInf"</c> chunk + (the chunk containing the compilation information which is + returned by <c>Module:module_info(compile)</c>) + have the same contents in both files, <c>ok</c> is returned. Otherwise an error message is returned.</p> </desc> </func> diff --git a/lib/stdlib/doc/src/erl_scan.xml b/lib/stdlib/doc/src/erl_scan.xml index 4175146c3c..1199c34f0f 100644 --- a/lib/stdlib/doc/src/erl_scan.xml +++ b/lib/stdlib/doc/src/erl_scan.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2009</year> + <year>1996</year><year>2010</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -13,12 +13,12 @@ compliance with the License. You should have received a copy of the Erlang Public License along with this software. If not, it can be retrieved online at http://www.erlang.org/. - + Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for the specific language governing rights and limitations under the License. - + </legalnotice> <title>erl_scan</title> @@ -103,7 +103,7 @@ attributes() = line() | list() | tuple()</code> Info, atom()}</c>, <c>{char, Info, integer()}</c>, <c>{comment, Info, string()}</c>, <c>{float, Info, float()}</c>, <c>{integer, - Info, integer()}</c>, <c>{var, Info, atom()}</c>, + Info, integer()}</c>, <c>{var, Info, atom()}</c>, and <c>{white_space, Info, string()}</c>.</p> <p>The valid options are:</p> <taglist> @@ -149,7 +149,8 @@ attributes() = line() | list() | tuple()</code> <v>StartLocation = EndLocation = location()</v> <v>Options = Option | [Option]</v> <v>Option = {reserved_word_fun,reserved_word_fun()} - | return_comments | return_white_spaces | return</v> + | return_comments | return_white_spaces | return + | text</v> </type> <desc> <p>This is the re-entrant scanner which scans characters until @@ -173,7 +174,7 @@ attributes() = line() | list() | tuple()</code> <tag><c>{error, ErrorInfo, EndLocation}</c></tag> <item> <p>An error occurred. <c>LeftOverChars</c> is the remaining - characters of the input data, + characters of the input data, starting from <c>EndLocation</c>.</p> </item> </taglist> @@ -278,7 +279,7 @@ attributes() = line() | list() | tuple()</code> <item><p>The token's symbol.</p> </item> <tag><c>{text, string()}</c></tag> - <item><p>The token's text..</p> + <item><p>The token's text.</p> </item> </taglist> </desc> @@ -315,7 +316,7 @@ attributes() = line() | list() | tuple()</code> <type> <v>Attributes = attributes()</v> <v>AttributeItemSpec = AttributeItem | [AttributeItem]</v> - <v>AttributesInfo = AttributeInfoTuple | undefined + <v>AttributesInfo = AttributeInfoTuple | undefined | [AttributeInfoTuple]</v> <v>AttributeInfoTuple = {AttributeItem, Info}</v> <v>AttributeItem = atom()</v> @@ -352,7 +353,7 @@ attributes() = line() | list() | tuple()</code> just the line if the column unknown.</p> </item> <tag><c>{text, string()}</c></tag> - <item><p>The token's text..</p> + <item><p>The token's text.</p> </item> </taglist> </desc> diff --git a/lib/stdlib/doc/src/ets.xml b/lib/stdlib/doc/src/ets.xml index 7b9f0e7772..ee1befc882 100644 --- a/lib/stdlib/doc/src/ets.xml +++ b/lib/stdlib/doc/src/ets.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2009</year> + <year>1996</year><year>2010</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -13,12 +13,12 @@ compliance with the License. You should have received a copy of the Erlang Public License along with this software. If not, it can be retrieved online at http://www.erlang.org/. - + Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for the specific language governing rights and limitations under the License. - + </legalnotice> <title>ets</title> @@ -1686,7 +1686,7 @@ true</pre> </desc> </func> <func> - <name>to_dets(Tab, DetsTab) -> Tab</name> + <name>to_dets(Tab, DetsTab) -> DetsTab</name> <fsummary>Fill a Dets table with objects from an ETS table.</fsummary> <type> <v>Tab = tid() | atom()</v> diff --git a/lib/stdlib/doc/src/io_protocol.xml b/lib/stdlib/doc/src/io_protocol.xml index 201787f7b5..b52e862a5c 100644 --- a/lib/stdlib/doc/src/io_protocol.xml +++ b/lib/stdlib/doc/src/io_protocol.xml @@ -195,7 +195,7 @@ latin1, Module, Function, Args} respectively. </p> below).</p> <p>The function will be called with the data the io_server finds on - it's device, returning {done, Result, RestChars} when enough data is + its device, returning {done, Result, RestChars} when enough data is read (in which case Result is sent to the client and RestChars are kept in the io_server as a buffer for subsequent input) or {more, Continuation}, indicating that more characters are needed to @@ -741,7 +741,7 @@ optimize anything however. It is important though that the returned data is of the right type depending on the options set, so we convert the lists to binaries in the correct encoding <em>if possible</em> before returning. The function supplied in the get_until request may, -as it's final result return anything, so only functions actually +as its final result return anything, so only functions actually returning lists can get them converted to binaries. If the request contained the encoding tag unicode, the lists can contain all unicode codepoints and the binaries should be in UTF-8, if the encoding tag diff --git a/lib/stdlib/doc/src/lists.xml b/lib/stdlib/doc/src/lists.xml index 855a7e0244..a273a2301f 100644 --- a/lib/stdlib/doc/src/lists.xml +++ b/lib/stdlib/doc/src/lists.xml @@ -443,7 +443,7 @@ flatmap(Fun, List1) -> <desc> <p>Returns a list containing the sorted elements of the list <c>TupleList1</c>. Sorting is performed on the <c>N</c>th - element of the tuples.</p> + element of the tuples. The sort is stable.</p> </desc> </func> <func> @@ -466,7 +466,7 @@ flatmap(Fun, List1) -> </desc> </func> <func> - <name>keytake(Key, N, TupleList1) -> {value, Tuple, TupleList2} + <name>keytake(Key, N, TupleList1) -> {value, Tuple, TupleList2} | false</name> <fsummary>Extract an element from a list of tuples</fsummary> <type> @@ -840,7 +840,7 @@ length(lists:seq(From, To, Incr)) == (To-From+Incr) div Incr</code> <c>Pred</c>. <c>splitwith/2</c> behaves as if it is defined as follows:</p> <code type="none"> -splitwith(Pred, List) -> +splitwith(Pred, List) -> {takewhile(Pred, List), dropwhile(Pred, List)}.</code> <p>Examples:</p> <pre> diff --git a/lib/stdlib/doc/src/ms_transform.xml b/lib/stdlib/doc/src/ms_transform.xml index 9f178b426c..ba9f89685b 100644 --- a/lib/stdlib/doc/src/ms_transform.xml +++ b/lib/stdlib/doc/src/ms_transform.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>2002</year><year>2009</year> + <year>2002</year><year>2010</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -13,12 +13,12 @@ compliance with the License. You should have received a copy of the Erlang Public License along with this software. If not, it can be retrieved online at http://www.erlang.org/. - + Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for the specific language governing rights and limitations under the License. - + </legalnotice> <title>ms_transform</title> @@ -245,7 +245,7 @@ ets:select(emp_tab, ets:fun2ms( fun(#emp{empno = [$0 | Rest] }) -> {[$0|Rest],[$1|Rest]} end)). </code> - <p>As a matter of fact, this query hit's the feature of partially bound + <p>As a matter of fact, this query hits the feature of partially bound keys in the table type <c>ordered_set</c>, so that not the whole table need be searched, only the part of the table containing keys beginning with <c>0</c> is in fact looked into. </p> diff --git a/lib/stdlib/doc/src/notes.xml b/lib/stdlib/doc/src/notes.xml index c55eafc8b8..28a3719d38 100644 --- a/lib/stdlib/doc/src/notes.xml +++ b/lib/stdlib/doc/src/notes.xml @@ -50,7 +50,7 @@ <item> <p>A number of bugs concerning re and unicode are corrected:</p> - <p>re:compile no longer looses unicode option, which also + <p>re:compile no longer loses unicode option, which also fixes bug in re:split.</p> <p>re:replace now handles unicode charlist replacement argument</p> diff --git a/lib/stdlib/doc/src/unicode_usage.xml b/lib/stdlib/doc/src/unicode_usage.xml index c5bf10b63d..f1b0659ea2 100644 --- a/lib/stdlib/doc/src/unicode_usage.xml +++ b/lib/stdlib/doc/src/unicode_usage.xml @@ -143,7 +143,7 @@ en_US.UTF-8</pre> <pre> $ echo <input>$LC_CTYPE</input> en_US.UTF-8</pre> -<p>The LANG or LC_CTYPE setting should be consistent with what the terminal is capable of, there is no portable way for Erlang to ask the actual terminal about it's UTF-8 capacity, we have to rely on the language and character type settings.</p> +<p>The LANG or LC_CTYPE setting should be consistent with what the terminal is capable of, there is no portable way for Erlang to ask the actual terminal about its UTF-8 capacity, we have to rely on the language and character type settings.</p> <p>To investigate what Erlang thinks about the terminal, the <c>io:getopts()</c> call can be used when the shell is started:</p> <pre> $ <input>LC_CTYPE=en_US.ISO-8859-1 erl</input> @@ -185,7 +185,7 @@ Eshell V5.7 (abort with ^G) <tag><c>file</c>, <c>group</c> and <c>user</c></tag> <item> <p>I/O-servers throughout the system are able both to handle Unicode data and has options for converting data upon actual output or input to/from the device. As shown earlier, the <seealso marker="stdlib:shell">shell</seealso> has support for Unicode terminals and the <seealso marker="kernel:file">file</seealso> module allows for translation to and from various Unicode formats on disk.</p> -<p>The actual reading and writing of files with Unicode data is however not best done with the <c>file</c> module as it's interface is byte oriented. A file opened with a Unicode encoding (like UTF-8), is then best read or written using the <seealso marker="stdlib:io">io</seealso> module.</p> +<p>The actual reading and writing of files with Unicode data is however not best done with the <c>file</c> module as its interface is byte oriented. A file opened with a Unicode encoding (like UTF-8), is then best read or written using the <seealso marker="stdlib:io">io</seealso> module.</p> </item> <tag><c>re</c></tag> <item> diff --git a/lib/stdlib/doc/src/zip.xml b/lib/stdlib/doc/src/zip.xml index e2ecfec8f0..4d98a20206 100644 --- a/lib/stdlib/doc/src/zip.xml +++ b/lib/stdlib/doc/src/zip.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>2006</year><year>2009</year> + <year>2006</year><year>2010</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -13,12 +13,12 @@ compliance with the License. You should have received a copy of the Erlang Public License along with this software. If not, it can be retrieved online at http://www.erlang.org/. - + Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for the specific language governing rights and limitations under the License. - + </legalnotice> <title>zip</title> @@ -42,16 +42,18 @@ <p>By convention, the name of a zip file should end in "<c>.zip</c>". To abide to the convention, you'll need to add "<c>.zip</c>" yourself to the name.</p> - <p>Zip archives are created with the - <seealso marker="#zip_2">zip/2</seealso> or the + <p>Zip archives are created with the + <seealso marker="#zip_2">zip/2</seealso> or the <seealso marker="#zip_2">zip/3</seealso> function. (They are also available as <c>create</c>, to resemble the <c>erl_tar</c> module.)</p> - <p>To extract files from a zip archive, use the - <seealso marker="#unzip_1">unzip/1</seealso> or the + <p>To extract files from a zip archive, use the + <seealso marker="#unzip_1">unzip/1</seealso> or the <seealso marker="#unzip_2">unzip/2</seealso> function. (They are also available as <c>extract</c>.)</p> - <p>To return a list of the files in a zip archive, use the + <p>To fold a function over all files in a zip archive, use the + <seealso marker="#foldl_3">foldl_3</seealso>.</p> + <p>To return a list of the files in a zip archive, use the <seealso marker="#list_dir_1">list_dir/1</seealso> or the <seealso marker="#list_dir_2">list_dir/2</seealso> function. (They are also available as <c>table</c>.)</p> @@ -132,7 +134,7 @@ zip_file() </code> <type> <v>Name = filename()</v> <v>FileList = [FileSpec]</v> - <v>FileSpec = filename() | {filename(), binary()}</v> + <v>FileSpec = filename() | {filename(), binary()} | {filename(), binary(), #file_info{}}</v> <v>Options = [Option]</v> <v>Option = memory | cooked | verbose | {comment, Comment} | {cwd, CWD} | {compress, What} | {uncompress, What}</v> <v>What = all | [Extension] | {add, [Extension]} | {del, [Extension]}</v> @@ -212,16 +214,16 @@ zip_file() </code> <taglist> <tag><c>all</c></tag> <item><p> means that all files will be compressed (as long - as they pass the <c>uncompress</c> condition).</p></item> + as they pass the <c>uncompress</c> condition).</p></item> <tag><c>[Extension]</c></tag> <item><p>means that only files with exactly these extensions - will be compressed.</p></item> + will be compressed.</p></item> <tag><c>{add,[Extension]}</c></tag> <item><p>adds these extensions to the list of compress - extensions.</p></item> + extensions.</p></item> <tag><c>{del,[Extension]}</c></tag> <item><p>deletes these extensions from the list of compress - extensions.</p></item> + extensions.</p></item> </taglist> </item> <tag><c>{uncompress, What}</c></tag> @@ -231,16 +233,16 @@ zip_file() </code> The following values of <c>What</c> are allowed:</p> <taglist> <tag><c>all</c></tag> - <item><p> means that no files will be compressed.</p></item> + <item><p> means that no files will be compressed.</p></item> <tag><c>[Extension]</c></tag> <item><p>means that files with these extensions will be - uncompressed.</p></item> + uncompressed.</p></item> <tag><c>{add,[Extension]}</c></tag> <item><p>adds these extensions to the list of uncompress - extensions.</p></item> + extensions.</p></item> <tag><c>{del,[Extension]}</c></tag> <item><p>deletes these extensions from the list of uncompress - extensions.</p></item> + extensions.</p></item> </taglist> </item> </taglist> @@ -283,7 +285,7 @@ zip_file() </code> the <c>unzip/2</c> function will only extract the files whose names are included in <c>FileList</c>. The full paths, including the names of all sub directories within - the zip archive, must be specified.</p> + the zip archive, must be specified.</p> </item> <tag><c>cooked</c></tag> <item> @@ -327,6 +329,64 @@ zip_file() </code> </desc> </func> <func> + <name>foldl(Fun, Acc0, Archive) -> {ok, Acc1} | {error, Reason}</name> + <fsummary>Fold a function over all files in a zip archive</fsummary> + <type> + <v>Fun = fun(FileInArchive, GetInfo, GetBin, AccIn) -> AccOut</v> + <v>FileInArchive = filename()</v> + <v>GetInfo = fun() -> #file_info{}</v> + <v>GetBin = fun() -> binary()</v> + <v>Acc0 = Acc1 = AccIn = AccOut = term()</v> + <v>Archive = filename() | {filename(), binary()}</v> + </type> + <desc> + <p>The <marker id="foldl_3"></marker> <c>foldl/3</c> function + calls <c>Fun(FileInArchive, GetInfo, GetBin, AccIn)</c> on + successive files in the <c>Archive</c>, starting with <c>AccIn + == Acc0</c>. <c>FileInArchive</c> is the name that the file + has in the archive. <c>GetInfo</c> is a fun that returns info + about the the file. <c>GetBin</c> returns the contents of the + file. Both <c>GetInfo</c> and <c>GetBin</c> must be called + within the <c>Fun</c>. Their behavior is undefined if they are + called outside the context of the <c>Fun</c>. The <c>Fun</c> + must return a new accumulator which is passed to the next + call. <c>foldl/3</c> returns the final value of the + accumulator. <c>Acc0</c> is returned if the archive is + empty. It is not necessary to iterate over all files in the + archive. The iteration may be ended prematurely in a + controlled manner by throwing an exception.</p> + + <p>For example:</p> + <pre> +> <input>Name = "dummy.zip".</input> +"dummy.zip" +> <input>{ok, {Name, Bin}} = zip:create(Name, [{"foo", <<"FOO">>}, {"bar", <<"BAR">>}], [memory]).</input> +{ok,{"dummy.zip", + <<80,75,3,4,20,0,0,0,0,0,74,152,97,60,171,39,212,26,3,0, + 0,0,3,0,0,...>>}} +> <input>{ok, FileSpec} = zip:foldl(fun(N, I, B, Acc) -> [{N, B(), I()} | Acc] end, [], {Name, Bin}).</input> +{ok,[{"bar",<<"BAR">>, + {file_info,3,regular,read_write, + {{2010,3,1},{19,2,10}}, + {{2010,3,1},{19,2,10}}, + {{2010,3,1},{19,2,10}}, + 54,1,0,0,0,0,0}}, + {"foo",<<"FOO">>, + {file_info,3,regular,read_write, + {{2010,3,1},{19,2,10}}, + {{2010,3,1},{19,2,10}}, + {{2010,3,1},{19,2,10}}, + 54,1,0,0,0,0,0}}]} +> <input>{ok, {Name, Bin}} = zip:create(Name, lists:reverse(FileSpec), [memory]).</input> +{ok,{"dummy.zip", + <<80,75,3,4,20,0,0,0,0,0,74,152,97,60,171,39,212,26,3,0, + 0,0,3,0,0,...>>}} +> <input>catch zip:foldl(fun("foo", _, B, _) -> throw(B()); (_, _, _, Acc) -> Acc end, [], {Name, Bin}). </input> +<<"FOO">> +</pre> + </desc> + </func> + <func> <name>list_dir(Archive) -> RetValue</name> <name>list_dir(Archive, Options)</name> <name>table(Archive) -> RetValue</name> diff --git a/lib/stdlib/src/beam_lib.erl b/lib/stdlib/src/beam_lib.erl index 820afd3739..c71dad6163 100644 --- a/lib/stdlib/src/beam_lib.erl +++ b/lib/stdlib/src/beam_lib.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2000-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2000-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% -module(beam_lib). @@ -44,9 +44,6 @@ -import(lists, [append/1, delete/2, foreach/2, keysort/2, member/2, reverse/1, sort/1, splitwith/2]). --include_lib("kernel/include/file.hrl"). --include("erl_compile.hrl"). - %%------------------------------------------------------------------------- -type beam() :: module() | file:filename() | binary(). @@ -331,13 +328,11 @@ beam_files(Dir) -> %% -> ok | throw(Error) cmp_files(File1, File2) -> - {ok, {M1, L1}} = read_significant_chunks(File1), - {ok, {M2, L2}} = read_significant_chunks(File2), + {ok, {M1, L1}} = read_all_but_useless_chunks(File1), + {ok, {M2, L2}} = read_all_but_useless_chunks(File2), if M1 =:= M2 -> - List1 = filter_funtab(L1), - List2 = filter_funtab(L2), - cmp_lists(List1, List2); + cmp_lists(L1, L2); true -> error({modules_different, M1, M2}) end. @@ -408,6 +403,20 @@ pad(Size) -> end. %% -> {ok, {Module, Chunks}} | throw(Error) +read_all_but_useless_chunks(File0) when is_atom(File0); + is_list(File0); + is_binary(File0) -> + File = beam_filename(File0), + {ok, Module, ChunkIds0} = scan_beam(File, info), + ChunkIds = [Name || {Name,_,_} <- ChunkIds0, + not is_useless_chunk(Name)], + {ok, Module, Chunks} = scan_beam(File, ChunkIds), + {ok, {Module, lists:reverse(Chunks)}}. + +is_useless_chunk("CInf") -> true; +is_useless_chunk(_) -> false. + +%% -> {ok, {Module, Chunks}} | throw(Error) read_significant_chunks(File) -> case read_chunk_data(File, significant_chunks(), [allow_missing_chunks]) of {ok, {Module, Chunks0}} -> diff --git a/lib/stdlib/src/c.erl b/lib/stdlib/src/c.erl index 433833e233..e05a1c787f 100644 --- a/lib/stdlib/src/c.erl +++ b/lib/stdlib/src/c.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% -module(c). @@ -31,10 +31,14 @@ -export([display_info/1]). -export([appcall/4]). --import(lists, [reverse/1,flatten/1,sublist/3,sort/1,keysearch/3,keysort/2, +-import(lists, [reverse/1,flatten/1,sublist/3,sort/1,keysort/2, concat/1,max/1,min/1,foreach/2,foldl/3,flatmap/2]). -import(io, [format/1, format/2]). +%%----------------------------------------------------------------------- + +-spec help() -> 'ok'. + help() -> format("bt(Pid) -- stack backtrace for a process\n" "c(File) -- compile and load code in <File>\n" @@ -65,8 +69,12 @@ help() -> %% c(FileName) %% Compile a file/module. +-spec c(file:name()) -> {'ok', module()} | 'error'. + c(File) -> c(File, []). +-spec c(file:name(), [compile:option()]) -> {'ok', module()} | 'error'. + c(File, Opts0) when is_list(Opts0) -> Opts = [report_errors,report_warnings|Opts0], case compile:file(File, Opts) of @@ -82,6 +90,8 @@ c(File, Opt) -> %%% Obtain the 'outdir' option from the argument. Return "." if no %%% such option was given. +-spec outdir([compile:option()]) -> file:filename(). + outdir([]) -> "."; outdir([Opt|Rest]) -> @@ -118,8 +128,8 @@ machine_load(Mod, File, Opts) -> %%% 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, R}; -check_load(_, X) -> {ok, X}. +check_load({error, _R} = Error, _) -> Error; +check_load(_, Mod) -> {ok, Mod}. %% Compile a list of modules %% enables the nice unix shell cmd @@ -128,6 +138,8 @@ check_load(_, X) -> {ok, X}. %% with constant c2 defined, c1=v1 (v1 must be a term!), include dir %% IDir, outdir ODir. +-spec lc([erl_compile:cmd_line_arg()]) -> 'ok' | 'error'. + lc(Args) -> case catch split(Args, [], []) of error -> error; @@ -145,7 +157,7 @@ lc_batch() -> io:format("Error: no files to compile~n"), halt(1). --spec lc_batch([_]) -> no_return(). +-spec lc_batch([erl_compile:cmd_line_arg()]) -> no_return(). lc_batch(Args) -> try split(Args, [], []) of @@ -191,8 +203,13 @@ make_term(Str) -> throw(error) end. +-spec nc(file:name()) -> {'ok', module()} | 'error'. + nc(File) -> nc(File, []). +-spec nc(file:name(), [compile:option()] | compile:option()) -> + {'ok', module} | 'error'. + nc(File, Opts0) when is_list(Opts0) -> Opts = Opts0 ++ [report_errors, report_warnings], case compile:file(File, Opts) of @@ -215,26 +232,37 @@ nc(File, Opt) when is_atom(Opt) -> %% l(Mod) %% Reload module Mod from file of same name +-spec l(module()) -> code:load_ret(). l(Mod) -> code:purge(Mod), code:load_file(Mod). %% Network version of l/1 +%%-spec nl(module()) -> nl(Mod) -> case code:get_object_code(Mod) of {_Module, Bin, Fname} -> - rpc:eval_everywhere(code,load_binary,[Mod,Fname,Bin]); + rpc:eval_everywhere(code, load_binary, [Mod, Fname, Bin]); Other -> Other end. +-spec i() -> 'ok'. + i() -> i(processes()). + +-spec ni() -> 'ok'. + ni() -> i(all_procs()). +-spec i([pid()]) -> 'ok'. + i(Ps) -> i(Ps, length(Ps)). +-spec i([pid()], non_neg_integer()) -> 'ok'. + i(Ps, N) when N =< 100 -> iformat("Pid", "Initial Call", "Heap", "Reds", "Msgs"), @@ -275,7 +303,6 @@ paged_i(Ps, Acc, N, Page) -> paged_i([], NewAcc, 0, Page) end. - choice(F) -> case get_line('(c)ontinue (q)uit -->', "c\n") of "c\n" -> @@ -285,7 +312,6 @@ choice(F) -> _ -> choice(F) end. - get_line(P, Default) -> case io:get_line(P) of @@ -305,7 +331,6 @@ mfa_string({M,F,A}) -> mfa_string(X) -> w(X). - display_info(Pid) -> case pinfo(Pid) of undefined -> {0,0,0,0}; @@ -317,7 +342,7 @@ display_info(Pid) -> Other -> Other end, - Reds = fetch(reductions, Info), + Reds = fetch(reductions, Info), LM = length(fetch(messages, Info)), HS = fetch(heap_size, Info), SS = fetch(stack_size, Info), @@ -364,21 +389,30 @@ pinfo(Pid) -> end. fetch(Key, Info) -> - case keysearch(Key, 1, Info) of - {value, {_, Val}} -> Val; + case lists:keyfind(Key, 1, Info) of + {_, Val} -> Val; false -> 0 end. -pid(X,Y,Z) -> +-spec pid(non_neg_integer(), non_neg_integer(), non_neg_integer()) -> pid(). + +pid(X, Y, Z) -> list_to_pid("<" ++ integer_to_list(X) ++ "." ++ integer_to_list(Y) ++ "." ++ integer_to_list(Z) ++ ">"). -i(X,Y,Z) -> pinfo(pid(X,Y,Z)). +-spec i(non_neg_integer(), non_neg_integer(), non_neg_integer()) -> + [{atom(), term()}]. + +i(X, Y, Z) -> pinfo(pid(X, Y, Z)). + +-spec q() -> no_return(). q() -> init:stop(). +-spec bt(pid()) -> 'ok' | 'undefined'. + bt(Pid) -> case catch erlang:process_display(Pid, backtrace) of {'EXIT', _} -> @@ -387,6 +421,8 @@ bt(Pid) -> ok end. +-spec m() -> 'ok'. + m() -> mformat("Module", "File"), foreach(fun ({Mod,File}) -> mformat(Mod, File) end, sort(code:all_loaded())). @@ -414,8 +450,8 @@ error(Fmt, Args) -> f_p_e(P, F) -> case file:path_eval(P, F) of - {error, enoent} -> - {error, enoent}; + {error, enoent} = Enoent -> + Enoent; {error, E={Line, _Mod, _Term}} -> error("file:path_eval(~p,~p): error on line ~p: ~s~n", [P, F, Line, file:format_error(E)]), @@ -438,10 +474,11 @@ bi(I) -> %% %% Short and nice form of module info %% +-spec m(module()) -> 'ok'. m(M) -> L = M:module_info(), - {value,{exports,E}} = keysearch(exports, 1, L), + {exports,E} = lists:keyfind(exports, 1, L), Time = get_compile_time(L), COpts = get_compile_options(L), format("Module ~w compiled: ",[M]), print_time(Time), @@ -470,10 +507,10 @@ get_compile_options(L) -> end. get_compile_info(L, Tag) -> - case keysearch(compile, 1, L) of - {value, {compile, I}} -> - case keysearch(Tag, 1, I) of - {value, {Tag, Val}} -> {ok,Val}; + case lists:keyfind(compile, 1, L) of + {compile, I} -> + case lists:keyfind(Tag, 1, I) of + {Tag, Val} -> {ok,Val}; false -> error end; false -> error @@ -523,6 +560,8 @@ month(11) -> "November"; month(12) -> "December". %% Just because we can't eval receive statements... +-spec flush() -> 'ok'. + flush() -> receive X -> @@ -533,9 +572,13 @@ flush() -> end. %% Print formatted info about all registered names in the system +-spec nregs() -> 'ok'. + nregs() -> foreach(fun (N) -> print_node_regs(N) end, all_regs()). +-spec regs() -> 'ok'. + regs() -> print_node_regs({node(),registered()}). @@ -609,6 +652,8 @@ portformat(Name, Id, Cmd) -> %% cd(Directory) %% These are just wrappers around the file:get/set_cwd functions. +-spec pwd() -> 'ok'. + pwd() -> case file:get_cwd() of {ok, Str} -> @@ -617,6 +662,8 @@ pwd() -> ok = io:format("Cannot determine current directory\n") end. +-spec cd(file:name()) -> 'ok'. + cd(Dir) -> file:set_cwd(Dir), pwd(). @@ -625,9 +672,13 @@ cd(Dir) -> %% ls(Directory) %% The strategy is to print in fixed width files. +-spec ls() -> 'ok'. + ls() -> ls("."). +-spec ls(file:name()) -> 'ok'. + ls(Dir) -> case file:list_dir(Dir) of {ok, Entries} -> @@ -660,24 +711,31 @@ w(X) -> %% memory/[0,1] %% -memory() -> erlang:memory(). +-spec memory() -> [{atom(), non_neg_integer()}]. + +memory() -> erlang:memory(). + +-spec memory(atom()) -> non_neg_integer() + ; ([atom()]) -> [{atom(), non_neg_integer()}]. + memory(TypeSpec) -> erlang:memory(TypeSpec). %% %% Cross Reference Check %% - +%%-spec xm(module() | file:filename()) -> xref:m/1 return xm(M) -> appcall(tools, xref, m, [M]). %% %% Call yecc %% - +%%-spec y(file:name()) -> yecc:file/2 return y(File) -> y(File, []). +%%-spec y(file:name(), [yecc:option()]) -> yecc:file/2 return y(File, Opts) -> - appcall(parsetools, yecc, file, [File,Opts]). + appcall(parsetools, yecc, file, [File, Opts]). %% @@ -699,4 +757,3 @@ appcall(App, M, F, Args) -> erlang:raise(error, undef, Stk) end end. - diff --git a/lib/stdlib/src/dets_sup.erl b/lib/stdlib/src/dets_sup.erl index 5c6caa787d..8ea2ba9b3f 100644 --- a/lib/stdlib/src/dets_sup.erl +++ b/lib/stdlib/src/dets_sup.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2002-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2002-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% -module(dets_sup). @@ -22,9 +22,16 @@ -export([start_link/0, init/1]). +-spec start_link() -> {'ok', pid()} | 'ignore' | {'error', term()}. + start_link() -> supervisor:start_link({local, dets_sup}, dets_sup, []). +-spec init([]) -> + {'ok', {{'simple_one_for_one', 4, 3600}, + [{'dets', {'dets', 'istart_link', []}, + 'temporary', 30000, 'worker', ['dets']}]}}. + init([]) -> SupFlags = {simple_one_for_one, 4, 3600}, Child = {dets, {dets, istart_link, []}, temporary, 30000, worker, [dets]}, diff --git a/lib/stdlib/src/epp.erl b/lib/stdlib/src/epp.erl index 2aa52ea84a..f144cbb938 100644 --- a/lib/stdlib/src/epp.erl +++ b/lib/stdlib/src/epp.erl @@ -109,6 +109,8 @@ format_error(cannot_parse) -> io_lib:format("cannot parse file, giving up", []); format_error({bad,W}) -> io_lib:format("badly formed '~s'", [W]); +format_error(missing_parenthesis) -> + io_lib:format("badly formed define: missing closing right parenthesis",[]); format_error({call,What}) -> io_lib:format("illegal macro call '~s'",[What]); format_error({undefined,M,none}) -> @@ -176,6 +178,8 @@ parse_file(Epp) -> [{eof,Location}] end. +normalize_typed_record_fields([]) -> + {typed, []}; normalize_typed_record_fields(Fields) -> normalize_typed_record_fields(Fields, [], false). @@ -413,7 +417,7 @@ scan_toks(From, St) -> leave_file(From, St#epp{location=Cl}); {error,_E} -> epp_reply(From, {error,{St#epp.location,epp,cannot_parse}}), - leave_file(From, St) %This serious, just exit! + leave_file(wait_request(St), St) %This serious, just exit! end. scan_toks([{'-',_Lh},{atom,_Ld,define}=Define|Toks], From, St) -> @@ -489,26 +493,32 @@ scan_extends(_Ts, _As, Ms) -> Ms. scan_define([{'(',_Lp},{Type,_Lm,M}=Mac,{',',_Lc}|Toks], _Def, From, St) when Type =:= atom; Type =:= var -> - case dict:find({atom,M}, St#epp.macs) of - {ok, Defs} when is_list(Defs) -> - %% User defined macros: can be overloaded - case proplists:is_defined(none, Defs) of - true -> - epp_reply(From, {error,{loc(Mac),epp,{redefine,M}}}), + case catch macro_expansion(Toks) of + Expansion when is_list(Expansion) -> + case dict:find({atom,M}, St#epp.macs) of + {ok, Defs} when is_list(Defs) -> + %% User defined macros: can be overloaded + case proplists:is_defined(none, Defs) of + true -> + epp_reply(From, {error,{loc(Mac),epp,{redefine,M}}}), + wait_req_scan(St); + false -> + scan_define_cont(From, St, + {atom, M}, + {none, {none,Expansion}}) + end; + {ok, _PreDef} -> + %% Predefined macros: cannot be overloaded + epp_reply(From, {error,{loc(Mac),epp,{redefine_predef,M}}}), wait_req_scan(St); - false -> + error -> scan_define_cont(From, St, {atom, M}, - {none, {none,macro_expansion(Toks)}}) + {none, {none,Expansion}}) end; - {ok, _PreDef} -> - %% Predefined macros: cannot be overloaded - epp_reply(From, {error,{loc(Mac),epp,{redefine_predef,M}}}), - wait_req_scan(St); - error -> - scan_define_cont(From, St, - {atom, M}, - {none, {none,macro_expansion(Toks)}}) + {error,ErrL,What} -> + epp_reply(From, {error,{ErrL,epp,What}}), + wait_req_scan(St) end; scan_define([{'(',_Lp},{Type,_Lm,M}=Mac,{'(',_Lc}|Toks], Def, From, St) when Type =:= atom; Type =:= var -> @@ -534,6 +544,9 @@ scan_define([{'(',_Lp},{Type,_Lm,M}=Mac,{'(',_Lc}|Toks], Def, From, St) error -> scan_define_cont(From, St, {atom, M}, {Len, {As, Me}}) end; + {error,ErrL,What} -> + epp_reply(From, {error,{ErrL,epp,What}}), + wait_req_scan(St); _ -> epp_reply(From, {error,{loc(Def),epp,{bad,define}}}), wait_req_scan(St) @@ -787,7 +800,7 @@ skip_toks(From, St, [I|Sis]) -> leave_file(From, St#epp{location=Cl,istk=[I|Sis]}); {error,_E} -> epp_reply(From, {error,{St#epp.location,epp,cannot_parse}}), - leave_file(From, St) %This serious, just exit! + leave_file(wait_request(St), St) %This serious, just exit! end; skip_toks(From, St, []) -> scan_toks(From, St). @@ -814,7 +827,7 @@ macro_pars([{var,_L,Name}, {',',_}|Ts], Args) -> macro_pars(Ts, [Name|Args]). macro_expansion([{')',_Lp},{dot,_Ld}]) -> []; -macro_expansion([{dot,_Ld}]) -> []; %Be nice, allow no right paren! +macro_expansion([{dot,Ld}]) -> throw({error,Ld,missing_parenthesis}); macro_expansion([T|Ts]) -> [T|macro_expansion(Ts)]. diff --git a/lib/stdlib/src/erl_expand_records.erl b/lib/stdlib/src/erl_expand_records.erl index 6fa77f2c3b..a38b7639d8 100644 --- a/lib/stdlib/src/erl_expand_records.erl +++ b/lib/stdlib/src/erl_expand_records.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2005-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2005-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% %% Purpose : Expand records into tuples. @@ -191,7 +191,6 @@ guard_test1(Test, St) -> normalise_test(atom, 1) -> is_atom; normalise_test(binary, 1) -> is_binary; -normalise_test(constant, 1) -> is_constant; normalise_test(float, 1) -> is_float; normalise_test(function, 1) -> is_function; normalise_test(integer, 1) -> is_integer; @@ -346,9 +345,6 @@ expr({'fun',Line,{clauses,Cs0}}, St0) -> {{'fun',Line,{clauses,Cs}},St1}; expr({call,Line,{atom,_,is_record},[A,{atom,_,Name}]}, St) -> record_test(Line, A, Name, St); -expr({'cond',Line,Cs0}, St0) -> - {Cs,St1} = clauses(Cs0, St0), - {{'cond',Line,Cs},St1}; expr({call,Line,{remote,_,{atom,_,erlang},{atom,_,is_record}}, [A,{atom,_,Name}]}, St) -> record_test(Line, A, Name, St); diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index 91f7641af7..94ad560549 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -1021,11 +1021,8 @@ func_line_error(Type, Fs, St) -> check_untyped_records(Forms, St0) -> case is_warn_enabled(untyped_record, St0) of true -> - %% One possibility is to use the names of all records - %% RecNames = dict:fetch_keys(St0#lint.records), - %% but I think it's better to keep those that are used by the file - Usage = St0#lint.usage, - UsedRecNames = sets:to_list(Usage#usage.used_records), + %% Use the names of all records *defined* in the module (not used) + RecNames = dict:fetch_keys(St0#lint.records), %% these are the records with field(s) containing type info TRecNames = [Name || {attribute,_,type,{{record,Name},Fields,_}} <- Forms, @@ -1038,7 +1035,7 @@ check_untyped_records(Forms, St0) -> [] -> St; % exclude records with no fields [_|_] -> add_warning(L, {untyped_record, N}, St) end - end, St0, UsedRecNames -- TRecNames); + end, St0, RecNames -- TRecNames); false -> St0 end. @@ -1943,8 +1940,6 @@ expr({'case',Line,E,Cs}, Vt, St0) -> {Evt,St1} = expr(E, Vt, St0), {Cvt,St2} = icrt_clauses(Cs, {'case',Line}, vtupdate(Evt, Vt), St1), {vtmerge(Evt, Cvt),St2}; -expr({'cond',Line,Cs}, Vt, St) -> - cond_clauses(Cs,{'cond',Line}, Vt, St); expr({'receive',Line,Cs}, Vt, St) -> icrt_clauses(Cs, {'receive',Line}, Vt, St); expr({'receive',Line,Cs,To,ToEs}, Vt, St0) -> @@ -2720,45 +2715,6 @@ icrt_clause({clause,_Line,H,G,B}, Vt0, St0) -> {Bvt,St3} = exprs(B, Vt2, St2), {vtupdate(Bvt, Vt2),St3}. -%% The tests of 'cond' clauses are normal expressions - not guards. -%% Variables bound in a test is visible both in the corresponding body -%% and in the tests and bodies of subsequent clauses: a 'cond' is -%% *equivalent* to nested case-switches on boolean expressions. - -cond_clauses([C], In, Vt, St) -> - last_cond_clause(C, In, Vt, St); -cond_clauses([C | Cs], In, Vt, St) -> - cond_clause(C, Cs, In, Vt, St). - -%% see expr/3 for 'case' -cond_clause({clause,_L,[],[[E]],B}, Cs, In, Vt, St0) -> - {Evt,St1} = expr(E, Vt, St0), - {Cvt, St2} = cond_cases(B, Cs, In, vtupdate(Evt, Vt), St1), - Mvt = vtmerge(Evt, Cvt), - {Mvt,St2}. - -%% see icrt_clauses/4 -cond_cases(B, Cs, In, Vt, St0) -> - %% note that Vt is used for both cases - {Bvt,St1} = exprs(B, Vt, St0), % true case - Vt1 = vtupdate(Bvt, Vt), - {Cvt, St2} = cond_clauses(Cs, In, Vt, St1), % false case - Vt2 = vtupdate(Cvt, Vt), - %% and this also uses Vt - icrt_export([Vt1,Vt2], Vt, In, St2). - -%% last case must call icrt_export/4 with only one vartable -last_cond_clause({clause,_L,[],[[E]],B}, In, Vt, St0) -> - {Evt,St1} = expr(E, Vt, St0), - {Cvt, St2} = last_cond_case(B, In, vtupdate(Evt, Vt), St1), - Mvt = vtmerge(Evt, Cvt), - {Mvt,St2}. - -last_cond_case(B, In, Vt, St0) -> - {Bvt,St1} = exprs(B, Vt, St0), - Vt1 = vtupdate(Bvt, Vt), - icrt_export([Vt1], Vt, In, St1). - icrt_export(Csvt, Vt, In, St) -> Vt1 = vtmerge(Csvt), All = ordsets:subtract(vintersection(Csvt), vtnames(Vt)), diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl index fd5d905797..5287f55e59 100644 --- a/lib/stdlib/src/erl_parse.yrl +++ b/lib/stdlib/src/erl_parse.yrl @@ -1,20 +1,20 @@ %% -*- erlang -*- %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% @@ -30,14 +30,12 @@ expr_600 expr_700 expr_800 expr_900 expr_max list tail list_comprehension lc_expr lc_exprs -binary_comprehension +binary_comprehension tuple -atom1 %struct record_expr record_tuple record_field record_fields if_expr if_clause if_clauses case_expr cr_clause cr_clauses receive_expr fun_expr fun_clause fun_clauses -%% cond_expr cond_clause cond_clauses try_expr try_catch try_clause try_clauses query_expr function_call argument_list exprs guard @@ -56,8 +54,7 @@ char integer float atom string var '(' ')' ',' '->' ':-' '{' '}' '[' ']' '|' '||' '<-' ';' ':' '#' '.' 'after' 'begin' 'case' 'try' 'catch' 'end' 'fun' 'if' 'of' 'receive' 'when' -'andalso' 'orelse' 'query' 'spec' -%% 'cond' +'andalso' 'orelse' 'query' 'bnot' 'not' '*' '/' 'div' 'rem' 'band' 'and' '+' '-' 'bor' 'bxor' 'bsl' 'bsr' 'or' 'xor' @@ -65,6 +62,7 @@ char integer float atom string var '==' '/=' '=<' '<' '>=' '>' '=:=' '=/=' '<=' '<<' '>>' '!' '=' '::' +'spec' % helper dot. Expect 2. @@ -79,19 +77,16 @@ attribute -> '-' atom attr_val : build_attribute('$2', '$3'). attribute -> '-' atom typed_attr_val : build_typed_attribute('$2','$3'). attribute -> '-' atom '(' typed_attr_val ')' : build_typed_attribute('$2','$4'). attribute -> '-' 'spec' type_spec : build_type_spec('$2', '$3'). - -atom1 -> 'spec' : {atom, ?line('$1'), 'spec'}. -atom1 -> atom : '$1'. type_spec -> spec_fun type_sigs : {'$1', '$2'}. type_spec -> '(' spec_fun type_sigs ')' : {'$2', '$3'}. -spec_fun -> atom1 : '$1'. -spec_fun -> atom1 ':' atom1 : {'$1', '$3'}. +spec_fun -> atom : '$1'. +spec_fun -> atom ':' atom : {'$1', '$3'}. %% The following two are retained only for backwards compatibility; %% they are not part of the EEP syntax and should be removed. -spec_fun -> atom1 '/' integer '::' : {'$1', '$3'}. -spec_fun -> atom1 ':' atom1 '/' integer '::' : {'$1', '$3', '$5'}. +spec_fun -> atom '/' integer '::' : {'$1', '$3'}. +spec_fun -> atom ':' atom '/' integer '::' : {'$1', '$3', '$5'}. typed_attr_val -> expr ',' typed_record_fields : {typed_record, '$1', '$3'}. typed_attr_val -> expr '::' top_type : {type_def, '$1', '$3'}. @@ -109,14 +104,15 @@ type_sigs -> type_sig : ['$1']. type_sigs -> type_sig ';' type_sigs : ['$1'|'$3']. type_sig -> fun_type : '$1'. -type_sig -> fun_type 'when' type_guards : {type, ?line('$1'), bounded_fun, +type_sig -> fun_type 'when' type_guards : {type, ?line('$1'), bounded_fun, ['$1','$3']}. type_guards -> type_guard : ['$1']. type_guards -> type_guard ',' type_guards : ['$1'|'$3']. -type_guard -> atom1 '(' top_types ')' : {type, ?line('$1'), constraint, +type_guard -> atom '(' top_types ')' : {type, ?line('$1'), constraint, ['$1', '$3']}. +type_guard -> var '::' top_type : build_def('$1', '$3'). top_types -> top_type : ['$1']. top_types -> top_type ',' top_types : ['$1'|'$3']. @@ -129,53 +125,53 @@ top_type_100 -> type '|' top_type_100 : lift_unions('$1','$3'). type -> '(' top_type ')' : {paren_type, ?line('$2'), ['$2']}. type -> var : '$1'. -type -> atom1 : '$1'. -type -> atom1 '(' ')' : build_gen_type('$1'). -type -> atom1 '(' top_types ')' : {type, ?line('$1'), +type -> atom : '$1'. +type -> atom '(' ')' : build_gen_type('$1'). +type -> atom '(' top_types ')' : {type, ?line('$1'), normalise('$1'), '$3'}. -type -> atom1 ':' atom1 '(' ')' : {remote_type, ?line('$1'), +type -> atom ':' atom '(' ')' : {remote_type, ?line('$1'), ['$1', '$3', []]}. -type -> atom1 ':' atom1 '(' top_types ')' : {remote_type, ?line('$1'), +type -> atom ':' atom '(' top_types ')' : {remote_type, ?line('$1'), ['$1', '$3', '$5']}. type -> '[' ']' : {type, ?line('$1'), nil, []}. type -> '[' top_type ']' : {type, ?line('$1'), list, ['$2']}. -type -> '[' top_type ',' '.' '.' '.' ']' : {type, ?line('$1'), +type -> '[' top_type ',' '.' '.' '.' ']' : {type, ?line('$1'), nonempty_list, ['$2']}. type -> '{' '}' : {type, ?line('$1'), tuple, []}. type -> '{' top_types '}' : {type, ?line('$1'), tuple, '$2'}. -type -> '#' atom1 '{' '}' : {type, ?line('$1'), record, ['$2']}. -type -> '#' atom1 '{' field_types '}' : {type, ?line('$1'), +type -> '#' atom '{' '}' : {type, ?line('$1'), record, ['$2']}. +type -> '#' atom '{' field_types '}' : {type, ?line('$1'), record, ['$2'|'$4']}. type -> binary_type : '$1'. type -> int_type : '$1'. -type -> int_type '.' '.' int_type : {type, ?line('$1'), range, +type -> int_type '.' '.' int_type : {type, ?line('$1'), range, ['$1', '$4']}. type -> 'fun' '(' ')' : {type, ?line('$1'), 'fun', []}. type -> 'fun' '(' fun_type_100 ')' : '$3'. int_type -> integer : '$1'. -int_type -> '-' integer : abstract(-normalise('$2'), +int_type -> '-' integer : abstract(-normalise('$2'), ?line('$2')). -fun_type_100 -> '(' '.' '.' '.' ')' '->' top_type +fun_type_100 -> '(' '.' '.' '.' ')' '->' top_type : {type, ?line('$1'), 'fun', [{type, ?line('$1'), any}, '$7']}. fun_type_100 -> fun_type : '$1'. fun_type -> '(' ')' '->' top_type : {type, ?line('$1'), 'fun', [{type, ?line('$1'), product, []}, '$4']}. -fun_type -> '(' top_types ')' '->' top_type +fun_type -> '(' top_types ')' '->' top_type : {type, ?line('$1'), 'fun', [{type, ?line('$1'), product, '$2'},'$5']}. field_types -> field_type : ['$1']. field_types -> field_type ',' field_types : ['$1'|'$3']. -field_type -> atom1 '::' top_type : {type, ?line('$1'), field_type, +field_type -> atom '::' top_type : {type, ?line('$1'), field_type, ['$1', '$3']}. -binary_type -> '<<' '>>' : {type, ?line('$1'),binary, - [abstract(0, ?line('$1')), +binary_type -> '<<' '>>' : {type, ?line('$1'),binary, + [abstract(0, ?line('$1')), abstract(0, ?line('$1'))]}. binary_type -> '<<' bin_base_type '>>' : {type, ?line('$1'),binary, ['$2', abstract(0, ?line('$1'))]}. @@ -197,7 +193,7 @@ function -> function_clauses : build_function('$1'). function_clauses -> function_clause : ['$1']. function_clauses -> function_clause ';' function_clauses : ['$1'|'$3']. -function_clause -> atom1 clause_args clause_guard clause_body : +function_clause -> atom clause_args clause_guard clause_body : {clause,?line('$1'),element(3, '$1'),'$2','$3','$4'}. @@ -250,9 +246,9 @@ expr_800 -> expr_900 ':' expr_max : {remote,?line('$2'),'$1','$3'}. expr_800 -> expr_900 : '$1'. -expr_900 -> '.' atom1 : +expr_900 -> '.' atom : {record_field,?line('$1'),{atom,?line('$1'),''},'$2'}. -expr_900 -> expr_900 '.' atom1 : +expr_900 -> expr_900 '.' atom : {record_field,?line('$2'),'$1','$3'}. expr_900 -> expr_max : '$1'. @@ -270,7 +266,6 @@ expr_max -> if_expr : '$1'. expr_max -> case_expr : '$1'. expr_max -> receive_expr : '$1'. expr_max -> fun_expr : '$1'. -%%expr_max -> cond_expr : '$1'. expr_max -> try_expr : '$1'. expr_max -> query_expr : '$1'. @@ -304,8 +299,8 @@ opt_bit_type_list -> '$empty' : default. bit_type_list -> bit_type '-' bit_type_list : ['$1' | '$3']. bit_type_list -> bit_type : ['$1']. -bit_type -> atom1 : element(3,'$1'). -bit_type -> atom1 ':' integer : { element(3,'$1'), element(3,'$3') }. +bit_type -> atom : element(3,'$1'). +bit_type -> atom ':' integer : { element(3,'$1'), element(3,'$3') }. bit_size_expr -> expr_max : '$1'. @@ -325,7 +320,7 @@ tuple -> '{' '}' : {tuple,?line('$1'),[]}. tuple -> '{' exprs '}' : {tuple,?line('$1'),'$2'}. -%%struct -> atom1 tuple : +%%struct -> atom tuple : %% {struct,?line('$1'),element(3, '$1'),element(3, '$2')}. @@ -333,13 +328,17 @@ tuple -> '{' exprs '}' : {tuple,?line('$1'),'$2'}. %% N.B. Field names are returned as the complete object, even if they are %% always atoms for the moment, this might change in the future. -record_expr -> '#' atom1 '.' atom1 : +record_expr -> '#' atom '.' atom : {record_index,?line('$1'),element(3, '$2'),'$4'}. -record_expr -> '#' atom1 record_tuple : +record_expr -> '#' atom record_tuple : {record,?line('$1'),element(3, '$2'),'$3'}. -record_expr -> expr_max '#' atom1 '.' atom1 : +record_expr -> expr_max '#' atom '.' atom : {record_field,?line('$2'),'$1',element(3, '$3'),'$5'}. -record_expr -> expr_max '#' atom1 record_tuple : +record_expr -> expr_max '#' atom record_tuple : + {record,?line('$2'),'$1',element(3, '$3'),'$4'}. +record_expr -> record_expr '#' atom '.' atom : + {record_field,?line('$2'),'$1',element(3, '$3'),'$5'}. +record_expr -> record_expr '#' atom record_tuple : {record,?line('$2'),'$1',element(3, '$3'),'$4'}. record_tuple -> '{' '}' : []. @@ -349,7 +348,7 @@ record_fields -> record_field : ['$1']. record_fields -> record_field ',' record_fields : ['$1' | '$3']. record_field -> var '=' expr : {record_field,?line('$1'),'$1','$3'}. -record_field -> atom1 '=' expr : {record_field,?line('$1'),'$1','$3'}. +record_field -> atom '=' expr : {record_field,?line('$1'),'$1','$3'}. %% N.B. This is called from expr_700. @@ -383,9 +382,9 @@ receive_expr -> 'receive' cr_clauses 'after' expr clause_body 'end' : {'receive',?line('$1'),'$2','$4','$5'}. -fun_expr -> 'fun' atom1 '/' integer : +fun_expr -> 'fun' atom '/' integer : {'fun',?line('$1'),{function,element(3, '$2'),element(3, '$4')}}. -fun_expr -> 'fun' atom1 ':' atom1 '/' integer : +fun_expr -> 'fun' atom ':' atom '/' integer : {'fun',?line('$1'),{function,element(3, '$2'),element(3, '$4'),element(3,'$6')}}. fun_expr -> 'fun' fun_clauses 'end' : build_fun(?line('$1'), '$2'). @@ -415,21 +414,13 @@ try_clauses -> try_clause ';' try_clauses : ['$1' | '$3']. try_clause -> expr clause_guard clause_body : L = ?line('$1'), {clause,L,[{tuple,L,[{atom,L,throw},'$1',{var,L,'_'}]}],'$2','$3'}. -try_clause -> atom1 ':' expr clause_guard clause_body : +try_clause -> atom ':' expr clause_guard clause_body : L = ?line('$1'), {clause,L,[{tuple,L,['$1','$3',{var,L,'_'}]}],'$4','$5'}. try_clause -> var ':' expr clause_guard clause_body : L = ?line('$1'), {clause,L,[{tuple,L,['$1','$3',{var,L,'_'}]}],'$4','$5'}. -%%cond_expr -> 'cond' cond_clauses 'end' : {'cond',?line('$1'),'$2'}. - -%%cond_clauses -> cond_clause : ['$1']. -%%cond_clauses -> cond_clause ';' cond_clauses : ['$1' | '$3']. - -%%cond_clause -> expr clause_body : -%% {clause,?line('$1'),[],[['$1']],'$2'}. - query_expr -> 'query' list_comprehension 'end' : {'query',?line('$1'),'$2'}. @@ -447,7 +438,7 @@ guard -> exprs ';' guard : ['$1'|'$3']. atomic -> char : '$1'. atomic -> integer : '$1'. atomic -> float : '$1'. -atomic -> atom1 : '$1'. +atomic -> atom : '$1'. atomic -> strings : '$1'. strings -> string : '$1'. @@ -492,7 +483,7 @@ rule -> rule_clauses : build_rule('$1'). rule_clauses -> rule_clause : ['$1']. rule_clauses -> rule_clause ';' rule_clauses : ['$1'|'$3']. -rule_clause -> atom1 clause_args clause_guard rule_body : +rule_clause -> atom clause_args clause_guard rule_body : {clause,?line('$1'),element(3, '$1'),'$2','$3','$4'}. rule_body -> ':-' lc_exprs: '$2'. @@ -514,8 +505,8 @@ Erlang code. %% mkop(Op, Arg) -> {op,Line,Op,Arg}. %% mkop(Left, Op, Right) -> {op,Line,Op,Left,Right}. --define(mkop2(L, OpPos, R), - begin +-define(mkop2(L, OpPos, R), + begin {Op,Pos} = OpPos, {op,Pos,Op,L,R} end). @@ -533,6 +524,8 @@ Erlang code. %% These really suck and are only here until Calle gets multiple %% entry points working. +parse_form([{'-',L1},{atom,L2,spec}|Tokens]) -> + parse([{'-',L1},{'spec',L2}|Tokens]); parse_form(Tokens) -> parse(Tokens). @@ -559,7 +552,7 @@ parse_term(Tokens) -> -type attributes() :: 'export' | 'file' | 'import' | 'module' | 'opaque' | 'record' | 'type'. -build_typed_attribute({atom,La,record}, +build_typed_attribute({atom,La,record}, {typed_record, {atom,_Ln,RecordName}, RecTuple}) -> {attribute,La,record,{RecordName,record_tuple(RecTuple)}}; build_typed_attribute({atom,La,Attr}, @@ -582,7 +575,7 @@ build_typed_attribute({atom,La,Attr},_) -> build_type_spec({spec,La}, {SpecFun, TypeSpecs}) -> NewSpecFun = case SpecFun of - {atom, _, Fun} -> + {atom, _, Fun} -> {Fun, find_arity_from_specs(TypeSpecs)}; {{atom,_, Mod}, {atom,_, Fun}} -> {Mod,Fun,find_arity_from_specs(TypeSpecs)}; @@ -605,6 +598,10 @@ find_arity_from_specs([Spec|_]) -> {type, _, 'fun', [{type, _, product, Args},_]} = Fun, length(Args). +build_def(LHS, Types) -> + IsSubType = {atom, ?line(LHS), is_subtype}, + {type, ?line(LHS), constraint, [IsSubType, [LHS, Types]]}. + lift_unions(T1, {type, _La, union, List}) -> {type, ?line(T1), union, [T1|List]}; lift_unions(T1, T2) -> @@ -716,7 +713,7 @@ attribute_farity(Other) -> Other. attribute_farity_list(Args) -> [attribute_farity(A) || A <- Args]. - + -spec error_bad_decl(integer(), attributes()) -> no_return(). error_bad_decl(L, S) -> @@ -739,17 +736,33 @@ record_fields([{match,_Lm,{atom,La,A},Expr}|Fields]) -> [{record_field,La,{atom,La,A},Expr}|record_fields(Fields)]; record_fields([{typed,Expr,TypeInfo}|Fields]) -> [Field] = record_fields([Expr]), - TypeInfo1 = + TypeInfo1 = case Expr of {match, _, _, _} -> TypeInfo; %% If we have an initializer. - {atom, La, _} -> - lift_unions(abstract(undefined, La), TypeInfo) - end, + {atom, La, _} -> + case has_undefined(TypeInfo) of + false -> + lift_unions(abstract(undefined, La), TypeInfo); + true -> + TypeInfo + end + end, [{typed_record_field,Field,TypeInfo1}|record_fields(Fields)]; record_fields([Other|_Fields]) -> ret_err(?line(Other), "bad record field"); record_fields([]) -> []. +has_undefined({atom,_,undefined}) -> + true; +has_undefined({ann_type,_,[_,T]}) -> + has_undefined(T); +has_undefined({paren_type,_,[T]}) -> + has_undefined(T); +has_undefined({type,_,union,Ts}) -> + lists:any(fun has_undefined/1, Ts); +has_undefined(_) -> + false. + term(Expr) -> try normalise(Expr) catch _:_R -> ret_err(?line(Expr), "bad attribute") @@ -989,7 +1002,7 @@ inop_prec('#') -> {800,700,800}; inop_prec(':') -> {900,800,900}; inop_prec('.') -> {900,900,1000}. --type pre_op() :: 'catch' | '+' | '-' | 'bnot' | '#'. +-type pre_op() :: 'catch' | '+' | '-' | 'bnot' | 'not' | '#'. -spec preop_prec(pre_op()) -> {0 | 600 | 700, 100 | 700 | 800}. diff --git a/lib/stdlib/src/erl_pp.erl b/lib/stdlib/src/erl_pp.erl index 93c2541e80..0859bf0466 100644 --- a/lib/stdlib/src/erl_pp.erl +++ b/lib/stdlib/src/erl_pp.erl @@ -170,8 +170,7 @@ ltype({type,Line,T,Ts}) -> ltype({remote_type,Line,[M,F,Ts]}) -> simple_type({remote,Line,M,F}, Ts); ltype({atom,_,T}) -> - %% Follow the convention to always quote atoms (in types): - leaf([$',atom_to_list(T),$']); + leaf(write(T)); ltype(E) -> lexpr(E, 0, none). diff --git a/lib/stdlib/src/erl_scan.erl b/lib/stdlib/src/erl_scan.erl index 52ec81a78b..1013d54bdc 100644 --- a/lib/stdlib/src/erl_scan.erl +++ b/lib/stdlib/src/erl_scan.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% @@ -48,7 +48,7 @@ -module(erl_scan). -%%% External exports +%%% External exports -export([string/1,string/2,string/3,tokens/3,tokens/4, format_error/1,reserved_word/1, @@ -98,41 +98,41 @@ -spec format_error(Error :: term()) -> string(). format_error({string,Quote,Head}) -> lists:flatten(["unterminated " ++ string_thing(Quote) ++ - " starting with " ++ + " starting with " ++ io_lib:write_unicode_string(Head, Quote)]); -format_error({illegal,Type}) -> +format_error({illegal,Type}) -> lists:flatten(io_lib:fwrite("illegal ~w", [Type])); format_error(char) -> "unterminated character"; -format_error({base,Base}) -> +format_error({base,Base}) -> lists:flatten(io_lib:fwrite("illegal base '~w'", [Base])); -format_error(Other) -> +format_error(Other) -> lists:flatten(io_lib:write(Other)). --type string_return() :: {'ok', tokens(), location()} +-type string_return() :: {'ok', tokens(), location()} | {'error', error_info(), location()}. -spec string(String :: string()) -> string_return(). string(String) -> string(String, 1, []). --spec string(String :: string(), StartLocation :: location()) -> +-spec string(String :: string(), StartLocation :: location()) -> string_return(). string(String, StartLocation) -> string(String, StartLocation, []). --spec string(String :: string(), StartLocation :: location(), +-spec string(String :: string(), StartLocation :: location(), Options :: options()) -> string_return(). string(String, Line, Options) when ?STRING(String), ?ALINE(Line) -> string1(String, options(Options), Line, no_col, []); string(String, {Line,Column}, Options) when ?STRING(String), - ?ALINE(Line), + ?ALINE(Line), ?COLUMN(Column) -> string1(String, options(Options), Line, Column, []). -type char_spec() :: string() | 'eof'. -type cont_fun() :: fun((char_spec(), #erl_scan{}, line(), column(), tokens(), any()) -> any()). --opaque return_cont() :: {string(), column(), tokens(), line(), +-opaque return_cont() :: {string(), column(), tokens(), line(), #erl_scan{}, cont_fun(), any()}. -type cont() :: return_cont() | []. -type tokens_result() :: {'ok', tokens(), location()} @@ -141,13 +141,13 @@ string(String, {Line,Column}, Options) when ?STRING(String), -type tokens_return() :: {'done', tokens_result(), char_spec()} | {'more', return_cont()}. --spec tokens(Cont :: cont(), CharSpec :: char_spec(), +-spec tokens(Cont :: cont(), CharSpec :: char_spec(), StartLocation :: location()) -> tokens_return(). tokens(Cont, CharSpec, StartLocation) -> tokens(Cont, CharSpec, StartLocation, []). --spec tokens(Cont :: cont(), CharSpec :: char_spec(), - StartLocation :: location(), Options :: options()) -> +-spec tokens(Cont :: cont(), CharSpec :: char_spec(), + StartLocation :: location(), Options :: options()) -> tokens_return(). tokens([], CharSpec, Line, Options) when ?ALINE(Line) -> tokens1(CharSpec, options(Options), Line, no_col, [], fun scan/6, []); @@ -157,15 +157,15 @@ tokens([], CharSpec, {Line,Column}, Options) when ?ALINE(Line), tokens({Cs,Col,Toks,Line,St,Any,Fun}, CharSpec, _Loc, _Opts) -> tokens1(Cs++CharSpec, St, Line, Col, Toks, Fun, Any). --type attribute_item() :: 'column' | 'length' | 'line' +-type attribute_item() :: 'column' | 'length' | 'line' | 'location' | 'text'. -type info_location() :: location() | term(). --type attribute_info() :: {'column', column()}| {'length', pos_integer()} - | {'line', info_line()} +-type attribute_info() :: {'column', column()}| {'length', pos_integer()} + | {'line', info_line()} | {'location', info_location()} | {'text', string()}. -type token_item() :: 'category' | 'symbol' | attribute_item(). --type token_info() :: {'category', category()} | {'symbol', symbol()} +-type token_info() :: {'category', category()} | {'symbol', symbol()} | attribute_info(). -spec token_info(token()) -> [token_info()]. @@ -214,7 +214,7 @@ attributes_info(Attrs, [A|As]) when is_atom(A) -> AttributeInfo when is_tuple(AttributeInfo) -> [AttributeInfo|attributes_info(Attrs, As)] end; -attributes_info({Line,Column}, column=Item) when ?ALINE(Line), +attributes_info({Line,Column}, column=Item) when ?ALINE(Line), ?COLUMN(Column) -> {Item,Column}; attributes_info(Line, column) when ?ALINE(Line) -> @@ -230,12 +230,12 @@ attributes_info(Attrs, length=Item) -> end; attributes_info(Line, line=Item) when ?ALINE(Line) -> {Item,Line}; -attributes_info({Line,Column}, line=Item) when ?ALINE(Line), +attributes_info({Line,Column}, line=Item) when ?ALINE(Line), ?COLUMN(Column) -> {Item,Line}; attributes_info(Attrs, line=Item) -> attr_info(Attrs, Item); -attributes_info({Line,Column}=Location, location=Item) when ?ALINE(Line), +attributes_info({Line,Column}=Location, location=Item) when ?ALINE(Line), ?COLUMN(Column) -> {Item,Location}; attributes_info(Line, location=Item) when ?ALINE(Line) -> @@ -289,11 +289,11 @@ string_thing(_) -> "string". options(Opts0) when is_list(Opts0) -> Opts = lists:foldr(fun expand_opt/2, [], Opts0), - [RW_fun] = + [RW_fun] = case opts(Opts, [reserved_word_fun], []) of badarg -> erlang:error(badarg, [Opts0]); - R -> + R -> R end, Comment = proplists:get_bool(return_comments, Opts), @@ -336,7 +336,7 @@ attr_info(Attrs, Item) -> case catch lists:keysearch(Item, 1, Attrs) of {value,{Item,Value}} -> {Item,Value}; - false -> + false -> undefined; _ -> erlang:error(badarg, [Attrs, Item]) @@ -591,12 +591,12 @@ scan_atom(Cs0, St, Line, Col, Toks, Ncs0) -> case catch list_to_atom(Wcs) of Name when is_atom(Name) -> case (St#erl_scan.resword_fun)(Name) of - true -> + true -> tok2(Cs, St, Line, Col, Toks, Wcs, Name); - false -> + false -> tok3(Cs, St, Line, Col, Toks, atom, Wcs, Name) end; - _Error -> + _Error -> Ncol = incr_column(Col, length(Wcs)), scan_error({illegal,atom}, Line, Col, Line, Ncol, Cs) end @@ -610,7 +610,7 @@ scan_variable(Cs0, St, Line, Col, Toks, Ncs0) -> case catch list_to_atom(Wcs) of Name when is_atom(Name) -> tok3(Cs, St, Line, Col, Toks, var, Wcs, Name); - _Error -> + _Error -> Ncol = incr_column(Col, length(Wcs)), scan_error({illegal,var}, Line, Col, Line, Ncol, Cs) end @@ -690,7 +690,7 @@ scan_nl_spcs([]=Cs, _St, Line, Col, Toks, N) -> {more,{Cs,Col,Toks,Line,N,fun scan_nl_spcs/6}}; scan_nl_spcs(Cs, St, Line, Col, Toks, N) -> newline_end(Cs, St, Line, Col, Toks, N, nl_spcs(N)). - + scan_nl_tabs([$\t|Cs], St, Line, Col, Toks, N) when N < 11 -> scan_nl_tabs(Cs, St, Line, Col, Toks, N+1); scan_nl_tabs([]=Cs, _St, Line, Col, Toks, N) -> @@ -701,7 +701,7 @@ scan_nl_tabs(Cs, St, Line, Col, Toks, N) -> %% Note: returning {more,Cont} is meaningless here; one could just as %% well return several tokens. But since tokens() scans up to a full %% stop anyway, nothing is gained by not collecting all white spaces. -scan_nl_white_space([$\n|Cs], #erl_scan{text = false}=St, Line, no_col=Col, +scan_nl_white_space([$\n|Cs], #erl_scan{text = false}=St, Line, no_col=Col, Toks0, Ncs) -> Toks = [{white_space,Line,lists:reverse(Ncs)}|Toks0], scan_newline(Cs, St, Line+1, Col, Toks); @@ -714,7 +714,7 @@ scan_nl_white_space([C|Cs], St, Line, Col, Toks, Ncs) when ?WHITE_SPACE(C) -> scan_nl_white_space(Cs, St, Line, Col, Toks, [C|Ncs]); scan_nl_white_space([]=Cs, _St, Line, Col, Toks, Ncs) -> {more,{Cs,Col,Toks,Line,Ncs,fun scan_nl_white_space/6}}; -scan_nl_white_space(Cs, #erl_scan{text = false}=St, Line, no_col=Col, +scan_nl_white_space(Cs, #erl_scan{text = false}=St, Line, no_col=Col, Toks, Ncs) -> scan1(Cs, St, Line+1, Col, [{white_space,Line,lists:reverse(Ncs)}|Toks]); scan_nl_white_space(Cs, St, Line, Col, Toks, Ncs0) -> @@ -723,7 +723,7 @@ scan_nl_white_space(Cs, St, Line, Col, Toks, Ncs0) -> Token = {white_space,Attrs,Ncs}, scan1(Cs, St, Line+1, new_column(Col, length(Ncs)), [Token|Toks]). -newline_end(Cs, #erl_scan{text = false}=St, Line, no_col=Col, +newline_end(Cs, #erl_scan{text = false}=St, Line, no_col=Col, Toks, _N, Ncs) -> scan1(Cs, St, Line+1, Col, [{white_space,Line,Ncs}|Toks]); newline_end(Cs, St, Line, Col, Toks, N, Ncs) -> @@ -789,7 +789,7 @@ scan_char([$\\|Cs]=Cs0, St, Line, Col, Toks) -> Ntoks = [{char,Attrs,Val}|Toks], scan1(Ncs, St, Line, Ncol, Ntoks) end; -scan_char([$\n=C|Cs], St, Line, Col, Toks) -> +scan_char([$\n=C|Cs], St, Line, Col, Toks) -> Attrs = attributes(Line, Col, St, [$$,C]), scan1(Cs, St, Line+1, new_column(Col, 1), [{char,Attrs,C}|Toks]); scan_char([C|Cs], St, Line, Col, Toks) when ?CHAR(C) -> @@ -896,7 +896,7 @@ scan_string_no_col([Q|Cs], Line, Col, Q, Wcs, Uni) -> {Cs,Line,Col,_DontCare=[],lists:reverse(Wcs),Uni}; scan_string_no_col([$\n=C|Cs], Line, Col, Q, Wcs, Uni) -> scan_string_no_col(Cs, Line+1, Col, Q, [C|Wcs], Uni); -scan_string_no_col([C|Cs], Line, Col, Q, Wcs, Uni) when C =/= $\\, +scan_string_no_col([C|Cs], Line, Col, Q, Wcs, Uni) when C =/= $\\, ?CHAR(C), ?UNI255(C) -> scan_string_no_col(Cs, Line, Col, Q, [C|Wcs], Uni); scan_string_no_col(Cs, Line, Col, Q, Wcs, Uni) -> @@ -909,7 +909,7 @@ scan_string_col([Q|Cs], Line, Col, Q, Wcs0, Uni) -> {Cs,Line,Col+1,Str,Wcs,Uni}; scan_string_col([$\n=C|Cs], Line, _xCol, Q, Wcs, Uni) -> scan_string_col(Cs, Line+1, 1, Q, [C|Wcs], Uni); -scan_string_col([C|Cs], Line, Col, Q, Wcs, Uni) when C =/= $\\, +scan_string_col([C|Cs], Line, Col, Q, Wcs, Uni) when C =/= $\\, ?CHAR(C), ?UNI255(C) -> scan_string_col(Cs, Line, Col+1, Q, [C|Wcs], Uni); scan_string_col(Cs, Line, Col, Q, Wcs, Uni) -> @@ -970,8 +970,8 @@ scan_string1(eof, Line, Col, _Q, _Str, Wcs, _Uni) -> {error,Line,Col,lists:reverse(Wcs),eof}. -define(OCT(C), C >= $0, C =< $7). --define(HEX(C), C >= $0 andalso C =< $9 orelse - C >= $A andalso C =< $F orelse +-define(HEX(C), C >= $0 andalso C =< $9 orelse + C >= $A andalso C =< $F orelse C >= $a andalso C =< $f). %% \<1-3> octal digits @@ -1086,7 +1086,7 @@ scan_number(Cs, St, Line, Col, Toks, Ncs0) -> Ncol = incr_column(Col, length(Ncs)), scan_error({illegal,integer}, Line, Col, Line, Ncol, Cs) end. - + scan_based_int([C|Cs], St, Line, Col, Toks, {B,Ncs,Bcs}) when ?DIGIT(C), C < $0+B -> scan_based_int(Cs, St, Line, Col, Toks, {B,[C|Ncs],Bcs}); @@ -1262,7 +1262,7 @@ nl_tabs(8) -> "\n\t\t\t\t\t\t\t"; nl_tabs(9) -> "\n\t\t\t\t\t\t\t\t"; nl_tabs(10) -> "\n\t\t\t\t\t\t\t\t\t"; nl_tabs(11) -> "\n\t\t\t\t\t\t\t\t\t\t". - + tabs(1) -> "\t"; tabs(2) -> "\t\t"; tabs(3) -> "\t\t\t"; @@ -1303,5 +1303,4 @@ reserved_word('bsl') -> true; reserved_word('bsr') -> true; reserved_word('or') -> true; reserved_word('xor') -> true; -reserved_word('spec') -> true; reserved_word(_) -> false. diff --git a/lib/stdlib/src/escript.erl b/lib/stdlib/src/escript.erl index 5958a58d7c..d26443f277 100644 --- a/lib/stdlib/src/escript.erl +++ b/lib/stdlib/src/escript.erl @@ -19,11 +19,16 @@ -module(escript). %% Useful functions that can be called from scripts. --export([script_name/0, foldl/3]). +-export([script_name/0, create/2, extract/2]). %% Internal API. -export([start/0, start/1]). +-include_lib("kernel/include/file.hrl"). + +-define(SHEBANG, "/usr/bin/env escript"). +-define(COMMENT, "This is an -*- erlang -*- file"). + -record(state, {file, module, forms_or_bin, @@ -32,89 +37,223 @@ mode, exports_main, has_records}). - +-record(sections, {type, + shebang, + comment, + emu_args, + body}). +-record(extract_options, {compile_source}). + +-type shebang() :: string(). +-type comment() :: string(). +-type emu_args() :: string(). +-type escript_filename() :: string(). +-type filename() :: string(). +-type zip_file() :: + filename() + | {filename(), binary()} + | {filename(), binary(), #file_info{}}. +-type zip_create_option() :: term(). +-type section() :: + shebang + | {shebang, shebang()} + | comment + | {comment, comment()} + | {emu_args, emu_args()} + | {source, filename() | binary()} + | {beam, filename() | binary()} + | {archive, filename() | binary()} + | {archive, [zip_file()], [zip_create_option()]}. + +%% Create a complete escript file with both header and body +-spec create(escript_filename() | binary, [section()]) -> + ok | {ok, binary()} | {error, term()}. + +create(File, Options) when is_list(Options) -> + try + S = prepare(Options, #sections{}), + BinList = + [Section || Section <- [S#sections.shebang, + S#sections.comment, + S#sections.emu_args, + S#sections.body], + Section =/= undefined], + case File of + binary -> + {ok, list_to_binary(BinList)}; + _ -> + case file:write_file(File, BinList) of + ok -> + ok; + {error, Reason} -> + {error, {Reason, File}} + end + end + catch + throw:PrepareReason -> + {error, PrepareReason} + end. + +prepare([H | T], S) -> + case H of + {shebang, undefined} -> + prepare(T, S); + shebang -> + prepare(T, S#sections{shebang = "#!" ++ ?SHEBANG ++ "\n"}); + {shebang, default} -> + prepare(T, S#sections{shebang = "#!" ++ ?SHEBANG ++ "\n"}); + {shebang, Shebang} when is_list(Shebang) -> + prepare(T, S#sections{shebang = "#!" ++ Shebang ++ "\n"}); + {comment, undefined} -> + prepare(T, S); + comment -> + prepare(T, S#sections{comment = "%% " ++ ?COMMENT ++ "\n"}); + {comment, default} -> + prepare(T, S#sections{comment = "%% " ++ ?COMMENT ++ "\n"}); + {comment, Comment} when is_list(Comment) -> + prepare(T, S#sections{comment = "%% " ++ Comment ++ "\n"}); + {emu_args, undefined} -> + prepare(T, S); + {emu_args, Args} when is_list(Args) -> + prepare(T, S#sections{emu_args = "%%!" ++ Args ++ "\n"}); + {Type, File} when is_list(File) -> + case file:read_file(File) of + {ok, Bin} -> + prepare(T, S#sections{type = Type, body = Bin}); + {error, Reason} -> + throw({Reason, H}) + end; + {Type, Bin} when is_binary(Bin) -> + prepare(T, S#sections{type = Type, body = Bin}); + {archive = Type, ZipFiles, ZipOptions} + when is_list(ZipFiles), is_list(ZipOptions) -> + File = "dummy.zip", + case zip:create(File, ZipFiles, ZipOptions ++ [memory]) of + {ok, {File, ZipBin}} -> + prepare(T, S#sections{type = Type, body = ZipBin}); + {error, Reason} -> + throw({Reason, H}) + end; + _ -> + throw({badarg, H}) + end; +prepare([], #sections{body = undefined}) -> + throw(missing_body); +prepare([], #sections{type = Type} = S) + when Type =:= source; Type =:= beam; Type =:= archive -> + S; +prepare([], #sections{type = Type}) -> + throw({illegal_type, Type}); +prepare(BadOptions, _) -> + throw({badarg, BadOptions}). + +-type section_name() :: shebang | comment | emu_args | body . +-type extract_option() :: compile_source | {section, [section_name()]}. +-spec extract(filename(), [extract_option()]) -> {ok, [section()]} | {error, term()}. +extract(File, Options) when is_list(File), is_list(Options) -> + try + EO = parse_extract_options(Options, + #extract_options{compile_source = false}), + {HeaderSz, NextLineNo, Fd, Sections} = + parse_header(File, not EO#extract_options.compile_source), + Type = Sections#sections.type, + case {Type, EO#extract_options.compile_source} of + {source, true} -> + Bin = compile_source(Type, File, Fd, NextLineNo, HeaderSz); + {_, _} -> + ok = file:close(Fd), + case file:read_file(File) of + {ok, <<_Header:HeaderSz/binary, Bin/binary>>} -> + ok; + {error, ReadReason} -> + Bin = get_rid_of_compiler_warning, + throw(ReadReason) + end + end, + return_sections(Sections, Bin) + catch + throw:Reason -> + {error, Reason} + end. + +parse_extract_options([H | T], EO) -> + case H of + compile_source -> + EO2 = EO#extract_options{compile_source = true}, + parse_extract_options(T, EO2); + _ -> + throw({badarg, H}) + end; +parse_extract_options([], EO) -> + EO. + +compile_source(Type, File, Fd, NextLineNo, HeaderSz) -> + {text, _Module, Forms, _HasRecs, _Mode} = + do_parse_file(Type, File, Fd, NextLineNo, HeaderSz, false), + ok = file:close(Fd), + case compile:forms(Forms, [return_errors, debug_info]) of + {ok, _, BeamBin} -> + BeamBin; + {error, Errors, Warnings} -> + throw({compile, [{errors, format_errors(Errors)}, + {warnings, format_errors(Warnings)}]}) + end. + +format_errors(CompileErrors) -> + [lists:flatten([File, ":", integer_to_list(LineNo), ": ", + Mod:format_error(Error)]) || + {File, FileErrors} <- CompileErrors, + {LineNo, Mod, Error} <- FileErrors]. + +return_sections(S, Bin) -> + {ok, [normalize_section(shebang, S#sections.shebang), + normalize_section(comment, S#sections.comment), + normalize_section(emu_args, S#sections.emu_args), + normalize_section(S#sections.type, Bin)]}. + +normalize_section(Name, undefined) -> + {Name, undefined}; +normalize_section(shebang, "#!" ++ Chars) -> + Chopped = string:strip(Chars, right, $\n), + Stripped = string:strip(Chopped, both), + if + Stripped =:= ?SHEBANG -> + {shebang, default}; + true -> + {shebang, Stripped} + end; +normalize_section(comment, Chars) -> + Chopped = string:strip(Chars, right, $\n), + Stripped = string:strip(string:strip(Chopped, left, $%), both), + if + Stripped =:= ?COMMENT -> + {comment, default}; + true -> + {comment, Stripped} + end; +normalize_section(emu_args, "%%!" ++ Chars) -> + Chopped = string:strip(Chars, right, $\n), + Stripped = string:strip(Chopped, both), + {emu_args, Stripped}; +normalize_section(Name, Chars) -> + {Name, Chars}. + +-spec script_name() -> string(). script_name() -> [ScriptName|_] = init:get_plain_arguments(), ScriptName. -%% Apply Fun(Name, GetInfo, GetBin, Acc) for each file in the escript. -%% -%% Fun/2 must return a new accumulator which is passed to the next call. -%% The function returns the final value of the accumulator. Acc0 is -%% returned if the escript contain an empty archive. -%% -%% GetInfo/0 is a fun that returns a #file_info{} record for the file. -%% GetBin/0 is a fun that returns a the contents of the file as a binary. -%% -%% An escript may contain erlang code, beam code or an archive: -%% -%% archive - the Fun/2 will be applied for each file in the archive -%% beam - the Fun/2 will be applied once and GetInfo/0 returns the file -%% info for the (entire) escript file -%% erl - the Fun/2 will be applied once, GetInfo/0 returns the file -%% info for the (entire) escript file and the GetBin returns -%% the compiled beam code - -%%-spec foldl(fun((string(), -%% fun(() -> #file_info()), -%% fun(() -> binary() -> term()), -%% term()) -> term()), -%% term(), -%% string()). -foldl(Fun, Acc0, File) when is_function(Fun, 4) -> - case parse_file(File, false) of - {text, _, Forms, _HasRecs, _Mode} when is_list(Forms) -> - GetInfo = fun() -> file:read_file_info(File) end, - GetBin = - fun() -> - case compile:forms(Forms, [return_errors, debug_info]) of - {ok, _, BeamBin} -> - BeamBin; - {error, _Errors, _Warnings} -> - fatal("There were compilation errors.") - end - end, - try - {ok, Fun(".", GetInfo, GetBin, Acc0)} - catch - throw:Reason -> - {error, Reason} - end; - {beam, _, BeamBin, _HasRecs, _Mode} when is_binary(BeamBin) -> - GetInfo = fun() -> file:read_file_info(File) end, - GetBin = fun() -> BeamBin end, - try - {ok, Fun(".", GetInfo, GetBin, Acc0)} - catch - throw:Reason -> - {error, Reason} - end; - {archive, _, ArchiveBin, _HasRecs, _Mode} when is_binary(ArchiveBin) -> - ZipFun = - fun({Name, GetInfo, GetBin}, A) -> - A2 = Fun(Name, GetInfo, GetBin, A), - {true, false, A2} - end, - case prim_zip:open(ZipFun, Acc0, {File, ArchiveBin}) of - {ok, PrimZip, Res} -> - ok = prim_zip:close(PrimZip), - {ok, Res}; - {error, bad_eocd} -> - {error, "Not an archive file"}; - {error, Reason} -> - {error, Reason} - end - end. - %% %% Internal API. %% +-spec start() -> no_return(). start() -> start([]). +-spec start([string()]) -> no_return(). start(EscriptOptions) -> - try + try %% Commands run using -run or -s are run in a process %% trap_exit set to false. Because this behaviour is %% surprising for users of escript, make sure to reset @@ -143,11 +282,11 @@ parse_and_run(File, Args, Options) -> parse_file(File, CheckOnly), Mode2 = case lists:member("d", Options) of - true -> + true -> debug; false -> case lists:member("c", Options) of - true -> + true -> compile; false -> case lists:member("i", Options) of @@ -177,7 +316,7 @@ parse_and_run(File, Args, Options) -> _Other -> fatal("There were compilation errors.") end - end; + end; is_binary(FormsOrBin) -> case Source of archive -> @@ -190,11 +329,13 @@ parse_and_run(File, Args, Options) -> true -> my_halt(0); false -> - Text = lists:concat(["Function ", Module, ":main/1 is not exported"]), + Text = lists:concat(["Function ", Module, + ":main/1 is not exported"]), fatal(Text) end; _ -> - Text = lists:concat(["Cannot load module ", Module, " from archive"]), + Text = lists:concat(["Cannot load module ", Module, + " from archive"]), fatal(Text) end; ok -> @@ -212,7 +353,7 @@ parse_and_run(File, Args, Options) -> run -> {module, Module} = code:load_binary(Module, File, FormsOrBin), run(Module, Args); - debug -> + debug -> [Base | Rest] = lists:reverse(filename:split(File)), Base2 = filename:basename(Base, code:objfile_extension()), Rest2 = @@ -222,8 +363,8 @@ parse_and_run(File, Args, Options) -> end, SrcFile = filename:join(lists:reverse([Base2 ++ ".erl" | Rest2])), debug(Module, {Module, SrcFile, File, FormsOrBin}, Args) - end - end + end + end end. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -231,25 +372,19 @@ parse_and_run(File, Args, Options) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% parse_file(File, CheckOnly) -> - S = #state{file = File, - n_errors = 0, - mode = interpret, - exports_main = false, - has_records = false}, - {ok, Fd} = - case file:open(File, [read]) of - {ok, Fd0} -> - {ok, Fd0}; - {error, R} -> - fatal(lists:concat([file:format_error(R), ": '", File, "'"])) - end, - {HeaderSz, StartLine, ScriptType} = skip_header(Fd, 1), + {HeaderSz, NextLineNo, Fd, Sections} = + parse_header(File, false), + do_parse_file(Sections#sections.type, + File, Fd, NextLineNo, HeaderSz, CheckOnly). + +do_parse_file(Type, File, Fd, NextLineNo, HeaderSz, CheckOnly) -> + S = initial_state(File), #state{mode = Mode, source = Source, module = Module, forms_or_bin = FormsOrBin, has_records = HasRecs} = - case ScriptType of + case Type of archive -> %% Archive file ok = file:close(Fd), @@ -260,51 +395,93 @@ parse_file(File, CheckOnly) -> parse_beam(S, File, HeaderSz, CheckOnly); source -> %% Source code - parse_source(S, File, Fd, StartLine, HeaderSz, CheckOnly) + parse_source(S, File, Fd, NextLineNo, HeaderSz, CheckOnly) end, {Source, Module, FormsOrBin, HasRecs, Mode}. +initial_state(File) -> + #state{file = File, + n_errors = 0, + mode = interpret, + exports_main = false, + has_records = false}. + %% Skip header and make a heuristic guess about the script type -skip_header(P, LineNo) -> +parse_header(File, KeepFirst) -> + LineNo = 1, + {ok, Fd} = + case file:open(File, [read]) of + {ok, Fd0} -> + {ok, Fd0}; + {error, R} -> + fatal(lists:concat([file:format_error(R), ": '", File, "'"])) + end, + %% Skip shebang on first line - {ok, HeaderSz0} = file:position(P, cur), - Line1 = get_line(P), + {ok, HeaderSz0} = file:position(Fd, cur), + Line1 = get_line(Fd), case classify_line(Line1) of shebang -> - find_first_body_line(P, LineNo); + find_first_body_line(Fd, HeaderSz0, LineNo, KeepFirst, + #sections{shebang = Line1}); archive -> - {HeaderSz0, LineNo, archive}; + {HeaderSz0, LineNo, Fd, + #sections{type = archive}}; beam -> - {HeaderSz0, LineNo, beam}; + {HeaderSz0, LineNo, Fd, + #sections{type = beam}}; _ -> - find_first_body_line(P, LineNo) + find_first_body_line(Fd, HeaderSz0, LineNo, KeepFirst, + #sections{}) end. -find_first_body_line(P, LineNo) -> - {ok, HeaderSz1} = file:position(P, cur), +find_first_body_line(Fd, HeaderSz0, LineNo, KeepFirst, Sections) -> + {ok, HeaderSz1} = file:position(Fd, cur), %% Look for special comment on second line - Line2 = get_line(P), - {ok, HeaderSz2} = file:position(P, cur), + Line2 = get_line(Fd), + {ok, HeaderSz2} = file:position(Fd, cur), case classify_line(Line2) of emu_args -> %% Skip special comment on second line - Line3 = get_line(P), - {HeaderSz2, LineNo + 2, guess_type(Line3)}; - _ -> + Line3 = get_line(Fd), + {HeaderSz2, LineNo + 2, Fd, + Sections#sections{type = guess_type(Line3), + comment = undefined, + emu_args = Line2}}; + Line2Type -> %% Look for special comment on third line - Line3 = get_line(P), - {ok, HeaderSz3} = file:position(P, cur), - case classify_line(Line3) of - emu_args -> + Line3 = get_line(Fd), + {ok, HeaderSz3} = file:position(Fd, cur), + Line3Type = classify_line(Line3), + if + Line3Type =:= emu_args -> %% Skip special comment on third line - Line4 = get_line(P), - {HeaderSz3, LineNo + 3, guess_type(Line4)}; - _ -> + Line4 = get_line(Fd), + {HeaderSz3, LineNo + 3, Fd, + Sections#sections{type = guess_type(Line4), + comment = Line2, + emu_args = Line3}}; + Sections#sections.shebang =:= undefined, + KeepFirst =:= true -> + %% No shebang. Use the entire file + {HeaderSz0, LineNo, Fd, + Sections#sections{type = guess_type(Line2)}}; + Sections#sections.shebang =:= undefined -> + %% No shebang. Skip the first line + {HeaderSz1, LineNo, Fd, + Sections#sections{type = guess_type(Line2)}}; + Line2Type =:= comment -> + %% Skip shebang on first line and comment on second + {HeaderSz2, LineNo + 2, Fd, + Sections#sections{type = guess_type(Line3), + comment = Line2}}; + true -> %% Just skip shebang on first line - {HeaderSz1, LineNo + 1, guess_type(Line2)} + {HeaderSz1, LineNo + 1, Fd, + Sections#sections{type = guess_type(Line2)}} end end. - + classify_line(Line) -> case Line of [$\#, $\! | _] -> @@ -313,8 +490,10 @@ classify_line(Line) -> archive; [$F, $O, $R, $1 | _] -> beam; - [$\%, $\%, $\! | _] -> + [$%, $%, $\! | _] -> emu_args; + [$% | _] -> + comment; _ -> undefined end. @@ -336,8 +515,8 @@ get_line(P) -> parse_archive(S, File, HeaderSz) -> case file:read_file(File) of - {ok, <<_FirstLine:HeaderSz/binary, Bin/binary>>} -> - Mod = + {ok, <<_Header:HeaderSz/binary, Bin/binary>>} -> + Mod = case init:get_argument(escript) of {ok, [["main", M]]} -> %% Use explicit module name @@ -345,14 +524,14 @@ parse_archive(S, File, HeaderSz) -> _ -> %% Use escript name without extension as module name RevBase = lists:reverse(filename:basename(File)), - RevBase2 = + RevBase2 = case lists:dropwhile(fun(X) -> X =/= $. end, RevBase) of [$. | Rest] -> Rest; [] -> RevBase end, list_to_atom(lists:reverse(RevBase2)) end, - + S#state{source = archive, mode = run, module = Mod, @@ -365,7 +544,7 @@ parse_archive(S, File, HeaderSz) -> parse_beam(S, File, HeaderSz, CheckOnly) -> - {ok, <<_FirstLine:HeaderSz/binary, Bin/binary>>} = + {ok, <<_Header:HeaderSz/binary, Bin/binary>>} = file:read_file(File), case beam_lib:chunks(Bin, [exports]) of {ok, {Module, [{exports, Exports}]}} -> @@ -399,7 +578,7 @@ parse_source(S, File, Fd, StartLine, HeaderSz, CheckOnly) -> {ok, FileForm} = epp:parse_erl_form(Epp), OptModRes = epp:parse_erl_form(Epp), S2 = S#state{source = text, module = Module}, - S3 = + S3 = case OptModRes of {ok, {attribute,_, module, M} = Form} -> epp_parse_file(Epp, S2#state{module = M}, [Form, FileForm]); @@ -448,12 +627,12 @@ check_source(S, CheckOnly) -> pre_def_macros(File) -> {MegaSecs, Secs, MicroSecs} = erlang:now(), - Replace = fun(Char) -> + Replace = fun(Char) -> case Char of $\. -> $\_; _ -> Char end - end, + end, CleanBase = lists:map(Replace, filename:basename(File)), ModuleStr = CleanBase ++ "__" ++ @@ -642,8 +821,8 @@ eval_exprs([E|Es], Bs0, Lf, Ef, RBs) -> eval_exprs(Es, Bs, Lf, Ef, RBs). format_exception(Class, Reason) -> - PF = fun(Term, I) -> - io_lib:format("~." ++ integer_to_list(I) ++ "P", [Term, 50]) + PF = fun(Term, I) -> + io_lib:format("~." ++ integer_to_list(I) ++ "P", [Term, 50]) end, StackTrace = erlang:get_stacktrace(), StackFun = fun(M, _F, _A) -> (M =:= erl_eval) or (M =:= ?MODULE) end, @@ -651,7 +830,7 @@ format_exception(Class, Reason) -> fatal(Str) -> throw(Str). - + my_halt(Reason) -> case process_info(group_leader(), status) of {_,waiting} -> @@ -675,7 +854,7 @@ hidden_apply(App, M, F, Args) -> Arity = length(Args), Text = io_lib:format("Call to ~w:~w/~w in application ~w failed.\n", [M, F, Arity, App]), - fatal(Text); + fatal(Text); Stk -> erlang:raise(error, undef, Stk) end diff --git a/lib/stdlib/src/ets.erl b/lib/stdlib/src/ets.erl index 9f84e3639f..d7b5dbc636 100644 --- a/lib/stdlib/src/ets.erl +++ b/lib/stdlib/src/ets.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% -module(ets). @@ -230,7 +230,7 @@ from_dets(EtsTable, DetsTable) -> erlang:error(Unexpected,[EtsTable,DetsTable]) end. --spec to_dets(tab(), dets:tab_name()) -> tab(). +-spec to_dets(tab(), dets:tab_name()) -> dets:tab_name(). to_dets(EtsTable, DetsTable) -> case (catch dets:from_ets(DetsTable, EtsTable)) of @@ -622,14 +622,14 @@ do_read_and_verify(ReadFun,InitState,Tab,FtOptions,HeadCount,Verify) -> end, {ok,Tab}; {ok,{FinalMD5State,FinalCount,['$end_of_table',LastInfo],_}} -> - ECount = case lists:keysearch(count,1,LastInfo) of - {value,{count,N}} -> + ECount = case lists:keyfind(count,1,LastInfo) of + {count,N} -> N; _ -> false end, - EMD5 = case lists:keysearch(md5,1,LastInfo) of - {value,{md5,M}} -> + EMD5 = case lists:keyfind(md5,1,LastInfo) of + {md5,M} -> M; _ -> false @@ -742,22 +742,21 @@ get_header_data(Name,true) -> false -> throw(badfile); true -> - Major = case lists:keysearch(major,1,L) of - {value,{major,Maj}} -> + Major = case lists:keyfind(major,1,L) of + {major,Maj} -> Maj; _ -> 0 end, - Minor = case lists:keysearch(minor,1,L) of - {value,{minor,Min}} -> + Minor = case lists:keyfind(minor,1,L) of + {minor,Min} -> Min; _ -> 0 end, FtOptions = - case lists:keysearch(extended_info,1,L) of - {value,{extended_info,I}} - when is_list(I) -> + case lists:keyfind(extended_info,1,L) of + {extended_info,I} when is_list(I) -> #filetab_options { object_count = @@ -786,29 +785,28 @@ get_header_data(Name,true) -> end; get_header_data(Name, false) -> - case wrap_chunk(Name,start,1,false) of + case wrap_chunk(Name, start, 1, false) of {C,[Tup]} when is_tuple(Tup) -> L = tuple_to_list(Tup), case verify_header_mandatory(L) of false -> throw(badfile); true -> - Major = case lists:keysearch(major_version,1,L) of - {value,{major_version,Maj}} -> + Major = case lists:keyfind(major_version, 1, L) of + {major_version, Maj} -> Maj; _ -> 0 end, - Minor = case lists:keysearch(minor_version,1,L) of - {value,{minor_version,Min}} -> + Minor = case lists:keyfind(minor_version, 1, L) of + {minor_version, Min} -> Min; _ -> 0 end, FtOptions = - case lists:keysearch(extended_info,1,L) of - {value,{extended_info,I}} - when is_list(I) -> + case lists:keyfind(extended_info, 1, L) of + {extended_info, I} when is_list(I) -> #filetab_options { object_count = @@ -825,25 +823,26 @@ get_header_data(Name, false) -> throw(badfile) end. -md5_and_convert([],MD5State,Count) -> +md5_and_convert([], MD5State, Count) -> {[],MD5State,Count,[]}; -md5_and_convert([H|T],MD5State,Count) when is_binary(H) -> +md5_and_convert([H|T], MD5State, Count) when is_binary(H) -> case (catch binary_to_term(H)) of {'EXIT', _} -> md5_and_convert(T,MD5State,Count); - ['$end_of_table',Dat] -> - {[],MD5State,Count,['$end_of_table',Dat]}; + ['$end_of_table',_Dat] = L -> + {[],MD5State,Count,L}; Term -> - X = erlang:md5_update(MD5State,H), - {Rest,NewMD5,NewCount,NewLast} = md5_and_convert(T,X,Count+1), + X = erlang:md5_update(MD5State, H), + {Rest,NewMD5,NewCount,NewLast} = md5_and_convert(T, X, Count+1), {[Term | Rest],NewMD5,NewCount,NewLast} end. -scan_for_endinfo([],Count) -> + +scan_for_endinfo([], Count) -> {[],Count,[]}; -scan_for_endinfo([['$end_of_table',Dat]],Count) -> +scan_for_endinfo([['$end_of_table',Dat]], Count) -> {['$end_of_table',Dat],Count,[]}; -scan_for_endinfo([Term|T],Count) -> - {NewLast,NCount,Rest} = scan_for_endinfo(T,Count+1), +scan_for_endinfo([Term|T], Count) -> + {NewLast,NCount,Rest} = scan_for_endinfo(T, Count+1), {NewLast,NCount,[Term | Rest]}. load_table(ReadFun, State, Tab) -> @@ -852,19 +851,19 @@ load_table(ReadFun, State, Tab) -> [] -> {ok,NewState}; List -> - ets:insert(Tab,List), - load_table(ReadFun,NewState,Tab) + ets:insert(Tab, List), + load_table(ReadFun, NewState, Tab) end. create_tab(I) -> - {value, {name, Name}} = lists:keysearch(name, 1, I), - {value, {type, Type}} = lists:keysearch(type, 1, I), - {value, {protection, P}} = lists:keysearch(protection, 1, I), - {value, {named_table, Val}} = lists:keysearch(named_table, 1, I), - {value, {keypos, Kp}} = lists:keysearch(keypos, 1, I), - {value, {size, Sz}} = lists:keysearch(size, 1, I), + {name, Name} = lists:keyfind(name, 1, I), + {type, Type} = lists:keyfind(type, 1, I), + {protection, P} = lists:keyfind(protection, 1, I), + {named_table, Val} = lists:keyfind(named_table, 1, I), + {keypos, _Kp} = Keypos = lists:keyfind(keypos, 1, I), + {size, Sz} = lists:keyfind(size, 1, I), try - Tab = ets:new(Name, [Type, P, {keypos, Kp} | named_table(Val)]), + Tab = ets:new(Name, [Type, P, Keypos | named_table(Val)]), {ok, Tab, Sz} catch _:_ -> @@ -905,9 +904,9 @@ tabfile_info(File) when is_list(File) ; is_atom(File) -> {value, Val} = lists:keysearch(named_table, 1, FullHeader), {value, Kp} = lists:keysearch(keypos, 1, FullHeader), {value, Sz} = lists:keysearch(size, 1, FullHeader), - Ei = case lists:keysearch(extended_info, 1, FullHeader) of - {value, Ei0} -> Ei0; - _ -> {extended_info, []} + Ei = case lists:keyfind(extended_info, 1, FullHeader) of + false -> {extended_info, []}; + Ei0 -> Ei0 end, {ok, [N,Type,P,Val,Kp,Sz,Ei,{version,{Major,Minor}}]} catch @@ -1021,21 +1020,20 @@ options(Option, Keys) -> options([Option], Keys, []). options(Options, [Key | Keys], L) when is_list(Options) -> - V = case lists:keysearch(Key, 1, Options) of - {value, {n_objects, default}} -> + V = case lists:keyfind(Key, 1, Options) of + {n_objects, default} -> {ok, default_option(Key)}; - {value, {n_objects, NObjs}} when is_integer(NObjs), - NObjs >= 1 -> + {n_objects, NObjs} when is_integer(NObjs), NObjs >= 1 -> {ok, NObjs}; - {value, {traverse, select}} -> + {traverse, select} -> {ok, select}; - {value, {traverse, {select, MS}}} -> - {ok, {select, MS}}; - {value, {traverse, first_next}} -> + {traverse, {select, _MS} = Select} -> + {ok, Select}; + {traverse, first_next} -> {ok, first_next}; - {value, {traverse, last_prev}} -> + {traverse, last_prev} -> {ok, last_prev}; - {value, {Key, _}} -> + {Key, _} -> badarg; false -> Default = default_option(Key), diff --git a/lib/stdlib/src/filelib.erl b/lib/stdlib/src/filelib.erl index 74c5172137..5c5e084e17 100644 --- a/lib/stdlib/src/filelib.erl +++ b/lib/stdlib/src/filelib.erl @@ -40,66 +40,66 @@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% --spec wildcard(name()) -> [file:filename()]. +-spec wildcard(file:name()) -> [file:filename()]. wildcard(Pattern) when is_list(Pattern) -> ?HANDLE_ERROR(do_wildcard(Pattern, file)). --spec wildcard(name(), name() | atom()) -> [file:filename()]. +-spec wildcard(file:name(), file:name() | atom()) -> [file:filename()]. wildcard(Pattern, Cwd) when is_list(Pattern), is_list(Cwd) -> ?HANDLE_ERROR(do_wildcard(Pattern, Cwd, file)); wildcard(Pattern, Mod) when is_list(Pattern), is_atom(Mod) -> ?HANDLE_ERROR(do_wildcard(Pattern, Mod)). --spec wildcard(name(), name(), atom()) -> [file:filename()]. +-spec wildcard(file:name(), file:name(), atom()) -> [file:filename()]. wildcard(Pattern, Cwd, Mod) when is_list(Pattern), is_list(Cwd), is_atom(Mod) -> ?HANDLE_ERROR(do_wildcard(Pattern, Cwd, Mod)). --spec is_dir(name()) -> boolean(). +-spec is_dir(file:name()) -> boolean(). is_dir(Dir) -> do_is_dir(Dir, file). --spec is_dir(name(), atom()) -> boolean(). +-spec is_dir(file:name(), atom()) -> boolean(). is_dir(Dir, Mod) when is_atom(Mod) -> do_is_dir(Dir, Mod). --spec is_file(name()) -> boolean(). +-spec is_file(file:name()) -> boolean(). is_file(File) -> do_is_file(File, file). --spec is_file(name(), atom()) -> boolean(). +-spec is_file(file:name(), atom()) -> boolean(). is_file(File, Mod) when is_atom(Mod) -> do_is_file(File, Mod). --spec is_regular(name()) -> boolean(). +-spec is_regular(file:name()) -> boolean(). is_regular(File) -> do_is_regular(File, file). --spec is_regular(name(), atom()) -> boolean(). +-spec is_regular(file:name(), atom()) -> boolean(). is_regular(File, Mod) when is_atom(Mod) -> do_is_regular(File, Mod). --spec fold_files(name(), string(), boolean(), fun((_,_) -> _), _) -> _. +-spec fold_files(file:name(), string(), boolean(), fun((_,_) -> _), _) -> _. fold_files(Dir, RegExp, Recursive, Fun, Acc) -> do_fold_files(Dir, RegExp, Recursive, Fun, Acc, file). --spec fold_files(name(), string(), boolean(), fun((_,_) -> _), _, atom()) -> _. +-spec fold_files(file:name(), string(), boolean(), fun((_,_) -> _), _, atom()) -> _. fold_files(Dir, RegExp, Recursive, Fun, Acc, Mod) when is_atom(Mod) -> do_fold_files(Dir, RegExp, Recursive, Fun, Acc, Mod). --spec last_modified(name()) -> date_time() | 0. +-spec last_modified(file:name()) -> file:date_time() | 0. last_modified(File) -> do_last_modified(File, file). --spec last_modified(name(), atom()) -> date_time() | 0. +-spec last_modified(file:name(), atom()) -> file:date_time() | 0. last_modified(File, Mod) when is_atom(Mod) -> do_last_modified(File, Mod). --spec file_size(name()) -> non_neg_integer(). +-spec file_size(file:name()) -> non_neg_integer(). file_size(File) -> do_file_size(File, file). --spec file_size(name(), atom()) -> non_neg_integer(). +-spec file_size(file:name(), atom()) -> non_neg_integer(). file_size(File, Mod) when is_atom(Mod) -> do_file_size(File, Mod). @@ -218,7 +218,7 @@ do_file_size(File, Mod) -> %% +type X = filename() | dirname() %% ensures that the directory name required to create D exists --spec ensure_dir(name()) -> 'ok' | {'error', posix()}. +-spec ensure_dir(file:name()) -> 'ok' | {'error', file:posix()}. ensure_dir("/") -> ok; ensure_dir(F) -> diff --git a/lib/stdlib/src/filename.erl b/lib/stdlib/src/filename.erl index cd26b2e219..01c06e4596 100644 --- a/lib/stdlib/src/filename.erl +++ b/lib/stdlib/src/filename.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% -module(filename). @@ -57,12 +57,12 @@ %% (for Unix) : absname("/") -> "/" %% (for WIN32): absname("/") -> "D:/" --spec absname(name()) -> string(). +-spec absname(file:name()) -> string(). absname(Name) -> {ok, Cwd} = file:get_cwd(), absname(Name, Cwd). --spec absname(name(), string()) -> string(). +-spec absname(file:name(), string()) -> string(). absname(Name, AbsBase) -> case pathtype(Name) of relative -> @@ -98,7 +98,7 @@ absname_vr([[X, $:]|Name], _, _AbsBase) -> %% For other systems this is just a join/2, but assumes that %% AbsBase must be absolute and Name must be relative. --spec absname_join(string(), name()) -> string(). +-spec absname_join(string(), file:name()) -> string(). absname_join(AbsBase, Name) -> case major_os_type() of vxworks -> @@ -136,7 +136,7 @@ absname_pretty(Abspath, [First|Rest], AbsBase) -> %% basename("/usr/foo/") -> "foo" (trailing slashes ignored) %% basename("/") -> [] --spec basename(name()) -> string(). +-spec basename(file:name()) -> string(). basename(Name0) -> Name = flatten(Name0), {DirSep2, DrvSep} = separators(), @@ -190,7 +190,7 @@ skip_prefix1(Name, _) -> %% rootname(basename("xxx.jam")) -> "xxx" %% rootname(basename("xxx.erl")) -> "xxx" --spec basename(name(), name()) -> string(). +-spec basename(file:name(), file:name()) -> string(). basename(Name0, Ext0) -> Name = flatten(Name0), Ext = flatten(Ext0), @@ -216,7 +216,7 @@ basename([], _Ext, Tail, _DrvSep2) -> %% Example: dirname("/usr/src/kalle.erl") -> "/usr/src", %% dirname("kalle.erl") -> "." --spec dirname(name()) -> string(). +-spec dirname(file:name()) -> string(). dirname(Name0) -> Name = flatten(Name0), case os:type() of @@ -268,7 +268,7 @@ dirname([], Dir, _, _) -> %% %% On Windows: fn:dirname("\\usr\\src/kalle.erl") -> "/usr/src" --spec extension(name()) -> string(). +-spec extension(file:name()) -> string(). extension(Name0) -> Name = flatten(Name0), extension(Name, [], major_os_type()). @@ -357,7 +357,7 @@ maybe_remove_dirsep(Name, _) -> %% a given base directory, which is is assumed to be normalised %% by a previous call to join/{1,2}. --spec append(string(), name()) -> string(). +-spec append(string(), file:name()) -> string(). append(Dir, Name) -> Dir ++ [$/|Name]. @@ -373,7 +373,7 @@ append(Dir, Name) -> %% current working volume. (Windows only) %% Example: a:bar.erl, /temp/foo.erl --spec pathtype(name()) -> 'absolute' | 'relative' | 'volumerelative'. +-spec pathtype(file:name()) -> 'absolute' | 'relative' | 'volumerelative'. pathtype(Atom) when is_atom(Atom) -> pathtype(atom_to_list(Atom)); pathtype(Name) when is_list(Name) -> @@ -422,7 +422,7 @@ win32_pathtype(_) -> relative. %% Examples: rootname("/jam.src/kalle") -> "/jam.src/kalle" %% rootname("/jam.src/foo.erl") -> "/jam.src/foo" --spec rootname(name()) -> string(). +-spec rootname(file:name()) -> string(). rootname(Name0) -> Name = flatten(Name0), rootname(Name, [], [], major_os_type()). @@ -451,7 +451,7 @@ rootname([], Root, _Ext, _OsType) -> %% Examples: rootname("/jam.src/kalle.jam", ".erl") -> "/jam.src/kalle.jam" %% rootname("/jam.src/foo.erl", ".erl") -> "/jam.src/foo" --spec rootname(name(), name()) -> string(). +-spec rootname(file:name(), file:name()) -> string(). rootname(Name0, Ext0) -> Name = flatten(Name0), Ext = flatten(Ext0), @@ -471,7 +471,7 @@ rootname2([Char|Rest], Ext, Result) when is_integer(Char) -> %% split("foo/bar") -> ["foo", "bar"] %% split("a:\\msdev\\include") -> ["a:/", "msdev", "include"] --spec split(name()) -> [string()]. +-spec split(file:name()) -> [string()]. split(Name0) -> Name = flatten(Name0), case os:type() of @@ -771,7 +771,7 @@ vxworks_first2(Devicep, [H|T], FirstComp) -> %% flatten(List) %% Flatten a list, also accepting atoms. --spec flatten(name()) -> string(). +-spec flatten(file:name()) -> string(). flatten(List) -> do_flatten(List, []). diff --git a/lib/stdlib/src/gen.erl b/lib/stdlib/src/gen.erl index 5aab547644..43df6f621d 100644 --- a/lib/stdlib/src/gen.erl +++ b/lib/stdlib/src/gen.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% -module(gen). @@ -212,7 +212,22 @@ do_call(Process, Label, Request, Timeout) -> catch erlang:send(Process, {Label, {self(), Mref}, Request}, [noconnect]), - wait_resp_mon(Node, Mref, Timeout) + receive + {Mref, Reply} -> + erlang:demonitor(Mref, [flush]), + {ok, Reply}; + {'DOWN', Mref, _, _, noconnection} -> + exit({nodedown, Node}); + {'DOWN', Mref, _, _, Reason} -> + exit(Reason) + after Timeout -> + erlang:demonitor(Mref), + receive + {'DOWN', Mref, _, _, _} -> true + after 0 -> true + end, + exit(timeout) + end catch error:_ -> %% Node (C/Java?) is not supporting the monitor. @@ -233,24 +248,6 @@ do_call(Process, Label, Request, Timeout) -> end end. -wait_resp_mon(Node, Mref, Timeout) -> - receive - {Mref, Reply} -> - erlang:demonitor(Mref, [flush]), - {ok, Reply}; - {'DOWN', Mref, _, _, noconnection} -> - exit({nodedown, Node}); - {'DOWN', Mref, _, _, Reason} -> - exit(Reason) - after Timeout -> - erlang:demonitor(Mref), - receive - {'DOWN', Mref, _, _, _} -> true - after 0 -> true - end, - exit(timeout) - end. - wait_resp(Node, Tag, Timeout) -> receive {Tag, Reply} -> diff --git a/lib/stdlib/src/gen_event.erl b/lib/stdlib/src/gen_event.erl index 1b30aaf5eb..27ff9441e6 100644 --- a/lib/stdlib/src/gen_event.erl +++ b/lib/stdlib/src/gen_event.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% -module(gen_event). @@ -42,7 +42,6 @@ system_continue/3, system_terminate/4, system_code_change/4, - print_event/3, format_status/2]). -import(error_logger, [error_msg/2]). @@ -239,7 +238,7 @@ fetch_msg(Parent, ServerName, MSL, Debug, Hib) -> Msg when Debug =:= [] -> handle_msg(Msg, Parent, ServerName, MSL, []); Msg -> - Debug1 = sys:handle_debug(Debug, {?MODULE, print_event}, + Debug1 = sys:handle_debug(Debug, fun print_event/3, ServerName, {in, Msg}), handle_msg(Msg, Parent, ServerName, MSL, Debug1) end. diff --git a/lib/stdlib/src/gen_fsm.erl b/lib/stdlib/src/gen_fsm.erl index ba0275ae2b..9961646418 100644 --- a/lib/stdlib/src/gen_fsm.erl +++ b/lib/stdlib/src/gen_fsm.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% -module(gen_fsm). @@ -116,7 +116,7 @@ -export([behaviour_info/1]). %% Internal exports --export([init_it/6, print_event/3, +-export([init_it/6, system_continue/3, system_terminate/4, system_code_change/4, @@ -376,7 +376,7 @@ decode_msg(Msg,Parent, Name, StateName, StateData, Mod, Time, Debug, Hib) -> _Msg when Debug =:= [] -> handle_msg(Msg, Parent, Name, StateName, StateData, Mod, Time); _Msg -> - Debug1 = sys:handle_debug(Debug, {?MODULE, print_event}, + Debug1 = sys:handle_debug(Debug, fun print_event/3, {Name, StateName}, {in, Msg}), handle_msg(Msg, Parent, Name, StateName, StateData, Mod, Time, Debug1) @@ -466,11 +466,11 @@ handle_msg(Msg, Parent, Name, StateName, StateData, Mod, _Time, Debug) -> From = from(Msg), case catch dispatch(Msg, Mod, StateName, StateData) of {next_state, NStateName, NStateData} -> - Debug1 = sys:handle_debug(Debug, {?MODULE, print_event}, + Debug1 = sys:handle_debug(Debug, fun print_event/3, {Name, NStateName}, return), loop(Parent, Name, NStateName, NStateData, Mod, infinity, Debug1); {next_state, NStateName, NStateData, Time1} -> - Debug1 = sys:handle_debug(Debug, {?MODULE, print_event}, + Debug1 = sys:handle_debug(Debug, fun print_event/3, {Name, NStateName}, return), loop(Parent, Name, NStateName, NStateData, Mod, Time1, Debug1); {reply, Reply, NStateName, NStateData} when From =/= undefined -> @@ -519,7 +519,7 @@ reply({To, Tag}, Reply) -> reply(Name, {To, Tag}, Reply, Debug, StateName) -> reply({To, Tag}, Reply), - sys:handle_debug(Debug, {?MODULE, print_event}, Name, + sys:handle_debug(Debug, fun print_event/3, Name, {out, Reply, To, StateName}). %%% --------------------------------------------------- diff --git a/lib/stdlib/src/gen_server.erl b/lib/stdlib/src/gen_server.erl index f1a9a31c63..1c9e5270b6 100644 --- a/lib/stdlib/src/gen_server.erl +++ b/lib/stdlib/src/gen_server.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% -module(gen_server). @@ -103,7 +103,7 @@ format_status/2]). %% Internal exports --export([init_it/6, print_event/3]). +-export([init_it/6]). -import(error_logger, [format/2]). @@ -353,7 +353,7 @@ decode_msg(Msg, Parent, Name, State, Mod, Time, Debug, Hib) -> _Msg when Debug =:= [] -> handle_msg(Msg, Parent, Name, State, Mod); _Msg -> - Debug1 = sys:handle_debug(Debug, {?MODULE, print_event}, + Debug1 = sys:handle_debug(Debug, fun print_event/3, Name, {in, Msg}), handle_msg(Msg, Parent, Name, State, Mod, Debug1) end. @@ -589,11 +589,11 @@ handle_msg({'$gen_call', From, Msg}, Parent, Name, State, Mod, Debug) -> Debug1 = reply(Name, From, Reply, NState, Debug), loop(Parent, Name, NState, Mod, Time1, Debug1); {noreply, NState} -> - Debug1 = sys:handle_debug(Debug, {?MODULE, print_event}, Name, + Debug1 = sys:handle_debug(Debug, fun print_event/3, Name, {noreply, NState}), loop(Parent, Name, NState, Mod, infinity, Debug1); {noreply, NState, Time1} -> - Debug1 = sys:handle_debug(Debug, {?MODULE, print_event}, Name, + Debug1 = sys:handle_debug(Debug, fun print_event/3, Name, {noreply, NState}), loop(Parent, Name, NState, Mod, Time1, Debug1); {stop, Reason, Reply, NState} -> @@ -625,11 +625,11 @@ handle_common_reply(Reply, Parent, Name, Msg, Mod, State) -> handle_common_reply(Reply, Parent, Name, Msg, Mod, State, Debug) -> case Reply of {noreply, NState} -> - Debug1 = sys:handle_debug(Debug, {?MODULE, print_event}, Name, + Debug1 = sys:handle_debug(Debug, fun print_event/3, Name, {noreply, NState}), loop(Parent, Name, NState, Mod, infinity, Debug1); {noreply, NState, Time1} -> - Debug1 = sys:handle_debug(Debug, {?MODULE, print_event}, Name, + Debug1 = sys:handle_debug(Debug, fun print_event/3, Name, {noreply, NState}), loop(Parent, Name, NState, Mod, Time1, Debug1); {stop, Reason, NState} -> @@ -642,7 +642,7 @@ handle_common_reply(Reply, Parent, Name, Msg, Mod, State, Debug) -> reply(Name, {To, Tag}, Reply, State, Debug) -> reply({To, Tag}, Reply), - sys:handle_debug(Debug, {?MODULE, print_event}, Name, + sys:handle_debug(Debug, fun print_event/3, Name, {out, Reply, To, State} ). diff --git a/lib/stdlib/src/lists.erl b/lib/stdlib/src/lists.erl index e1f8d1c200..857eda8161 100644 --- a/lib/stdlib/src/lists.erl +++ b/lib/stdlib/src/lists.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% -module(lists). @@ -25,7 +25,7 @@ unzip/1, unzip3/1, zip/2, zip3/3, zipwith/3, zipwith3/4, sort/1, merge/1, merge/2, rmerge/2, merge3/3, rmerge3/3, usort/1, umerge/1, umerge3/3, umerge/2, rumerge3/3, rumerge/2, - concat/1, flatten/1, flatten/2, flat_length/1, flatlength/1, + concat/1, flatten/1, flatten/2, flatlength/1, keydelete/3, keyreplace/4, keytake/3, keystore/4, keysort/2, keymerge/3, rkeymerge/3, rukeymerge/3, ukeysort/2, ukeymerge/3, keymap/3]). @@ -40,8 +40,6 @@ mapfoldl/3,mapfoldr/3,foreach/2,takewhile/2,dropwhile/2,splitwith/2, split/2]). --deprecated([flat_length/1]). - %% member(X, L) -> (true | false) %% test if X is a member of the list L %% Now a BIF! @@ -436,13 +434,6 @@ do_flatten([H|T], Tail) -> do_flatten([], Tail) -> Tail. -%% flat_length(List) (undocumented can be removed later) -%% Calculate the length of a list of lists. - --spec flat_length([_]) -> non_neg_integer(). - -flat_length(List) -> flatlength(List). - %% flatlength(List) %% Calculate the length of a list of lists. diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl index 7ea7de8d58..f3cfd78d54 100644 --- a/lib/stdlib/src/otp_internal.erl +++ b/lib/stdlib/src/otp_internal.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1999-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% -module(otp_internal). @@ -236,98 +236,116 @@ obsolete_1(erlang, fault, 2) -> obsolete_1(file, rawopen, 2) -> {removed, "deprecated (will be removed in R13B); use file:open/2 with the raw option"}; -obsolete_1(httpd, start, 0) -> {deprecated,{inets,start,[2,3]},"R14B"}; -obsolete_1(httpd, start, 1) -> {deprecated,{inets,start,[2,3]},"R14B"}; -obsolete_1(httpd, start_link, 1) -> {deprecated,{inets,start,[2,3]},"R14B"}; -obsolete_1(httpd, start_child, 0) -> {deprecated,{inets,start,[2,3]},"R14B"}; -obsolete_1(httpd, start_child, 1) -> {deprecated,{inets,start,[2,3]},"R14B"}; -obsolete_1(httpd, stop, 0) -> {deprecated,{inets,stop,2},"R14B"}; -obsolete_1(httpd, stop, 1) -> {deprecated,{inets,stop,2},"R14B"}; -obsolete_1(httpd, stop, 2) -> {deprecated,{inets,stop,2},"R14B"}; -obsolete_1(httpd, stop_child, 0) -> {deprecated,{inets,stop,2},"R14B"}; -obsolete_1(httpd, stop_child, 1) -> {deprecated,{inets,stop,2},"R14B"}; -obsolete_1(httpd, stop_child, 2) -> {deprecated,{inets,stop,2},"R14B"}; -obsolete_1(httpd, restart, 0) -> {deprecated,{httpd,reload_config,2},"R14B"}; -obsolete_1(httpd, restart, 1) -> {deprecated,{httpd,reload_config,2},"R14B"}; -obsolete_1(httpd, restart, 2) -> {deprecated,{httpd,reload_config,2},"R14B"}; -obsolete_1(httpd, block, 0) -> {deprecated,{httpd,reload_config,2},"R14B"}; -obsolete_1(httpd, block, 1) -> {deprecated,{httpd,reload_config,2},"R14B"}; -obsolete_1(httpd, block, 2) -> {deprecated,{httpd,reload_config,2},"R14B"}; -obsolete_1(httpd, block, 3) -> {deprecated,{httpd,reload_config,2},"R14B"}; -obsolete_1(httpd, block, 4) -> {deprecated,{httpd,reload_config,2},"R14B"}; -obsolete_1(httpd, unblock, 0) -> {deprecated,{httpd,reload_config,2},"R14B"}; -obsolete_1(httpd, unblock, 1) -> {deprecated,{httpd,reload_config,2},"R14B"}; -obsolete_1(httpd, unblock, 2) -> {deprecated,{httpd,reload_config,2},"R14B"}; +obsolete_1(http, request, 1) -> {deprecated,{httpc,request,1},"R15B"}; +obsolete_1(http, request, 2) -> {deprecated,{httpc,request,2},"R15B"}; +obsolete_1(http, request, 4) -> {deprecated,{httpc,request,4},"R15B"}; +obsolete_1(http, request, 5) -> {deprecated,{httpc,request,5},"R15B"}; +obsolete_1(http, cancel_request, 1) -> {deprecated,{httpc,cancel_request,1},"R15B"}; +obsolete_1(http, cancel_request, 2) -> {deprecated,{httpc,cancel_request,2},"R15B"}; +obsolete_1(http, set_option, 2) -> {deprecated,{httpc,set_option,2},"R15B"}; +obsolete_1(http, set_option, 3) -> {deprecated,{httpc,set_option,3},"R15B"}; +obsolete_1(http, set_options, 1) -> {deprecated,{httpc,set_options,1},"R15B"}; +obsolete_1(http, set_options, 2) -> {deprecated,{httpc,set_options,2},"R15B"}; +obsolete_1(http, verify_cookies, 2) -> {deprecated,{httpc,verify_cookies,2},"R15B"}; +obsolete_1(http, verify_cookies, 3) -> {deprecated,{httpc,verify_cookies,3},"R15B"}; +obsolete_1(http, cookie_header, 1) -> {deprecated,{httpc,cookie_header,1},"R15B"}; +obsolete_1(http, cookie_header, 2) -> {deprecated,{httpc,cookie_header,2},"R15B"}; +obsolete_1(http, stream_next, 1) -> {deprecated,{httpc,stream_next,1},"R15B"}; +obsolete_1(http, default_profile, 0) -> {deprecated,{httpc,default_profile,0},"R15B"}; + +obsolete_1(httpd, start, 0) -> {removed,{inets,start,[2,3]},"R14B"}; +obsolete_1(httpd, start, 1) -> {removed,{inets,start,[2,3]},"R14B"}; +obsolete_1(httpd, start_link, 0) -> {removed,{inets,start,[2,3]},"R14B"}; +obsolete_1(httpd, start_link, 1) -> {removed,{inets,start,[2,3]},"R14B"}; +obsolete_1(httpd, start_child, 0) -> {removed,{inets,start,[2,3]},"R14B"}; +obsolete_1(httpd, start_child, 1) -> {removed,{inets,start,[2,3]},"R14B"}; +obsolete_1(httpd, stop, 0) -> {removed,{inets,stop,2},"R14B"}; +obsolete_1(httpd, stop, 1) -> {removed,{inets,stop,2},"R14B"}; +obsolete_1(httpd, stop, 2) -> {removed,{inets,stop,2},"R14B"}; +obsolete_1(httpd, stop_child, 0) -> {removed,{inets,stop,2},"R14B"}; +obsolete_1(httpd, stop_child, 1) -> {removed,{inets,stop,2},"R14B"}; +obsolete_1(httpd, stop_child, 2) -> {removed,{inets,stop,2},"R14B"}; +obsolete_1(httpd, restart, 0) -> {removed,{httpd,reload_config,2},"R14B"}; +obsolete_1(httpd, restart, 1) -> {removed,{httpd,reload_config,2},"R14B"}; +obsolete_1(httpd, restart, 2) -> {removed,{httpd,reload_config,2},"R14B"}; +obsolete_1(httpd, block, 0) -> {removed,{httpd,reload_config,2},"R14B"}; +obsolete_1(httpd, block, 1) -> {removed,{httpd,reload_config,2},"R14B"}; +obsolete_1(httpd, block, 2) -> {removed,{httpd,reload_config,2},"R14B"}; +obsolete_1(httpd, block, 3) -> {removed,{httpd,reload_config,2},"R14B"}; +obsolete_1(httpd, block, 4) -> {removed,{httpd,reload_config,2},"R14B"}; +obsolete_1(httpd, unblock, 0) -> {removed,{httpd,reload_config,2},"R14B"}; +obsolete_1(httpd, unblock, 1) -> {removed,{httpd,reload_config,2},"R14B"}; +obsolete_1(httpd, unblock, 2) -> {removed,{httpd,reload_config,2},"R14B"}; obsolete_1(httpd_util, key1search, 2) -> {removed,{proplists,get_value,2},"R13B"}; obsolete_1(httpd_util, key1search, 3) -> {removed,{proplists,get_value,3},"R13B"}; -obsolete_1(ftp, open, 3) -> {deprecated,{inets,start,[2,3]},"R14B"}; -obsolete_1(ftp, force_active, 1) -> {deprecated,{inets,start,[2,3]},"R14B"}; +obsolete_1(ftp, open, 3) -> {removed,{inets,start,[2,3]},"R14B"}; +obsolete_1(ftp, force_active, 1) -> {removed,{inets,start,[2,3]},"R14B"}; %% Added in R12B-4. obsolete_1(ssh_cm, connect, A) when 1 =< A, A =< 3 -> - {deprecated,{ssh,connect,A},"R14B"}; + {removed,{ssh,connect,A},"R14B"}; obsolete_1(ssh_cm, listen, A) when 2 =< A, A =< 4 -> - {deprecated,{ssh,daemon,A},"R14B"}; + {removed,{ssh,daemon,A},"R14B"}; obsolete_1(ssh_cm, stop_listener, 1) -> - {deprecated,{ssh,stop_listener,[1,2]},"R14B"}; + {removed,{ssh,stop_listener,[1,2]},"R14B"}; obsolete_1(ssh_cm, session_open, A) when A =:= 2; A =:= 4 -> - {deprecated,{ssh_connection,session_channel,A},"R14B"}; + {removed,{ssh_connection,session_channel,A},"R14B"}; obsolete_1(ssh_cm, direct_tcpip, A) when A =:= 6; A =:= 8 -> - {deprecated,{ssh_connection,direct_tcpip,A}}; + {removed,{ssh_connection,direct_tcpip,A}}; obsolete_1(ssh_cm, tcpip_forward, 3) -> - {deprecated,{ssh_connection,tcpip_forward,3},"R14B"}; + {removed,{ssh_connection,tcpip_forward,3},"R14B"}; obsolete_1(ssh_cm, cancel_tcpip_forward, 3) -> - {deprecated,{ssh_connection,cancel_tcpip_forward,3},"R14B"}; + {removed,{ssh_connection,cancel_tcpip_forward,3},"R14B"}; obsolete_1(ssh_cm, open_pty, A) when A =:= 3; A =:= 7; A =:= 9 -> - {deprecated,{ssh_connection,open_pty,A},"R14"}; + {removed,{ssh_connection,open_pty,A},"R14"}; obsolete_1(ssh_cm, setenv, 5) -> - {deprecated,{ssh_connection,setenv,5},"R14B"}; + {removed,{ssh_connection,setenv,5},"R14B"}; obsolete_1(ssh_cm, shell, 2) -> - {deprecated,{ssh_connection,shell,2},"R14B"}; + {removed,{ssh_connection,shell,2},"R14B"}; obsolete_1(ssh_cm, exec, 4) -> - {deprecated,{ssh_connection,exec,4},"R14B"}; + {removed,{ssh_connection,exec,4},"R14B"}; obsolete_1(ssh_cm, subsystem, 4) -> - {deprecated,{ssh_connection,subsystem,4},"R14B"}; + {removed,{ssh_connection,subsystem,4},"R14B"}; obsolete_1(ssh_cm, winch, A) when A =:= 4; A =:= 6 -> - {deprecated,{ssh_connection,window_change,A},"R14B"}; + {removed,{ssh_connection,window_change,A},"R14B"}; obsolete_1(ssh_cm, signal, 3) -> - {deprecated,{ssh_connection,signal,3},"R14B"}; + {removed,{ssh_connection,signal,3},"R14B"}; obsolete_1(ssh_cm, attach, A) when A =:= 2; A =:= 3 -> - {deprecated,{ssh,attach,A}}; + {removed,{ssh,attach,A}}; obsolete_1(ssh_cm, detach, 2) -> - {deprecated,"no longer useful; will be removed in R14B"}; + {removed,"no longer useful; will be removed in R14B"}; obsolete_1(ssh_cm, set_user_ack, 4) -> - {deprecated,"no longer useful; will be removed in R14B"}; + {removed,"no longer useful; will be removed in R14B"}; obsolete_1(ssh_cm, adjust_window, 3) -> - {deprecated,{ssh_connection,adjust_window,3},"R14B"}; + {removed,{ssh_connection,adjust_window,3},"R14B"}; obsolete_1(ssh_cm, close, 2) -> - {deprecated,{ssh_connection,close,2},"R14B"}; + {removed,{ssh_connection,close,2},"R14B"}; obsolete_1(ssh_cm, stop, 1) -> - {deprecated,{ssh,close,1},"R14B"}; + {removed,{ssh,close,1},"R14B"}; obsolete_1(ssh_cm, send_eof, 2) -> - {deprecated,{ssh_connection,send_eof,2},"R14B"}; + {removed,{ssh_connection,send_eof,2},"R14B"}; obsolete_1(ssh_cm, send, A) when A =:= 3; A =:= 4 -> - {deprecated,{ssh_connection,send,A},"R14B"}; + {removed,{ssh_connection,send,A},"R14B"}; obsolete_1(ssh_cm, send_ack, A) when 3 =< A, A =< 5 -> - {deprecated,{ssh_connection,send,[3,4]},"R14B"}; + {removed,{ssh_connection,send,[3,4]},"R14B"}; obsolete_1(ssh_ssh, connect, A) when 1 =< A, A =< 3 -> - {deprecated,{ssh,shell,A},"R14B"}; + {removed,{ssh,shell,A},"R14B"}; obsolete_1(ssh_sshd, listen, A) when 0 =< A, A =< 3 -> - {deprecated,{ssh,daemon,[1,2,3]},"R14"}; + {removed,{ssh,daemon,[1,2,3]},"R14"}; obsolete_1(ssh_sshd, stop, 1) -> - {deprecated,{ssh,stop_listener,1}}; + {removed,{ssh,stop_listener,1}}; %% Added in R13A. obsolete_1(regexp, _, _) -> {deprecated, "the regexp module is deprecated (will be removed in R15A); use the re module instead"}; obsolete_1(lists, flat_length, 1) -> - {deprecated,{lists,flatlength,1},"R14"}; + {removed,{lists,flatlength,1},"R14"}; obsolete_1(ssh_sftp, connect, A) when 1 =< A, A =< 3 -> - {deprecated,{ssh_sftp,start_channel,A},"R14B"}; + {removed,{ssh_sftp,start_channel,A},"R14B"}; obsolete_1(ssh_sftp, stop, 1) -> - {deprecated,{ssh_sftp,stop_channel,1},"R14B"}; + {removed,{ssh_sftp,stop_channel,1},"R14B"}; %% Added in R13B01. obsolete_1(ssl_pkix, decode_cert_file, A) when A =:= 1; A =:= 2 -> @@ -337,7 +355,7 @@ obsolete_1(ssl_pkix, decode_cert, A) when A =:= 1; A =:= 2 -> %% Added in R13B04. obsolete_1(erlang, concat_binary, 1) -> - {deprecated,{erlang,list_to_binary,1},"R14B"}; + {deprecated,{erlang,list_to_binary,1},"R15B"}; obsolete_1(_, _, _) -> no. diff --git a/lib/stdlib/src/timer.erl b/lib/stdlib/src/timer.erl index 36fdb48c75..6ee837c3e6 100644 --- a/lib/stdlib/src/timer.erl +++ b/lib/stdlib/src/timer.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% -module(timer). @@ -41,54 +41,54 @@ %% %% Time is in milliseconds. %% --opaque tref() :: any(). +-opaque tref() :: {integer(), reference()}. -type time() :: non_neg_integer(). -type timestamp() :: {non_neg_integer(), non_neg_integer(), non_neg_integer()}. %% %% Interface functions %% --spec apply_after(time(), atom(), atom(), [_]) -> {'ok', tref()} | {'error', _}. +-spec apply_after(time(), atom(), atom(), [term()]) -> {'ok', tref()} | {'error', term()}. apply_after(Time, M, F, A) -> req(apply_after, {Time, {M, F, A}}). --spec send_after(time(), pid() | atom(), term()) -> {'ok', tref()} | {'error', _}. +-spec send_after(time(), pid() | atom(), term()) -> {'ok', tref()} | {'error', term()}. send_after(Time, Pid, Message) -> req(apply_after, {Time, {?MODULE, send, [Pid, Message]}}). --spec send_after(time(), _) -> {'ok', tref()} | {'error', _}. +-spec send_after(time(), term()) -> {'ok', tref()} | {'error', term()}. send_after(Time, Message) -> send_after(Time, self(), Message). --spec exit_after(time(), pid() | atom(), _) -> {'ok', tref()} | {'error', _}. +-spec exit_after(time(), pid() | atom(), term()) -> {'ok', tref()} | {'error', term()}. exit_after(Time, Pid, Reason) -> req(apply_after, {Time, {erlang, exit, [Pid, Reason]}}). --spec exit_after(time(), term()) -> {'ok', tref()} | {'error', _}. +-spec exit_after(time(), term()) -> {'ok', tref()} | {'error', term()}. exit_after(Time, Reason) -> exit_after(Time, self(), Reason). --spec kill_after(time(), pid() | atom()) -> {'ok', tref()} | {'error', _}. +-spec kill_after(time(), pid() | atom()) -> {'ok', tref()} | {'error', term()}. kill_after(Time, Pid) -> exit_after(Time, Pid, kill). --spec kill_after(time()) -> {'ok', tref()} | {'error', _}. +-spec kill_after(time()) -> {'ok', tref()} | {'error', term()}. kill_after(Time) -> exit_after(Time, self(), kill). --spec apply_interval(time(), atom(), atom(), [_]) -> {'ok', tref()} | {'error', _}. +-spec apply_interval(time(), atom(), atom(), [term()]) -> {'ok', tref()} | {'error', term()}. apply_interval(Time, M, F, A) -> req(apply_interval, {Time, self(), {M, F, A}}). --spec send_interval(time(), pid() | atom(), term()) -> {'ok', tref()} | {'error', _}. +-spec send_interval(time(), pid() | atom(), term()) -> {'ok', tref()} | {'error', term()}. send_interval(Time, Pid, Message) -> req(apply_interval, {Time, Pid, {?MODULE, send, [Pid, Message]}}). --spec send_interval(time(), term()) -> {'ok', tref()} | {'error', _}. +-spec send_interval(time(), term()) -> {'ok', tref()} | {'error', term()}. send_interval(Time, Message) -> send_interval(Time, self(), Message). --spec cancel(tref()) -> {'ok', 'cancel'} | {'error', _}. +-spec cancel(tref()) -> {'ok', 'cancel'} | {'error', term()}. cancel(BRef) -> req(cancel, BRef). @@ -101,7 +101,7 @@ sleep(T) -> %% %% Measure the execution time (in microseconds) for an MFA. %% --spec tc(atom(), atom(), [_]) -> {time(), term()}. +-spec tc(atom(), atom(), [term()]) -> {time(), term()}. tc(M, F, A) -> Before = erlang:now(), Val = (catch apply(M, F, A)), @@ -141,7 +141,7 @@ hms(H, M, S) -> start() -> ensure_started(). --spec start_link() -> {'ok', pid()} | {'error', _}. +-spec start_link() -> {'ok', pid()} | {'error', term()}. start_link() -> gen_server:start_link({local, timer_server}, ?MODULE, [], []). @@ -152,6 +152,7 @@ init([]) -> ?INTERVAL_TAB = ets:new(?INTERVAL_TAB, [named_table,protected]), {ok, [], infinity}. +-spec ensure_started() -> 'ok'. ensure_started() -> case whereis(timer_server) of undefined -> @@ -175,6 +176,10 @@ req(Req, Arg) -> %% %% Time and Timeout is in milliseconds. Started is in microseconds. %% +-type timers() :: term(). % XXX: refine? + +-spec handle_call(term(), term(), timers()) -> + {'reply', term(), timers(), timeout()} | {'noreply', timers(), timeout()}. handle_call({apply_after, {Time, Op}, Started}, _From, _Ts) when is_integer(Time), Time >= 0 -> BRef = {Started + 1000*Time, make_ref()}, @@ -194,7 +199,7 @@ handle_call({apply_interval, {Time, To, MFA}, Started}, _From, _Ts) Interval = Time*1000, BRef2 = {Started + Interval, Ref}, Timer = {BRef2, {repeat, Interval, Pid}, MFA}, - ets:insert(?INTERVAL_TAB,{BRef1,BRef2,Pid}), + ets:insert(?INTERVAL_TAB, {BRef1,BRef2,Pid}), ets:insert(?TIMER_TAB, Timer), Timeout = timer_timeout(SysTime), {reply, {ok, BRef1}, [], Timeout}; @@ -202,7 +207,7 @@ handle_call({apply_interval, {Time, To, MFA}, Started}, _From, _Ts) {reply, {error, badarg}, [], next_timeout()} end; handle_call({cancel, BRef = {_Time, Ref}, _}, _From, Ts) - when is_reference(Ref) -> + when is_reference(Ref) -> delete_ref(BRef), {reply, {ok, cancel}, Ts, next_timeout()}; handle_call({cancel, _BRef, _}, _From, Ts) -> @@ -214,6 +219,7 @@ handle_call({apply_interval, _, _}, _From, Ts) -> handle_call(_Else, _From, Ts) -> % Catch anything else {noreply, Ts, next_timeout()}. +-spec handle_info(term(), timers()) -> {'noreply', timers(), timeout()}. handle_info(timeout, Ts) -> % Handle timeouts Timeout = timer_timeout(system_time()), {noreply, Ts, Timeout}; @@ -223,19 +229,21 @@ handle_info({'EXIT', Pid, _Reason}, Ts) -> % Oops, someone died handle_info(_OtherMsg, Ts) -> % Other Msg's {noreply, Ts, next_timeout()}. +-spec handle_cast(term(), timers()) -> {'noreply', timers(), timeout()}. handle_cast(_Req, Ts) -> % Not predicted but handled {noreply, Ts, next_timeout()}. --spec terminate(_, _) -> 'ok'. +-spec terminate(term(), _State) -> 'ok'. terminate(_Reason, _State) -> ok. +-spec code_change(term(), State, term()) -> {'ok', State}. code_change(_OldVsn, State, _Extra) -> %% According to the man for gen server no timer can be set here. {ok, State}. %% -%% timer_timeout(Timers, SysTime) +%% timer_timeout(SysTime) %% %% Apply and remove already timed-out timers. A timer is a tuple %% {Time, BRef, Op, MFA}, where Time is in microseconds. @@ -279,12 +287,13 @@ delete_ref(BRef = {interval, _}) -> ok end; delete_ref(BRef) -> - ets:delete(?TIMER_TAB,BRef). + ets:delete(?TIMER_TAB, BRef). %% %% pid_delete %% +-spec pid_delete(pid()) -> 'ok'. pid_delete(Pid) -> IntervalTimerList = ets:select(?INTERVAL_TAB, @@ -292,13 +301,14 @@ pid_delete(Pid) -> [{'==','$1',Pid}], ['$_']}]), lists:foreach(fun({IntKey, TimerKey, _ }) -> - ets:delete(?INTERVAL_TAB,IntKey), - ets:delete(?TIMER_TAB,TimerKey) + ets:delete(?INTERVAL_TAB, IntKey), + ets:delete(?TIMER_TAB, TimerKey) end, IntervalTimerList). %% Calculate time to the next timeout. Returned timeout must fit in a %% small int. +-spec next_timeout() -> timeout(). next_timeout() -> case ets:first(?TIMER_TAB) of '$end_of_table' -> @@ -358,7 +368,7 @@ get_pid(_) -> get_status() -> Info1 = ets:info(?TIMER_TAB), - {value,{size,TotalNumTimers}} = lists:keysearch(size, 1, Info1), + {size,TotalNumTimers} = lists:keyfind(size, 1, Info1), Info2 = ets:info(?INTERVAL_TAB), - {value,{size,NumIntervalTimers}} = lists:keysearch(size, 1, Info2), + {size,NumIntervalTimers} = lists:keyfind(size, 1, Info2), {{?TIMER_TAB,TotalNumTimers},{?INTERVAL_TAB,NumIntervalTimers}}. diff --git a/lib/stdlib/src/zip.erl b/lib/stdlib/src/zip.erl index f44d97c227..d41aeefa59 100644 --- a/lib/stdlib/src/zip.erl +++ b/lib/stdlib/src/zip.erl @@ -1,26 +1,26 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2006-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2006-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% -module(zip). %% Basic api -export([unzip/1, unzip/2, extract/1, extract/2, - zip/2, zip/3, create/2, create/3, + zip/2, zip/3, create/2, create/3, foldl/3, list_dir/1, list_dir/2, table/1, table/2, t/1, tt/1]). @@ -38,7 +38,7 @@ zip_t/1, zip_tt/1, zip_list_dir/1, zip_list_dir/2, zip_close/1]). - + %% just for debugging zip server, not documented, not tested, not to be used -export([zip_get_state/1]). @@ -82,7 +82,7 @@ -record(openzip_opts, { output, % output object (fun) open_opts, % file:open options - cwd % directory to relate paths to + cwd % directory to relate paths to }). % openzip record, state for an open zip-file @@ -93,10 +93,10 @@ input, % archive io object (fun) output, % output io object (fun) zlib, % handle to open zlib - cwd % directory to relate paths to + cwd % directory to relate paths to }). -% Things that I would like to add to the public record #zip_file, +% Things that I would like to add to the public record #zip_file, % but can't as it would make things fail at upgrade. % Instead we use {#zip_file,#zip_file_extra} internally. -record(zip_file_extra, { @@ -278,7 +278,7 @@ file_name_search(Name,Files) -> [ZFile|_] -> ZFile; [] -> false end. - + %% %% add a file to an open archive %% openzip_add(File, OpenZip) -> %% case ?CATCH do_openzip_add(File, OpenZip) of @@ -344,6 +344,25 @@ do_unzip(F, Options) -> Input(close, In1), {ok, Files}. +%% Iterate over all files in a zip archive +foldl(Fun, Acc0, Archive) when is_function(Fun, 4) -> + ZipFun = + fun({Name, GetInfo, GetBin}, A) -> + A2 = Fun(Name, GetInfo, GetBin, A), + {true, false, A2} + end, + case prim_zip:open(ZipFun, Acc0, Archive) of + {ok, PrimZip, Acc1} -> + ok = prim_zip:close(PrimZip), + {ok, Acc1}; + {error, bad_eocd} -> + {error, "Not an archive file"}; + {error, Reason} -> + {error, Reason} + end; +foldl(_,_, _) -> + {error, einval}. + %% Create zip archive name F from Files or binaries %% %% Accepted options: @@ -383,7 +402,7 @@ list_dir(F, Options) -> do_list_dir(F, Options) -> Opts = get_list_dir_options(F, Options), - #list_dir_opts{input = Input, open_opts = OpO, + #list_dir_opts{input = Input, open_opts = OpO, raw_iterator = RawIterator} = Opts, In0 = Input({open, F, OpO}, []), {Info, In1} = get_central_dir(In0, RawIterator, Input), @@ -417,7 +436,7 @@ tt(F) when is_record(F, openzip) -> openzip_tt(F); tt(F) -> t(F, fun raw_long_print_info_etc/5). -%% option utils +%% option utils get_unzip_opt([], Opts) -> Opts; get_unzip_opt([verbose | Rest], Opts) -> @@ -470,7 +489,7 @@ get_zip_opt([{cwd, CWD} | Rest], Opts) -> get_zip_opt([{comment, C} | Rest], Opts) -> get_zip_opt(Rest, Opts#zip_opts{comment = C}); get_zip_opt([{compress, Which} = O| Rest], Opts) -> - Which2 = + Which2 = case Which of all -> all; @@ -485,7 +504,7 @@ get_zip_opt([{compress, Which} = O| Rest], Opts) -> end, get_zip_opt(Rest, Opts#zip_opts{compress = Which2}); get_zip_opt([{uncompress, Which} = O| Rest], Opts) -> - Which2 = + Which2 = case Which of all -> all; @@ -560,16 +579,24 @@ get_openzip_options(Options) -> get_input(F) when is_binary(F) -> fun binary_io/2; get_input(F) when is_list(F) -> - fun file_io/2. + fun file_io/2; +get_input(_) -> + throw(einval). get_zip_input({F, B}) when is_binary(B), is_list(F) -> fun binary_io/2; +get_zip_input({F, B, #file_info{}}) when is_binary(B), is_list(F) -> + fun binary_io/2; +get_zip_input({F, #file_info{}, B}) when is_binary(B), is_list(F) -> + fun binary_io/2; get_zip_input(F) when is_list(F) -> fun file_io/2; get_zip_input({files, []}) -> fun binary_io/2; get_zip_input({files, [File | _]}) -> - get_zip_input(File). + get_zip_input(File); +get_zip_input(_) -> + throw(einval). get_list_dir_options(F, Options) -> Opts = #list_dir_opts{raw_iterator = fun raw_file_info_public/5, @@ -620,6 +647,8 @@ put_eocd(N, Pos, Sz, Comment, Output, Out0) -> get_filename({Name, _}, Type) -> get_filename(Name, Type); +get_filename({Name, _, _}, Type) -> + get_filename(Name, Type); get_filename(Name, regular) -> Name; get_filename(Name, directory) -> @@ -895,7 +924,7 @@ local_file_header_to_bin( CompSize:32/little, UncompSize:32/little, FileNameLength:16/little, - ExtraFieldLength:16/little>>. + ExtraFieldLength:16/little>>. eocd_to_bin(#eocd{disk_num = DiskNum, start_disk_num = StartDiskNum, @@ -912,7 +941,7 @@ eocd_to_bin(#eocd{disk_num = DiskNum, Offset:32/little, ZipCommentLength:16/little>>. -%% put together a local file header +%% put together a local file header local_file_header_from_info_method_name(#file_info{mtime = MTime}, UncompSize, CompMethod, Name) -> @@ -939,7 +968,7 @@ server_loop(OpenZip) -> server_loop(NewOpenZip); Error -> From ! {self(), Error} - end; + end; {From, close} -> From ! {self(), openzip_close(OpenZip)}; {From, get} -> @@ -1024,7 +1053,7 @@ lists_foreach(F, [Hd|Tl]) -> F(Hd), lists_foreach(F, Tl). -%% option utils +%% option utils get_openzip_opt([], Opts) -> Opts; get_openzip_opt([cooked | Rest], #openzip_opts{open_opts = OO} = Opts) -> @@ -1121,7 +1150,7 @@ raw_file_info_public(CD, FileName, FileComment, BExtraField, Acc0) -> Other -> Other end, [H2|T]. - + %% make a file_info from a central directory header cd_file_header_to_file_info(FileName, @@ -1213,8 +1242,8 @@ get_z_file(In0, Z, Input, Output, OpO, FB, CWD, {ZipFile,Extra}) -> {dir, In3}; _ -> %% FileInfo = local_file_header_to_file_info(LH) - %%{Out, In4, CRC, UncompSize} = - {Out, In4, CRC, _UncompSize} = + %%{Out, In4, CRC, UncompSize} = + {Out, In4, CRC, _UncompSize} = get_z_data(CompMethod, In3, FileName1, CompSize, Input, Output, OpO, Z), In5 = skip_z_data_descriptor(GPFlag, Input, In4), @@ -1280,7 +1309,7 @@ get_z_data_loop(CompSize, UncompSize, In0, Out0, Input, Output, Z) -> Out1 = Output({write, Uncompressed}, Out0), get_z_data_loop(CompSize-N, UncompSize + iolist_size(Uncompressed), In1, Out1, Input, Output, Z) - end. + end. %% skip data descriptor if any @@ -1298,7 +1327,7 @@ dos_date_time_to_datetime(DosDate, DosTime) -> <<Hour:5, Min:6, Sec:5>> = <<DosTime:16>>, <<YearFrom1980:7, Month:4, Day:5>> = <<DosDate:16>>, {{YearFrom1980+1980, Month, Day}, - {Hour, Min, Sec}}. + {Hour, Min, Sec}}. dos_date_time_from_datetime({{Year, Month, Day}, {Hour, Min, Sec}}) -> YearFrom1980 = Year-1980, @@ -1319,7 +1348,6 @@ unix_extra_field_and_var_from_bin(<<TSize:16/little, Var}; unix_extra_field_and_var_from_bin(_) -> throw(bad_unix_extra_field). - %% A pwrite-like function for iolists (used by memory-option) @@ -1478,6 +1506,8 @@ local_file_header_from_bin(_) -> %% io functions binary_io({file_info, {_Filename, _B, #file_info{} = FI}}, _A) -> FI; +binary_io({file_info, {_Filename, #file_info{} = FI, _B}}, _A) -> + FI; binary_io({file_info, {_Filename, B}}, A) -> binary_io({file_info, B}, A); binary_io({file_info, B}, _) -> @@ -1493,9 +1523,11 @@ binary_io({file_info, B}, _) -> links = 1, major_device = 0, minor_device = 0, inode = 0, uid = 0, gid = 0}; -binary_io({open, {_Filename, B, _FI}, _Opts}, _) -> +binary_io({open, {_Filename, B, _FI}, _Opts}, _) when is_binary(B) -> + {0, B}; +binary_io({open, {_Filename, _FI, B}, _Opts}, _) when is_binary(B) -> {0, B}; -binary_io({open, {_Filename, B}, _Opts}, _) -> +binary_io({open, {_Filename, B}, _Opts}, _) when is_binary(B) -> {0, B}; binary_io({open, B, _Opts}, _) when is_binary(B) -> {0, B}; diff --git a/lib/stdlib/test/epp_SUITE.erl b/lib/stdlib/test/epp_SUITE.erl index 01027ba768..4806b5d361 100644 --- a/lib/stdlib/test/epp_SUITE.erl +++ b/lib/stdlib/test/epp_SUITE.erl @@ -23,7 +23,8 @@ upcase_mac/1, upcase_mac_1/1, upcase_mac_2/1, variable/1, variable_1/1, otp_4870/1, otp_4871/1, otp_5362/1, pmod/1, not_circular/1, skip_header/1, otp_6277/1, otp_7702/1, - otp_8130/1, overload_mac/1, otp_8388/1, otp_8470/1]). + otp_8130/1, overload_mac/1, otp_8388/1, otp_8470/1, otp_8503/1, + otp_8562/1]). -export([epp_parse_erl_form/2]). @@ -63,7 +64,7 @@ all(doc) -> all(suite) -> [rec_1, upcase_mac, predef_mac, variable, otp_4870, otp_4871, otp_5362, pmod, not_circular, skip_header, otp_6277, otp_7702, otp_8130, - overload_mac, otp_8388, otp_8470]. + overload_mac, otp_8388, otp_8470, otp_8503, otp_8562]. rec_1(doc) -> ["Recursive macros hang or crash epp (OTP-1398)."]; @@ -616,9 +617,9 @@ otp_8130(Config) when is_list(Config) -> "t() -> 14 = (#file_info{size = 14})#file_info.size, ok.\n">>, ok}, - {otp_8130_7, + {otp_8130_7_new, <<"-record(b, {b}).\n" - "-define(A, {{a,#b.b.\n" + "-define(A, {{a,#b.b).\n" "t() -> {{a,2}} = ?A}}, ok.">>, ok}, @@ -750,7 +751,14 @@ otp_8130(Config) when is_list(Config) -> {otp_8130_c24, <<"\n-include(\"no such file.erl\").\n">>, - {errors,[{{2,2},epp,{include,file,"no such file.erl"}}],[]}} + {errors,[{{2,2},epp,{include,file,"no such file.erl"}}],[]}}, + + {otp_8130_7, + <<"-record(b, {b}).\n" + "-define(A, {{a,#b.b.\n" + "t() -> {{a,2}} = ?A}}, ok.">>, + {errors,[{{2,20},epp,missing_parenthesis}, + {{3,19},epp,{undefined,'A',none}}],[]}} ], ?line [] = compile(Config, Cs), @@ -1047,13 +1055,13 @@ overload_mac(Config) when is_list(Config) -> "-undef(A).\n" "t1() -> ?A.\n", "t2() -> ?A(1).">>, - {errors,[{{4,9},epp,{undefined,'A', none}}, - {{5,9},epp,{undefined,'A', 1}}],[]}}, + {errors,[{{4,10},epp,{undefined,'A', none}}, + {{5,10},epp,{undefined,'A', 1}}],[]}}, %% cannot overload predefined macros {overload_mac_c2, <<"-define(MODULE(X), X).">>, - {errors,[{{1,9},epp,{redefine_predef,'MODULE'}}],[]}}, + {errors,[{{1,50},epp,{redefine_predef,'MODULE'}}],[]}}, %% cannot overload macros with same arity {overload_mac_c3, @@ -1120,27 +1128,27 @@ otp_8388(Config) when is_list(Config) -> {macro_1, <<"-define(m(A), A).\n" "t() -> ?m(,).\n">>, - {errors,[{{2,11},epp,{arg_error,m}}],[]}}, + {errors,[{{2,9},epp,{arg_error,m}}],[]}}, {macro_2, <<"-define(m(A), A).\n" "t() -> ?m(a,).\n">>, - {errors,[{{2,12},epp,{arg_error,m}}],[]}}, + {errors,[{{2,9},epp,{arg_error,m}}],[]}}, {macro_3, <<"-define(LINE, a).\n">>, - {errors,[{{1,9},epp,{redefine_predef,'LINE'}}],[]}}, + {errors,[{{1,50},epp,{redefine_predef,'LINE'}}],[]}}, {macro_4, <<"-define(A(B, C, D), {B,C,D}).\n" "t() -> ?A(a,,3).\n">>, - {errors,[{{2,8},epp,{mismatch,'A'}}],[]}}, + {errors,[{{2,9},epp,{mismatch,'A'}}],[]}}, {macro_5, <<"-define(Q, {?F0(), ?F1(,,4)}).\n">>, - {errors,[{{1,24},epp,{arg_error,'F1'}}],[]}}, + {errors,[{{1,62},epp,{arg_error,'F1'}}],[]}}, {macro_6, <<"-define(FOO(X), ?BAR(X)).\n" "-define(BAR(X), ?FOO(X)).\n" "-undef(FOO).\n" "test() -> ?BAR(1).\n">>, - {errors,[{{4,11},epp,{undefined,'FOO',1}}],[]}} + {errors,[{{4,12},epp,{undefined,'FOO',1}}],[]}} ], ?line [] = compile(Config, Ts), ok. @@ -1160,6 +1168,35 @@ otp_8470(Config) when is_list(Config) -> ?line receive _ -> fail() after 0 -> ok end, ok. +otp_8503(doc) -> + ["OTP-8503. Record with no fields is considered typed."]; +otp_8503(suite) -> + []; +otp_8503(Config) when is_list(Config) -> + Dir = ?config(priv_dir, Config), + C = <<"-record(r, {}).">>, + ?line File = filename:join(Dir, "otp_8503.erl"), + ?line ok = file:write_file(File, C), + ?line {ok, List} = epp:parse_file(File, [], []), + ?line [_] = [F || {attribute,_,type,{{record,r},[],[]}}=F <- List], + file:delete(File), + ?line receive _ -> fail() after 0 -> ok end, + ok. + +otp_8562(doc) -> + ["OTP-8503. Record with no fields is considered typed."]; +otp_8562(suite) -> + []; +otp_8562(Config) when is_list(Config) -> + Cs = [{otp_8562, + <<"-define(P(), {a,b}.\n" + "-define(P3, .\n">>, + {errors,[{{1,60},epp,missing_parenthesis}, + {{2,13},epp,missing_parenthesis}], []}} + ], + ?line [] = compile(Config, Cs), + ok. + check(Config, Tests) -> eval_tests(Config, fun check_test/2, Tests). diff --git a/lib/stdlib/test/erl_pp_SUITE.erl b/lib/stdlib/test/erl_pp_SUITE.erl index a695374908..66730b7b94 100644 --- a/lib/stdlib/test/erl_pp_SUITE.erl +++ b/lib/stdlib/test/erl_pp_SUITE.erl @@ -46,7 +46,7 @@ neg_indent/1, tickets/1, otp_6321/1, otp_6911/1, otp_6914/1, otp_8150/1, otp_8238/1, - otp_8473/1]). + otp_8473/1, otp_8522/1, otp_8567/1]). %% Internal export. -export([ehook/6]). @@ -150,15 +150,15 @@ recs(Config) when is_list(Config) -> (A#r1.a)#r.a > 3 -> 3 end(#r1{a = #r{a = 4}}), 7 = fun(A) when record(A#r3.a, r1) -> 7 end(#r3{}), - [#r1{a = 2,b = 1}] = + [#r1{a = 2,b = 1}] = fun() -> - [A || A <- [#r1{a = 1, b = 3}, - #r2{a = 2,b = 1}, + [A || A <- [#r1{a = 1, b = 3}, + #r2{a = 2,b = 1}, #r1{a = 2, b = 1}], - A#r1.a > + A#r1.a > A#r1.b] end(), - {[_],b} = + {[_],b} = fun(L) -> %% A is checked only once: R1 = [{A,B} || A <- L, A#r1.a, B <- L, A#r1.b], @@ -177,7 +177,7 @@ recs(Config) when is_list(Config) -> end(#r1{a = 2}), %% The test done twice (an effect of doing the test as soon as possible). - 3 = fun(A) when A#r1.a > 3, + 3 = fun(A) when A#r1.a > 3, record(A, r1) -> 3 end(#r1{a = 5}), @@ -251,18 +251,18 @@ recs(Config) when is_list(Config) -> ok end(), - both = fun(A) when A#r.a, A#r.b -> both + both = fun(A) when A#r.a, A#r.b -> both end(#r{a = true, b = true}), ok = fun() -> - F = fun(A, B) when ((A#r1.a) orelse (B#r2.a)) + F = fun(A, B) when ((A#r1.a) orelse (B#r2.a)) or (B#r2.b) or (A#r1.b) -> true; (_, _) -> false end, - true = F(#r1{a = false, b = false}, + true = F(#r1{a = false, b = false}, #r2{a = false, b = true}), - false = F(#r1{a = true, b = true}, + false = F(#r1{a = true, b = true}, #r1{a = false, b = true}), ok end(), @@ -273,7 +273,7 @@ recs(Config) when is_list(Config) -> <<"-record(r1, {a, b = foo:bar(kljlfjsdlf, kjlksdjf)}). -record(r2, {c = #r1{}, d = #r1{a = bar:foo(kljklsjdf)}}). - t() -> + t() -> R = #r2{}, R#r2{c = R, d = #r1{}}.">>} ], @@ -304,10 +304,10 @@ try_catch(Config) when is_list(Config) -> {try_6, <<"t() -> try 1=2 catch throw:{badmatch,2} -> 3 end.">>}, {try_7, - <<"t() -> try 1=2 of 3 -> 4 + <<"t() -> try 1=2 of 3 -> 4 catch error:{badmatch,2} -> 5 end.">>}, {try_8, - <<"t() -> try 1=2 + <<"t() -> try 1=2 catch error:{badmatch,2} -> 3 after put(try_catch, 4) end.">>}, {try_9, @@ -371,7 +371,7 @@ receive_after(Config) when is_list(Config) -> {X,Y}; Z -> Z - after + after foo:bar() -> {3,4} end.">>} @@ -429,7 +429,7 @@ head_tail(Config) when is_list(Config) -> {list_4, <<"t() -> [a].">>}, {list_5, - <<"t() -> + <<"t() -> [foo:bar(lkjljlskdfj, klsdajflds, sdafkljsdlfkjdas, kjlsdadjl), bar:foo(kljlkjsdf, lkjsdlfj, [kljsfj, sdfdsfsad])].">>} ], @@ -462,7 +462,7 @@ cond1(Config) when is_list(Config) -> " true ->\n" " {x,y}\n" "end" = CChars, -% ?line ok = pp_expr(<<"cond +% ?line ok = pp_expr(<<"cond % {foo,bar} -> % [a,b]; % true -> @@ -544,7 +544,7 @@ old_mnemosyne_syntax(Config) when is_list(Config) -> " X <- table(tab),\n" " X.foo = bar\n" " ]\n" - "end" = + "end" = lists:flatten(erl_pp:expr(Q)), R = {rule,12,sales,2, @@ -559,7 +559,7 @@ old_mnemosyne_syntax(Config) when is_list(Config) -> {atom,14,sales}}]}]}, ?line "sales(E, employee) :-\n" " E <- table(employee),\n" - " E.salary = sales.\n" = + " E.salary = sales.\n" = lists:flatten(erl_pp:form(R)), ok. @@ -660,7 +660,7 @@ hook(Config) when is_list(Config) -> ?line "INVALID-FORM:{foo,bar}:" = lists:flatten(erl_pp:expr({foo,bar})), - %% A list (as before R6), not a list of lists. + %% A list (as before R6), not a list of lists. G = [{op,1,'>',{atom,1,a},{foo,{atom,1,b}}}], % not a proper guard GChars = lists:flatten(erl_pp:guard(G, H)), G2 = [{op,1,'>',{atom,1,a}, @@ -677,23 +677,23 @@ hook(Config) when is_list(Config) -> %% Note: no leading spaces before "begin". Block = {block,0,[{match,0,{var,0,'A'},{integer,0,3}}, {atom,0,true}]}, - ?line "begin\n A =" ++ _ = + ?line "begin\n A =" ++ _ = lists:flatten(erl_pp:expr(Block, 17, none)), %% Special... - ?line true = + ?line true = "{some,value}" =:= lists:flatten(erl_pp:expr({value,0,{some,value}})), %% Silly... ?line true = - "if true -> 0 end" =:= + "if true -> 0 end" =:= flat_expr({'if',0,[{clause,0,[],[],[{atom,0,0}]}]}), %% More compatibility: before R6 OldIf = {'if',0,[{clause,0,[],[{atom,0,true}],[{atom,0,b}]}]}, NewIf = {'if',0,[{clause,0,[],[[{atom,0,true}]],[{atom,0,b}]}]}, OldIfChars = lists:flatten(erl_pp:expr(OldIf)), - NewIfChars = lists:flatten(erl_pp:expr(NewIf)), + NewIfChars = lists:flatten(erl_pp:expr(NewIf)), ?line true = OldIfChars =:= NewIfChars, ok. @@ -706,7 +706,7 @@ remove_indentation(S) -> ehook(HE, I, P, H, foo, bar) -> hook(HE, I, P, H). -hook({foo,E}, I, P, H) -> +hook({foo,E}, I, P, H) -> erl_pp:expr({call,0,{atom,0,foo},[E]}, I, P, H). neg_indent(suite) -> @@ -722,14 +722,14 @@ neg_indent(Config) when is_list(Config) -> end">>), ?line ok = pp_expr( <<"fun() -> - F = fun(A, B) when ((A#r1.a) orelse (B#r2.a)) + F = fun(A, B) when ((A#r1.a) orelse (B#r2.a)) or (B#r2.b) or (A#r1.b) -> true; (_, _) -> false end, - true = F(#r1{a = false, b = false}, + true = F(#r1{a = false, b = false}, #r2{a = false, b = true}), - false = F(#r1{a = true, b = true}, + false = F(#r1{a = true, b = true}, #r1{a = false, b = true}), ok end()">>), @@ -764,7 +764,8 @@ neg_indent(Config) when is_list(Config) -> ok. tickets(suite) -> - [otp_6321, otp_6911, otp_6914, otp_8150, otp_8238, otp_8473]. + [otp_6321, otp_6911, otp_6914, otp_8150, otp_8238, otp_8473, otp_8522, + otp_8567]. otp_6321(doc) -> "OTP_6321. Bug fix of exprs()."; @@ -813,7 +814,7 @@ otp_8150(doc) -> "OTP_8150. Types."; otp_8150(suite) -> []; otp_8150(Config) when is_list(Config) -> - ?line _ = [{N,ok} = {N,pp_forms(B)} || + ?line _ = [{N,ok} = {N,pp_forms(B)} || {N,B} <- type_examples() ], ok. @@ -847,7 +848,7 @@ type_examples() -> {ex4,<<"-type t1() :: atom(). ">>}, {ex5,<<"-type t2() :: [t1()]. ">>}, {ex6,<<"-type t3(Atom) :: integer(Atom). ">>}, - {ex7,<<"-type t4() :: t3(foobar). ">>}, + {ex7,<<"-type '\\'t::4'() :: t3('\\'foobar'). ">>}, {ex8,<<"-type t5() :: {t1(), t3(foo)}. ">>}, {ex9,<<"-type t6() :: 1 | 2 | 3 | 'foo' | 'bar'. ">>}, {ex10,<<"-type t7() :: []. ">>}, @@ -883,16 +884,16 @@ type_examples() -> "1|2|3|4|a|b|c|d| " "nonempty_maybe_improper_list(integer, any())]}. ">>}, {ex30,<<"-type t99() ::" - "{t2(),t4(),t5(),t6(),t7(),t8(),t10(),t14()," + "{t2(),'\\'t::4'(),t5(),t6(),t7(),t8(),t10(),t14()," "t15(),t20(),t21(), t22(),t25()}. ">>}, {ex31,<<"-spec t1(FooBar :: t99()) -> t99();" "(t2()) -> t2();" - "(t4()) -> t4() when is_subtype(t4(), t24);" + "('\\'t::4'()) -> '\\'t::4'() when is_subtype('\\'t::4'(), t24);" "(t23()) -> t23() when is_subtype(t23(), atom())," " is_subtype(t23(), t14());" "(t24()) -> t24() when is_subtype(t24(), atom())," " is_subtype(t24(), t14())," - " is_subtype(t24(), t4()).">>}, + " is_subtype(t24(), '\\'t::4'()).">>}, {ex32,<<"-spec mod:t2() -> any(). ">>}, {ex33,<<"-opaque attributes_data() :: " "[{'column', column()} | {'line', info_line()} |" @@ -918,16 +919,88 @@ otp_8473(suite) -> []; otp_8473(Config) when is_list(Config) -> Ex = [{ex1,<<"-type 'fun'(A) :: A.\n" "-type funkar() :: 'fun'(fun((integer()) -> atom())).\n">>}], - ?line _ = [{N,ok} = {N,pp_forms(B)} || + ?line _ = [{N,ok} = {N,pp_forms(B)} || {N,B} <- Ex], ok. +otp_8522(doc) -> + "OTP_8522. Avoid duplicated 'undefined' in record field types."; +otp_8522(suite) -> []; +otp_8522(Config) when is_list(Config) -> + FileName = filename('otp_8522.erl', Config), + C = <<"-module(otp_8522).\n" + "-record(r, {f1 :: undefined,\n" + " f2 :: A :: undefined,\n" + " f3 :: (undefined),\n" + " f4 :: x | y | undefined | z,\n" + " f5 :: a}).\n">>, + ?line ok = file:write_file(FileName, C), + ?line {ok, _} = compile:file(FileName, [{outdir,?privdir},debug_info]), + BF = filename("otp_8522", Config), + ?line {ok, A} = beam_lib:chunks(BF, [abstract_code]), + ?line 5 = count_atom(A, undefined), + ok. + +count_atom(A, A) -> + 1; +count_atom(T, A) when is_tuple(T) -> + count_atom(tuple_to_list(T), A); +count_atom(L, A) when is_list(L) -> + lists:sum([count_atom(T, A) || T <- L]); +count_atom(_, _) -> + 0. + +otp_8567(doc) -> + "OTP_8567. Avoid duplicated 'undefined' in record field types."; +otp_8567(suite) -> []; +otp_8567(Config) when is_list(Config) -> + FileName = filename('otp_8567.erl', Config), + C = <<"-module otp_8567.\n" + "-compile export_all.\n" + "-spec(a).\n" + "-record r, {a}.\n" + "-record s, {a :: integer()}.\n" + "-type t() :: {#r{},#s{}}.\n">>, + ?line ok = file:write_file(FileName, C), + ?line {error,[{_,[{3,erl_parse,["syntax error before: ","')'"]}]}],_} = + compile:file(FileName, [return]), + + F = <<"-module(otp_8567).\n" + "-compile(export_all).\n" + "-record(t, {a}).\n" + "-record(u, {a :: integer()}).\n" + "-opaque ot() :: {#t{}, #u{}}.\n" + "-opaque(ot1() :: atom()).\n" + "-type a() :: integer().\n" + "-spec t() -> a().\n" + "t() ->\n" + " 3.\n" + "\n" + "-spec(t1/1 :: (ot()) -> ot1()).\n" + "t1(A) ->\n" + " A.\n" + "\n" + "-spec(t2 (ot()) -> ot1()).\n" + "t2(A) ->\n" + " A.\n" + "\n" + "-spec(otp_8567:t3/1 :: (ot()) -> ot1()).\n" + "t3(A) ->\n" + " A.\n" + "\n" + "-spec(otp_8567:t4 (ot()) -> ot1()).\n" + "t4(A) ->\n" + " A.\n">>, + ?line ok = pp_forms(F), + + ok. + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% compile(Config, Tests) -> F = fun({N,P}, BadL) -> case catch compile_file(Config, P) of - ok -> + ok -> case pp_forms(P) of ok -> BadL; @@ -935,8 +1008,8 @@ compile(Config, Tests) -> ?t:format("~nTest ~p failed.~n", [N]), fail() end; - Bad -> - ?t:format("~nTest ~p failed. got~n ~p~n", + Bad -> + ?t:format("~nTest ~p failed. got~n ~p~n", [N, Bad]), fail() end @@ -966,7 +1039,7 @@ compile_file(Config, Test0) -> Error -> Error end. - + compile_file(Config, Test0, Opts0) -> FileName = filename('erl_pp_test.erl', Config), Test = list_to_binary(["-module(erl_pp_test). " @@ -975,7 +1048,7 @@ compile_file(Config, Test0, Opts0) -> Opts = [export_all,return,nowarn_unused_record,{outdir,?privdir} | Opts0], ok = file:write_file(FileName, Test), case compile:file(FileName, Opts) of - {ok, _M, _Ws} -> + {ok, _M, _Ws} -> {ok, filename:rootname(FileName)}; Error -> Error end. @@ -1002,7 +1075,7 @@ pp_forms(Bin, Hook) -> end. parse_and_pp_forms(String, Hook) -> - lists:append(lists:map(fun(AF) -> erl_pp:form(AF, Hook) + lists:append(lists:map(fun(AF) -> erl_pp:form(AF, Hook) end, parse_forms(String))). parse_forms(Chars) -> @@ -1010,13 +1083,13 @@ parse_forms(Chars) -> parse_forms2(String, [], 1, []). parse_forms2([], _Cont, _Line, Forms) -> - lists:reverse(Forms); + lists:reverse(Forms); parse_forms2(String, Cont0, Line, Forms) -> case erl_scan:tokens(Cont0, String, Line) of {done, {ok, Tokens, EndLine}, Chars} -> {ok, Form} = erl_parse:parse_form(Tokens), parse_forms2(Chars, [], EndLine, [Form | Forms]); - {more, Cont} when element(3, Cont) =:= [] -> + {more, Cont} when element(3, Cont) =:= [] -> %% extra spaces after forms... parse_forms2([], Cont, Line, Forms); {more, Cont} -> @@ -1034,10 +1107,10 @@ pp_expr(Bin, Hook) -> PP2 = (catch parse_and_pp_expr(PPneg, 0, Hook)), if PP1 =:= PP2 -> % same line numbers - case + case (test_max_line(PP1) =:= ok) and (test_new_line(PPneg) =:= ok) of - true -> + true -> ok; false -> not_ok @@ -1070,7 +1143,7 @@ test_max_line(String) -> end. max_line(String) -> - lists:max([0 | [length(Sub) || + lists:max([0 | [length(Sub) || Sub <- string:tokens(String, "\n"), string:substr(Sub, 1, 5) =/= "-file"]]). diff --git a/lib/stdlib/test/erl_scan_SUITE.erl b/lib/stdlib/test/erl_scan_SUITE.erl index 32a06d15c7..afeb67eeb1 100644 --- a/lib/stdlib/test/erl_scan_SUITE.erl +++ b/lib/stdlib/test/erl_scan_SUITE.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1998-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% -module(erl_scan_SUITE). @@ -34,7 +34,7 @@ -define(line, put(line, ?LINE), ). -define(config(A,B),config(A,B)). -define(t, test_server). -%% config(priv_dir, _) -> +%% config(priv_dir, _) -> %% "."; %% config(data_dir, _) -> %% ".". @@ -45,7 +45,7 @@ init_per_testcase(_Case, Config) when is_list(Config) -> ?line Dog=test_server:timetrap(test_server:seconds(1200)), [{watchdog, Dog}|Config]. - + fin_per_testcase(_Case, Config) -> Dog=?config(watchdog, Config), test_server:timetrap_cancel(Dog), @@ -97,7 +97,7 @@ assert_type(N, integer) when is_integer(N) -> ok; assert_type(N, atom) when is_atom(N) -> ok. - + check(String) -> Error = erl_scan:string(String), check_error(Error, erl_scan). @@ -146,7 +146,7 @@ iso88591(Config) when is_list(Config) -> ok -> ok %Aok end. -otp_7810(doc) -> +otp_7810(doc) -> ["OTP-7810. White spaces, comments, and more.."]; otp_7810(suite) -> []; @@ -185,7 +185,7 @@ reserved_words() -> 'andalso', 'orelse', 'end', 'fun', 'if', 'let', 'of', 'query', 'receive', 'when', 'bnot', 'not', 'div', 'rem', 'band', 'and', 'bor', 'bxor', 'bsl', 'bsr', - 'or', 'xor', 'spec'] , % 'spec' shouldn't be there... + 'or', 'xor'] , [begin ?line {RW, true} = {RW, erl_scan:reserved_word(RW)}, S = atom_to_list(RW), @@ -203,7 +203,7 @@ atoms() -> ?line test_string("a@2", [{atom,1,a@2}]), ?line test_string([39,65,200,39], [{atom,1,'A�'}]), ?line test_string("�rlig �sten", [{atom,1,�rlig},{atom,1,�sten}]), - ?line {ok,[{atom,_,'$a'}],{1,6}} = + ?line {ok,[{atom,_,'$a'}],{1,6}} = erl_scan:string("'$\\a'", {1,1}), ?line test("'$\\a'"), ok. @@ -221,8 +221,8 @@ punctuations() -> Three = ["/=:=", "<=:=", "==:=", ">=:="], % three tokens... No = Three ++ L, SL0 = [{S1++S2,{-length(S1),S1,S2}} || - S1 <- L, - S2 <- L, + S1 <- L, + S2 <- L, not lists:member(S1++S2, No)], SL = family_list(SL0), %% Two tokens. When there are several answers, the one with @@ -250,15 +250,15 @@ comments() -> ?line test("a %%\n b"), ?line {ok,[],1} = erl_scan:string("%"), ?line test("a %%\n b"), - ?line {ok,[{atom,_,a},{atom,_,b}],{2,3}} = + ?line {ok,[{atom,_,a},{atom,_,b}],{2,3}} = erl_scan:string("a %%\n b",{1,1}), - ?line {ok,[{atom,_,a},{comment,_,"%%"},{atom,_,b}],{2,3}} = + ?line {ok,[{atom,_,a},{comment,_,"%%"},{atom,_,b}],{2,3}} = erl_scan:string("a %%\n b",{1,1}, [return_comments]), ?line {ok,[{atom,_,a}, {white_space,_," "}, {white_space,_,"\n "}, {atom,_,b}], - {2,3}} = + {2,3}} = erl_scan:string("a %%\n b",{1,1},[return_white_spaces]), ?line {ok,[{atom,_,a}, {white_space,_," "}, @@ -275,14 +275,14 @@ errors() -> ?line {error,{1,erl_scan,char},1} = erl_scan:string("$"), ?line test_string([34,65,200,34], [{string,1,"A�"}]), ?line test_string("\\", [{'\\',1}]), - ?line {'EXIT',_} = + ?line {'EXIT',_} = (catch {foo, erl_scan:string('$\\a', {1,1})}), % type error - ?line {'EXIT',_} = + ?line {'EXIT',_} = (catch {foo, erl_scan:tokens([], '$\\a', {1,1})}), % type error ?line "{a,tuple}" = erl_scan:format_error({a,tuple}), ok. - + integers() -> [begin I = list_to_integer(S), @@ -299,14 +299,14 @@ base_integers() -> ?line test_string(BS++"#"++S, Ts) end || {BS,S} <- [{"2","11"}, {"5","23234"}, {"12","05a"}, {"16","abcdef"}, {"16","ABCDEF"}] ], - + ?line {error,{1,erl_scan,{base,1}},1} = erl_scan:string("1#000"), - + ?line test_string("12#bc", [{integer,1,11},{atom,1,c}]), - + [begin Str = BS ++ "#" ++ S, - ?line {error,{1,erl_scan,{illegal,integer}},1} = + ?line {error,{1,erl_scan,{illegal,integer}},1} = erl_scan:string(Str) end || {BS,S} <- [{"3","3"},{"15","f"}, {"12","c"}] ], @@ -323,8 +323,8 @@ floats() -> end || FS <- ["1.0","001.17","3.31200","1.0e0","1.0E17", "34.21E-18", "17.0E+14"]], ?line test_string("1.e2", [{integer,1,1},{'.',1},{atom,1,e2}]), - - ?line {error,{1,erl_scan,{illegal,float}},1} = + + ?line {error,{1,erl_scan,{illegal,float}},1} = erl_scan:string("1.0e400"), [begin ?line {error,{1,erl_scan,{illegal,float}},1} = erl_scan:string(S) @@ -345,16 +345,16 @@ dots() -> {".a", {ok,[{'.',1},{atom,1,a}],1}} ], ?line [R = erl_scan:string(S) || {S, R} <- Dot], - + ?line {ok,[{dot,_}=T1],{1,2}} = erl_scan:string(".", {1,1}, text), - ?line [{column,1},{length,1},{line,1},{text,"."}] = + ?line [{column,1},{length,1},{line,1},{text,"."}] = erl_scan:token_info(T1, [column, length, line, text]), ?line {ok,[{dot,_}=T2],{1,3}} = erl_scan:string(".%", {1,1}, text), - ?line [{column,1},{length,1},{line,1},{text,"."}] = + ?line [{column,1},{length,1},{line,1},{text,"."}] = erl_scan:token_info(T2, [column, length, line, text]), ?line {ok,[{dot,_}=T3],{1,6}} = erl_scan:string(".% �h", {1,1}, text), - ?line [{column,1},{length,1},{line,1},{text,"."}] = + ?line [{column,1},{length,1},{line,1},{text,"."}] = erl_scan:token_info(T3, [column, length, line, text]), ?line {error,{{1,2},erl_scan,char},{1,3}} = erl_scan:string(".$", {1,1}), @@ -376,10 +376,10 @@ dots() -> ?line {done,{ok,[{comment,_,"%. "}, {white_space,_,"\n"}, {dot,_}], - {2,3}}, ""} = + {2,3}}, ""} = erl_scan:tokens(C, "\n. ", {1,1}, return), % any loc, any options - ?line [test_string(S, R) || + ?line [test_string(S, R) || {S, R} <- [{".$\n", [{'.',1},{char,1,$\n}]}, {"$\\\n", [{char,1,$\n}]}, {"'\\\n'", [{atom,1,'\n'}]}, @@ -392,7 +392,7 @@ chars() -> Ts = [{char,1,C}], ?line test_string(L, Ts) end || C <- lists:seq(0, 255)], - + %% Leading zeroes... [begin L = lists:flatten(io_lib:format("$\\~3.8.0b", [C])), @@ -406,13 +406,13 @@ chars() -> Ts = [{char,1,C band 2#11111}], ?line test_string(L, Ts) end || C <- lists:seq(0, 255)], - + [begin L = "$\\" ++ [C], Ts = [{char,1,V}], ?line test_string(L, Ts) - end || {C,V} <- [{$n,$\n}, {$r,$\r}, {$t,$\t}, {$v,$\v}, - {$b,$\b}, {$f,$\f}, {$e,$\e}, {$s,$\s}, + end || {C,V} <- [{$n,$\n}, {$r,$\r}, {$t,$\t}, {$v,$\v}, + {$b,$\b}, {$f,$\f}, {$e,$\e}, {$s,$\s}, {$d,$\d}]], EC = [$\n,$\r,$\t,$\v,$\b,$\f,$\e,$\s,$\d], @@ -445,7 +445,7 @@ chars() -> end || C <- lists:seq(0, 255) -- (No ++ [$\\])], ?line test_string("$\n", [{char,1,$\n}]), - ?line {error,{{1,1},erl_scan,char},{1,4}} = + ?line {error,{{1,1},erl_scan,char},{1,4}} = erl_scan:string("$\\^",{1,1}), ?line test_string("$\\\n", [{char,1,$\n}]), %% Robert's scanner returns line 1: @@ -453,7 +453,7 @@ chars() -> ?line test_string("$\n\n", [{char,1,$\n}]), ?line test("$\n\n"), ok. - + variables() -> ?line test_string(" \237_Aou�eiy��", [{var,1,'_Aou�eiy��'}]), @@ -469,8 +469,8 @@ eof() -> ?line {done,{eof,2},eof} = erl_scan:tokens(C1, eof, 1), {more, C2} = erl_scan:tokens([], "abra", 1), %% An error before R13A. - %% ?line {done,Err={error,{1,erl_scan,scan},1},eof} = - ?line {done,{ok,[{atom,1,abra}],1},eof} = + %% ?line {done,Err={error,{1,erl_scan,scan},1},eof} = + ?line {done,{ok,[{atom,1,abra}],1},eof} = erl_scan:tokens(C2, eof, 1), %% With column. @@ -478,7 +478,7 @@ eof() -> ?line {done,{eof,{2,1}},eof} = erl_scan:tokens(C3, eof, 1), {more, C4} = erl_scan:tokens([], "abra", {1,1}), %% An error before R13A. - %% ?line {done,{error,{{1,1},erl_scan,scan},{1,5}},eof} = + %% ?line {done,{error,{{1,1},erl_scan,scan},{1,5}},eof} = ?line {done,{ok,[{atom,_,abra}],{1,5}},eof} = erl_scan:tokens(C4, eof, 1), @@ -486,7 +486,7 @@ eof() -> %% the R12B scanner returns eof as LeftoverChars: (eof is correct) ?line {more, C5} = erl_scan:tokens([], "a", 1), %% An error before R13A. - %% ?line {done,{error,{1,erl_scan,scan},1},eof} = + %% ?line {done,{error,{1,erl_scan,scan},1},eof} = ?line {done,{ok,[{atom,1,a}],1},eof} = erl_scan:tokens(C5,eof,1), @@ -528,7 +528,7 @@ illegal() -> erl_scan:tokens([], "foo "++Atom++". ", {1,1}), ?line {error,{{1,1},erl_scan,{illegal,atom}},{1,1003}} = erl_scan:string(QAtom, {1,1}), - ?line {done,{error,{{1,5},erl_scan,{illegal,atom}},{1,1007}},". "} = + ?line {done,{error,{{1,5},erl_scan,{illegal,atom}},{1,1007}},". "} = erl_scan:tokens([], "foo "++QAtom++". ", {1,1}), ?line {error,{{1,1},erl_scan,{illegal,var}},{1,1001}} = erl_scan:string(Var, {1,1}), @@ -553,7 +553,7 @@ crashes() -> ?line {'EXIT',_} = (catch {foo, erl_scan:string("\"\\v"++[-1,$"])}), %$" ?line {'EXIT',_} = (catch {foo, erl_scan:string([$",-1,$"])}), ?line {'EXIT',_} = (catch {foo, erl_scan:string("% foo"++[-1])}), - ?line {'EXIT',_} = + ?line {'EXIT',_} = (catch {foo, erl_scan:string("% foo"++[-1],{1,1})}), ?line {'EXIT',_} = (catch {foo, erl_scan:string([a])}), % type error @@ -564,7 +564,7 @@ crashes() -> ?line {'EXIT',_} = (catch {foo, erl_scan:string("\"\\v"++[a,$"])}), %$" ?line {'EXIT',_} = (catch {foo, erl_scan:string([$",a,$"])}), ?line {'EXIT',_} = (catch {foo, erl_scan:string("% foo"++[a])}), - ?line {'EXIT',_} = + ?line {'EXIT',_} = (catch {foo, erl_scan:string("% foo"++[a],{1,1})}), ?line {'EXIT',_} = (catch {foo, erl_scan:string([3.0])}), % type error @@ -573,26 +573,26 @@ crashes() -> options() -> %% line and column are not options, but tested here - ?line {ok,[{atom,1,foo},{white_space,1," "},{comment,1,"% bar"}], 1} = + ?line {ok,[{atom,1,foo},{white_space,1," "},{comment,1,"% bar"}], 1} = erl_scan:string("foo % bar", 1, return), - ?line {ok,[{atom,1,foo},{white_space,1," "}],1} = + ?line {ok,[{atom,1,foo},{white_space,1," "}],1} = erl_scan:string("foo % bar", 1, return_white_spaces), - ?line {ok,[{atom,1,foo},{comment,1,"% bar"}],1} = + ?line {ok,[{atom,1,foo},{comment,1,"% bar"}],1} = erl_scan:string("foo % bar", 1, return_comments), - ?line {ok,[{atom,17,foo}],17} = + ?line {ok,[{atom,17,foo}],17} = erl_scan:string("foo % bar", 17), - ?line {'EXIT',{function_clause,_}} = - (catch {foo, + ?line {'EXIT',{function_clause,_}} = + (catch {foo, erl_scan:string("foo % bar", {a,1}, [])}), % type error - ?line {ok,[{atom,_,foo}],{17,18}} = + ?line {ok,[{atom,_,foo}],{17,18}} = erl_scan:string("foo % bar", {17,9}, []), - ?line {'EXIT',{function_clause,_}} = + ?line {'EXIT',{function_clause,_}} = (catch {foo, erl_scan:string("foo % bar", {1,0}, [])}), % type error - ?line {ok,[{foo,1}],1} = + ?line {ok,[{foo,1}],1} = erl_scan:string("foo % bar",1, [{reserved_word_fun, fun(W) -> W =:= foo end}]), - ?line {'EXIT',{badarg,_}} = + ?line {'EXIT',{badarg,_}} = (catch {foo, erl_scan:string("foo % bar",1, % type error [{reserved_word_fun, @@ -618,14 +618,14 @@ more_options() -> token_info() -> ?line {ok,[T1],_} = erl_scan:string("foo", {1,18}, [text]), - {'EXIT',{badarg,_}} = + {'EXIT',{badarg,_}} = (catch {foo, erl_scan:token_info(T1, foo)}), % type error ?line {line,1} = erl_scan:token_info(T1, line), ?line {column,18} = erl_scan:token_info(T1, column), ?line {length,3} = erl_scan:token_info(T1, length), ?line {text,"foo"} = erl_scan:token_info(T1, text), ?line [{category,atom},{column,18},{length,3},{line,1}, - {symbol,foo},{text,"foo"}] = + {symbol,foo},{text,"foo"}] = erl_scan:token_info(T1), ?line [{length,3},{column,18}] = erl_scan:token_info(T1, [length, column]), @@ -648,9 +648,9 @@ token_info() -> ?line {category,'='} = erl_scan:token_info(T3, category), ?line [{symbol,'='}] = erl_scan:token_info(T3, [symbol]), ok. - + attributes_info() -> - ?line {'EXIT',_} = + ?line {'EXIT',_} = (catch {foo,erl_scan:attributes_info(foo)}), % type error ?line [{line,18}] = erl_scan:attributes_info(18), ?line {location,19} = erl_scan:attributes_info(19, location), @@ -717,9 +717,9 @@ set_attribute() -> ?line [{line,{17,11}},{text,"foo"}] = erl_scan:attributes_info(A7, [line,column,text]), - ?line {'EXIT',_} = + ?line {'EXIT',_} = (catch {foo, erl_scan:set_attribute(line, [], F2)}), % type error - ?line {'EXIT',{badarg,_}} = + ?line {'EXIT',{badarg,_}} = (catch {foo, erl_scan:set_attribute(column, [], F2)}), % type error ok. @@ -790,14 +790,14 @@ unicode() -> ?line {ok,[{char,1,83},{integer,1,45}],1} = erl_scan:string("$\\12345"), % not unicode - ?line {error,{1,erl_scan,{illegal,character}},1} = + ?line {error,{1,erl_scan,{illegal,character}},1} = erl_scan:string([1089]), - ?line {error,{{1,1},erl_scan,{illegal,character}},{1,2}} = + ?line {error,{{1,1},erl_scan,{illegal,character}},{1,2}} = erl_scan:string([1089], {1,1}), ?line {error,{1,erl_scan,{illegal,character}},1} = - %% ?line {error,{1,erl_scan,{illegal,atom}},1} = + %% ?line {error,{1,erl_scan,{illegal,atom}},1} = erl_scan:string("'a"++[1089]++"b'"), - ?line {error,{{1,3},erl_scan,{illegal,character}},{1,4}} = + ?line {error,{{1,3},erl_scan,{illegal,character}},{1,4}} = erl_scan:string("'a"++[1089]++"b'", {1,1}), ?line test("\"a"++[1089]++"b\""), ?line {ok,[{char,1,1}],1} = erl_scan:string([$$,$\\,$^,1089]), @@ -822,7 +822,7 @@ unicode() -> ?line {ok,[{integer,1,16#aaa}],1} = erl_scan:string(Qs), ?line {ok,[Q2],{1,9}} = erl_scan:string("$\\x{aaa}", {1,1}, text), ?line [{category,integer},{column,1},{length,8}, - {line,1},{symbol,16#aaa},{text,Qs}] = + {line,1},{symbol,16#aaa},{text,Qs}] = erl_scan:token_info(Q2), U1 = "\"\\x{aaa}\"", @@ -830,11 +830,11 @@ unicode() -> ?line [{category,'['},{column,1},{length,1},{line,1}, {symbol,'['},{text,"\""}] = erl_scan:token_info(T1, Tags), ?line [{category,integer},{column,2},{length,7}, - {line,1},{symbol,16#aaa},{text,"\\x{aaa}"}] = + {line,1},{symbol,16#aaa},{text,"\\x{aaa}"}] = erl_scan:token_info(T2, Tags), ?line [{category,']'},{column,9},{length,1},{line,1}, {symbol,']'},{text,"\""}] = erl_scan:token_info(T3, Tags), - ?line {ok,[{'[',1},{integer,1,16#aaa},{']',1}],1} = + ?line {ok,[{'[',1},{integer,1,16#aaa},{']',1}],1} = erl_scan:string(U1, 1), U2 = "\"\\x41\\x{fff}\\x42\"", @@ -844,7 +844,7 @@ unicode() -> U3 = "\"a\n\\x{fff}\n\"", ?line {ok,[{'[',1},{char,1,$a},{',',1},{char,1,$\n}, {',',2},{integer,2,16#fff},{',',2},{char,2,$\n}, - {']',3}],3} = + {']',3}],3} = erl_scan:string(U3, 1), U4 = "\"\\^\n\\x{aaa}\\^\n\"", @@ -867,10 +867,10 @@ unicode() -> {char,_,$d},{']',_}],{1,8}} = erl_scan:string(Str1, {1,1}), ?line test(Str1), Comment = "%% "++[1089], - ?line {ok,[{comment,1,[$%,$%,$\s,1089]}],1} = + ?line {ok,[{comment,1,[$%,$%,$\s,1089]}],1} = erl_scan:string(Comment, 1, return), - ?line {ok,[{comment,_,[$%,$%,$\s,1089]}],{1,5}} = - erl_scan:string(Comment, {1,1}, return), + ?line {ok,[{comment,_,[$%,$%,$\s,1089]}],{1,5}} = + erl_scan:string(Comment, {1,1}, return), ok. more_chars() -> @@ -885,7 +885,7 @@ more_chars() -> erl_scan:tokens(C1, eof, 1), ?line {ok,[{char,1,123},{atom,1,a},{'}',1}],1} = erl_scan:string("$\\{a}"), - + ?line {error,{{1,1},erl_scan,char},{1,4}} = erl_scan:string("$\\x", {1,1}), ?line {error,{{1,1},erl_scan,char},{1,5}} = @@ -893,12 +893,12 @@ more_chars() -> ?line {more, C3} = erl_scan:tokens([], "$\\x", {1,1}), ?line {done,{error,{{1,1},erl_scan,char},{1,4}},eof} = erl_scan:tokens(C3, eof, 1), - ?line {error,{{1,1},erl_scan,char},{1,5}} = + ?line {error,{{1,1},erl_scan,char},{1,5}} = erl_scan:string("$\\x{",{1,1}), ?line {more, C2} = erl_scan:tokens([], "$\\x{", {1,1}), - ?line {done,{error,{{1,1},erl_scan,char},{1,5}},eof} = + ?line {done,{error,{{1,1},erl_scan,char},{1,5}},eof} = erl_scan:tokens(C2, eof, 1), - ?line {error,{1,erl_scan,{illegal,character}},1} = + ?line {error,{1,erl_scan,{illegal,character}},1} = erl_scan:string("$\\x{g}"), ?line {error,{{1,1},erl_scan,{illegal,character}},{1,5}} = erl_scan:string("$\\x{g}", {1,1}), @@ -924,12 +924,12 @@ more_chars() -> ?line test("$\\x{10FFFF}"), ?line test("$\\x{10ffff}"), ?line test("\"$\n \\{1}\""), - ?line {error,{1,erl_scan,{illegal,character}},1} = + ?line {error,{1,erl_scan,{illegal,character}},1} = erl_scan:string("$\\x{110000}"), - ?line {error,{{1,1},erl_scan,{illegal,character}},{1,12}} = + ?line {error,{{1,1},erl_scan,{illegal,character}},{1,12}} = erl_scan:string("$\\x{110000}", {1,1}), - ?line {error,{{1,1},erl_scan,{illegal,character}},{1,4}} = + ?line {error,{{1,1},erl_scan,{illegal,character}},{1,4}} = erl_scan:string("$\\xfg", {1,1}), ?line test("$\\xffg"), @@ -953,11 +953,11 @@ test(String) -> {Wtokens, Wend}, {Ctokens, Cend}, {CWtokens, CWend}, - {CWtokens2, _}] = + {CWtokens2, _}] = [scan_string_with_column(String, X) || - X <- [[], - [return_white_spaces], - [return_comments], + X <- [[], + [return_white_spaces], + [return_comments], [return], [return]]], % for white space compaction test @@ -969,7 +969,7 @@ test(String) -> {none,Tokens} = {none, filter_tokens(CWtokens, [white_space,comment])}, {comments,Ctokens} = {comments,filter_tokens(CWtokens, [white_space])}, - {white_spaces,Wtokens} = + {white_spaces,Wtokens} = {white_spaces,filter_tokens(CWtokens, [comment])}, %% Use token attributes to extract parts from the original string, @@ -991,9 +991,9 @@ test(String) -> %% Line attribute only: [Simple,Wsimple,Csimple,WCsimple] = Simples = [element(2, erl_scan:string(String, 1, Opts)) || - Opts <- [[], - [return_white_spaces], - [return_comments], + Opts <- [[], + [return_white_spaces], + [return_comments], [return]]], {consistent,true} = {consistent,consistent_attributes(Simples)}, {simple_wc,WCsimple} = {simple_wc,simplify(CWtokens)}, @@ -1004,19 +1004,19 @@ test(String) -> %% Line attribute only, with text: [SimpleTxt,WsimpleTxt,CsimpleTxt,WCsimpleTxt] = SimplesTxt = [element(2, erl_scan:string(String, 1, [text|Opts])) || - Opts <- [[], - [return_white_spaces], - [return_comments], + Opts <- [[], + [return_white_spaces], + [return_comments], [return]]], TextTxt = get_text(WCsimpleTxt), {text_txt,TextTxt,String} = {text_txt,String,TextTxt}, - {consistent_txt,true} = + {consistent_txt,true} = {consistent_txt,consistent_attributes(SimplesTxt)}, - {simple_txt,SimpleTxt} = + {simple_txt,SimpleTxt} = {simple_txt,filter_tokens(WCsimpleTxt, [white_space,comment])}, - {simple_c_txt,CsimpleTxt} = + {simple_c_txt,CsimpleTxt} = {simple_c_txt,filter_tokens(WCsimpleTxt, [white_space])}, - {simple_w_txt,WsimpleTxt} = + {simple_w_txt,WsimpleTxt} = {simple_w_txt,filter_tokens(WCsimpleTxt, [comment])}, ok. @@ -1024,18 +1024,18 @@ test(String) -> test_white_space_compaction(Tokens, Tokens2) when Tokens =:= Tokens2 -> [WS, WS2] = [select_tokens(Ts, [white_space]) || Ts <- [Tokens, Tokens2]], test_wsc(WS, WS2). - + test_wsc([], []) -> ok; test_wsc([Token|Tokens], [Token2|Tokens2]) -> - [Text, Text2] = [Text || - {text, Text} <- + [Text, Text2] = [Text || + {text, Text} <- [erl_scan:token_info(T, text) || T <- [Token, Token2]]], Sz = erts_debug:size(Text), Sz2 = erts_debug:size({Text, Text2}), IsCompacted = Sz2 < 2*Sz+erts_debug:size({a,a}), - ToBeCompacted = is_compacted(Text), + ToBeCompacted = is_compacted(Text), if IsCompacted =:= ToBeCompacted -> test_wsc(Tokens, Tokens2); @@ -1050,14 +1050,14 @@ is_compacted("\n\r") -> is_compacted("\n\f") -> true; is_compacted([$\n|String]) -> - all_spaces(String) + all_spaces(String) orelse all_tabs(String); is_compacted(String) -> all_spaces(String) orelse all_tabs(String). - + all_spaces(L) -> all_same(L, $\s). @@ -1078,7 +1078,7 @@ newlines_first([Token|Tokens]) -> _ -> Nnls =:= 0 end, - if + if OK -> newlines_first(Tokens); true -> OK end. @@ -1097,7 +1097,7 @@ simplify([]) -> get_text(Tokens) -> lists:flatten( - [T || + [T || Token <- Tokens, ({text,T} = erl_scan:token_info(Token, text)) =/= []]). @@ -1108,7 +1108,7 @@ test_decorated_tokens(String, Tokens) -> token_attrs(Tokens) -> [{L,C,Len,T} || Token <- Tokens, - ([{line,L},{column,C},{length,Len},{text,T}] = + ([{line,L},{column,C},{length,Len},{text,T}] = erl_scan:token_info(Token, [line,column,length,text])) =/= []]. test_strings([], _S, Line, Column) -> @@ -1150,7 +1150,7 @@ scan_string_with_column(String, Options0) -> {ok, Ts1, End1} = erl_scan:string(String, StartLoc, Options), TString = String ++ ". ", {ok,Ts2,End2} = scan_tokens(TString, Options, [], StartLoc), - {ok, Ts3, End3} = + {ok, Ts3, End3} = scan_tokens_1({more, []}, TString, Options, [], StartLoc), {end_2,End2,End3} = {end_2,End3,End2}, {EndLine1,EndColumn1} = End1, @@ -1190,8 +1190,8 @@ consistent_attributes([Ts | TsL]) -> L = [T || T <- Ts, is_integer(element(2, T))], case L of [] -> - TagsL = [[Tag || {Tag,_} <- - erl_scan:attributes_info(element(2, T))] || + TagsL = [[Tag || {Tag,_} <- + erl_scan:attributes_info(element(2, T))] || T <- Ts], case lists:usort(TagsL) of [_] -> diff --git a/lib/stdlib/test/escript_SUITE.erl b/lib/stdlib/test/escript_SUITE.erl index 70aae54d62..77fd190e45 100644 --- a/lib/stdlib/test/escript_SUITE.erl +++ b/lib/stdlib/test/escript_SUITE.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2007-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2007-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% -module(escript_SUITE). @@ -22,16 +22,20 @@ init_per_testcase/2, fin_per_testcase/2, basic/1, - errors/1, + errors/1, strange_name/1, emulator_flags/1, module_script/1, beam_script/1, archive_script/1, - epp/1 + epp/1, + create_and_extract/1, + foldl/1, + verify_sections/3 ]). -include("test_server.hrl"). +-include_lib("kernel/include/file.hrl"). all(suite) -> [ @@ -42,7 +46,9 @@ all(suite) -> module_script, beam_script, archive_script, - epp + epp, + create_and_extract, + foldl ]. init_per_testcase(_Case, Config) -> @@ -68,11 +74,11 @@ basic(Config) when is_list(Config) -> ?line run(Dir, "factorial_warning 20", [data_dir,<<"factorial_warning:12: Warning: function bar/0 is unused\n" "factorial 20 = 2432902008176640000\nExitCode:0">>]), - ?line run(Dir, "-s", "factorial_warning", + ?line run_with_opts(Dir, "-s", "factorial_warning", [data_dir,<<"factorial_warning:12: Warning: function bar/0 is unused\nExitCode:0">>]), - ?line run(Dir, "-s -i", "factorial_warning", + ?line run_with_opts(Dir, "-s -i", "factorial_warning", [data_dir,<<"factorial_warning:12: Warning: function bar/0 is unused\nExitCode:0">>]), - ?line run(Dir, "-c -s", "factorial_warning", + ?line run_with_opts(Dir, "-c -s", "factorial_warning", [data_dir,<<"factorial_warning:12: Warning: function bar/0 is unused\nExitCode:0">>]), ?line run(Dir, "filesize "++filename:join(?config(data_dir, Config),"filesize"), [data_dir,<<"filesize:11: Warning: function id/1 is unused\n324\nExitCode:0">>]), @@ -100,7 +106,7 @@ errors(Config) when is_list(Config) -> [data_dir,<<"lint_error:6: function main/1 already defined\n">>, data_dir,"lint_error:8: variable 'ExitCode' is unbound\n", <<"escript: There were compilation errors.\nExitCode:127">>]), - ?line run(Dir, "-s", "lint_error", + ?line run_with_opts(Dir, "-s", "lint_error", [data_dir,<<"lint_error:6: function main/1 already defined\n">>, data_dir,"lint_error:8: variable 'ExitCode' is unbound\n", <<"escript: There were compilation errors.\nExitCode:127">>]), @@ -140,31 +146,31 @@ module_script(Config) when is_list(Config) -> OrigFile = filename:join([Data,"emulator_flags"]), {ok, OrigBin} = file:read_file(OrigFile), ?line [Shebang, Mode, Flags | Source] = string:tokens(binary_to_list(OrigBin), "\n"), - ?line {ok, OrigFI} = file:read_file_info(OrigFile), + ?line {ok, OrigFI} = file:read_file_info(OrigFile), %% Write source file Priv = ?config(priv_dir, Config), Dir = filename:absname(Priv), % Get rid of trailing slash. Base = "module_script", ErlFile = filename:join([Priv, Base ++ ".erl"]), - ErlCode = ["-module(", Base, ").\n", + ErlCode = ["\n-module(", Base, ").\n", "-export([main/1]).\n\n", string:join(Source, "\n"), "\n"], ?line ok = file:write_file(ErlFile, ErlCode), - + %%%%%%% %% Create and run scripts without emulator flags %% With shebang NoArgsBase = Base ++ "_no_args_with_shebang", NoArgsFile = filename:join([Priv, NoArgsBase]), - ?line ok = file:write_file(NoArgsFile, + ?line ok = file:write_file(NoArgsFile, [Shebang, "\n", ErlCode]), ?line ok = file:write_file_info(NoArgsFile, OrigFI), - - ?line run(Dir, NoArgsBase ++ " -arg1 arg2 arg3", + + ?line run(Dir, NoArgsBase ++ " -arg1 arg2 arg3", [<<"main:[\"-arg1\",\"arg2\",\"arg3\"]\n" "nostick:[]\n" "mnesia:[]\n" @@ -172,7 +178,7 @@ module_script(Config) when is_list(Config) -> "unknown:[]\n" "ExitCode:0">>]), - ?line run(Dir, "", NoArgsBase ++ " -arg1 arg2 arg3", + ?line run_with_opts(Dir, "", NoArgsBase ++ " -arg1 arg2 arg3", [<<"main:[\"-arg1\",\"arg2\",\"arg3\"]\n" "nostick:[]\n" "mnesia:[]\n" @@ -183,33 +189,33 @@ module_script(Config) when is_list(Config) -> %% Without shebang NoArgsBase2 = Base ++ "_no_args_without_shebang", NoArgsFile2 = filename:join([Priv, NoArgsBase2]), - ?line ok = file:write_file(NoArgsFile2, + ?line ok = file:write_file(NoArgsFile2, ["Something else than shebang!!!", "\n", ErlCode]), ?line ok = file:write_file_info(NoArgsFile2, OrigFI), - - ?line run(Dir, "", NoArgsBase2 ++ " -arg1 arg2 arg3", + + ?line run_with_opts(Dir, "", NoArgsBase2 ++ " -arg1 arg2 arg3", [<<"main:[\"-arg1\",\"arg2\",\"arg3\"]\n" "nostick:[]\n" "mnesia:[]\n" "ERL_FLAGS=false\n" "unknown:[]\n" "ExitCode:0">>]), - + %% Plain module without header NoArgsBase3 = Base ++ "_no_args_without_header", NoArgsFile3 = filename:join([Priv, NoArgsBase3]), ?line ok = file:write_file(NoArgsFile3, [ErlCode]), ?line ok = file:write_file_info(NoArgsFile3, OrigFI), - - ?line run(Dir, "", NoArgsBase3 ++ " -arg1 arg2 arg3", + + ?line run_with_opts(Dir, "", NoArgsBase3 ++ " -arg1 arg2 arg3", [<<"main:[\"-arg1\",\"arg2\",\"arg3\"]\n" "nostick:[]\n" "mnesia:[]\n" "ERL_FLAGS=false\n" "unknown:[]\n" "ExitCode:0">>]), - + %%%%%%% %% Create and run scripts with emulator flags @@ -217,12 +223,12 @@ module_script(Config) when is_list(Config) -> ArgsBase = Base ++ "_args_with_shebang", ArgsFile = filename:join([Priv, ArgsBase]), ?line ok = file:write_file(ArgsFile, - [Shebang, "\n", + [Shebang, "\n", Mode, "\n", Flags, "\n", ErlCode]), - ?line ok = file:write_file_info(ArgsFile, OrigFI), - + ?line ok = file:write_file_info(ArgsFile, OrigFI), + ?line run(Dir, ArgsBase ++ " -arg1 arg2 arg3", [<<"main:[\"-arg1\",\"arg2\",\"arg3\"]\n" "nostick:[{nostick,[]}]\n" @@ -242,32 +248,32 @@ beam_script(Config) when is_list(Config) -> OrigFile = filename:join([Data,"emulator_flags"]), {ok, OrigBin} = file:read_file(OrigFile), ?line [Shebang, Mode, Flags | Source] = string:tokens(binary_to_list(OrigBin), "\n"), - ?line {ok, OrigFI} = file:read_file_info(OrigFile), + ?line {ok, OrigFI} = file:read_file_info(OrigFile), %% Write source file Priv = ?config(priv_dir, Config), Dir = filename:absname(Priv), % Get rid of trailing slash. Base = "beam_script", ErlFile = filename:join([Priv, Base ++ ".erl"]), - ?line ok = file:write_file(ErlFile, - ["-module(", Base, ").\n", + ?line ok = file:write_file(ErlFile, + ["\n-module(", Base, ").\n", "-export([main/1]).\n\n", string:join(Source, "\n"), "\n"]), %% Compile the code ?line {ok, _Mod, BeamCode} = compile:file(ErlFile, [binary]), - + %%%%%%% %% Create and run scripts without emulator flags %% With shebang NoArgsBase = Base ++ "_no_args_with_shebang", NoArgsFile = filename:join([Priv, NoArgsBase]), - ?line ok = file:write_file(NoArgsFile, + ?line ok = file:write_file(NoArgsFile, [Shebang, "\n", BeamCode]), - ?line ok = file:write_file_info(NoArgsFile, OrigFI), + ?line ok = file:write_file_info(NoArgsFile, OrigFI), ?line run(Dir, NoArgsBase ++ " -arg1 arg2 arg3", [<<"main:[\"-arg1\",\"arg2\",\"arg3\"]\n" @@ -277,7 +283,7 @@ beam_script(Config) when is_list(Config) -> "unknown:[]\n" "ExitCode:0">>]), - ?line run(Dir, "", NoArgsBase ++ " -arg1 arg2 arg3", + ?line run_with_opts(Dir, "", NoArgsBase ++ " -arg1 arg2 arg3", [<<"main:[\"-arg1\",\"arg2\",\"arg3\"]\n" "nostick:[]\n" "mnesia:[]\n" @@ -288,12 +294,12 @@ beam_script(Config) when is_list(Config) -> %% Without shebang NoArgsBase2 = Base ++ "_no_args_without_shebang", NoArgsFile2 = filename:join([Priv, NoArgsBase2]), - ?line ok = file:write_file(NoArgsFile2, + ?line ok = file:write_file(NoArgsFile2, ["Something else than shebang!!!", "\n", BeamCode]), - ?line ok = file:write_file_info(NoArgsFile2, OrigFI), + ?line ok = file:write_file_info(NoArgsFile2, OrigFI), - ?line run(Dir, "", NoArgsBase2 ++ " -arg1 arg2 arg3", + ?line run_with_opts(Dir, "", NoArgsBase2 ++ " -arg1 arg2 arg3", [<<"main:[\"-arg1\",\"arg2\",\"arg3\"]\n" "nostick:[]\n" "mnesia:[]\n" @@ -305,9 +311,9 @@ beam_script(Config) when is_list(Config) -> NoArgsBase3 = Base ++ "_no_args_without_header", NoArgsFile3 = filename:join([Priv, NoArgsBase3]), ?line ok = file:write_file(NoArgsFile3, [BeamCode]), - ?line ok = file:write_file_info(NoArgsFile3, OrigFI), + ?line ok = file:write_file_info(NoArgsFile3, OrigFI), - ?line run(Dir, "", NoArgsBase3 ++ " -arg1 arg2 arg3", + ?line run_with_opts(Dir, "", NoArgsBase3 ++ " -arg1 arg2 arg3", [<<"main:[\"-arg1\",\"arg2\",\"arg3\"]\n" "nostick:[]\n" "mnesia:[]\n" @@ -322,12 +328,12 @@ beam_script(Config) when is_list(Config) -> ArgsBase = Base ++ "_args", ArgsFile = filename:join([Priv, ArgsBase]), ?line ok = file:write_file(ArgsFile, - [Shebang, "\n", + [Shebang, "\n", Mode, "\n", Flags, "\n", BeamCode]), - ?line ok = file:write_file_info(ArgsFile, OrigFI), - + ?line ok = file:write_file_info(ArgsFile, OrigFI), + ?line run(Dir, ArgsBase ++ " -arg1 arg2 arg3", [<<"main:[\"-arg1\",\"arg2\",\"arg3\"]\n" "nostick:[{nostick,[]}]\n" @@ -356,13 +362,13 @@ archive_script(Config) when is_list(Config) -> ?line ok = compile_app(TopDir, "archive_script_dict"), ?line ok = compile_app(TopDir, "archive_script_dummy"), ?line {ok, MainFiles} = file:list_dir(TopDir), - ?line ok = compile_files(MainFiles, TopDir, TopDir), - + ?line ok = compile_files(MainFiles, TopDir, TopDir), + %% Create the archive {ok, TopFiles} = file:list_dir(TopDir), ?line {ok, {_, ArchiveBin}} = zip:create(Archive, TopFiles, [memory, {compress, []}, {cwd, TopDir}]), - + %% Read the source script OrigFile = filename:join([DataDir, "emulator_flags"]), {ok, OrigBin} = file:read_file(OrigFile), @@ -371,73 +377,73 @@ archive_script(Config) when is_list(Config) -> Flags = "%%! -archive_script_dict foo bar" " -archive_script_dict foo" " -archive_script_dummy bar", - ?line {ok, OrigFI} = file:read_file_info(OrigFile), - + ?line {ok, OrigFI} = file:read_file_info(OrigFile), + %%%%%%% %% Create and run scripts without emulator flags - MainBase = "archive_script_main", - MainScript = filename:join([PrivDir, MainBase]), + MainBase = "archive_script_main", + MainScript = filename:join([PrivDir, MainBase]), %% With shebang - ?line ok = file:write_file(MainScript, + ?line ok = file:write_file(MainScript, [Shebang, "\n", Flags, "\n", ArchiveBin]), - ?line ok = file:write_file_info(MainScript, OrigFI), - + ?line ok = file:write_file_info(MainScript, OrigFI), + ?line run(PrivDir, MainBase ++ " -arg1 arg2 arg3", - [<<"main:[\"-arg1\",\"arg2\",\"arg3\"]\n" + [<<"main:[\"-arg1\",\"arg2\",\"arg3\"]\n" "dict:[{archive_script_dict,[\"foo\",\"bar\"]},{archive_script_dict,[\"foo\"]}]\n" "dummy:[{archive_script_dummy,[\"bar\"]}]\n" "priv:{ok,<<\"Some private data...\\n\">>}\n" "ExitCode:0">>]), - ?line run(PrivDir, "", MainBase ++ " -arg1 arg2 arg3", - [<<"main:[\"-arg1\",\"arg2\",\"arg3\"]\n" + ?line run_with_opts(PrivDir, "", MainBase ++ " -arg1 arg2 arg3", + [<<"main:[\"-arg1\",\"arg2\",\"arg3\"]\n" "dict:[{archive_script_dict,[\"foo\",\"bar\"]},{archive_script_dict,[\"foo\"]}]\n" "dummy:[{archive_script_dummy,[\"bar\"]}]\n" "priv:{ok,<<\"Some private data...\\n\">>}\n" "ExitCode:0">>]), - + ?line ok = file:rename(MainScript, MainScript ++ "_with_shebang"), %% Without shebang (no flags) - ?line ok = file:write_file(MainScript, + ?line ok = file:write_file(MainScript, ["Something else than shebang!!!", "\n", ArchiveBin]), - ?line ok = file:write_file_info(MainScript, OrigFI), - - ?line run(PrivDir, "", MainBase ++ " -arg1 arg2 arg3", - [<<"main:[\"-arg1\",\"arg2\",\"arg3\"]\n" + ?line ok = file:write_file_info(MainScript, OrigFI), + + ?line run_with_opts(PrivDir, "", MainBase ++ " -arg1 arg2 arg3", + [<<"main:[\"-arg1\",\"arg2\",\"arg3\"]\n" "dict:[]\n" "dummy:[]\n" "priv:{ok,<<\"Some private data...\\n\">>}\n" "ExitCode:0">>]), ?line ok = file:rename(MainScript, MainScript ++ "_without_shebang"), - + %% Plain archive without header (no flags) - + ?line ok = file:write_file(MainScript, [ArchiveBin]), - ?line ok = file:write_file_info(MainScript, OrigFI), - - ?line run(PrivDir, "", MainBase ++ " -arg1 arg2 arg3", - [<<"main:[\"-arg1\",\"arg2\",\"arg3\"]\n" + ?line ok = file:write_file_info(MainScript, OrigFI), + + ?line run_with_opts(PrivDir, "", MainBase ++ " -arg1 arg2 arg3", + [<<"main:[\"-arg1\",\"arg2\",\"arg3\"]\n" "dict:[]\n" "dummy:[]\n" "priv:{ok,<<\"Some private data...\\n\">>}\n" "ExitCode:0">>]), ?line ok = file:rename(MainScript, MainScript ++ "_without_header"), - + %%%%%%% %% Create and run scripts with emulator flags AltBase = "archive_script_alternate_main", AltScript = filename:join([PrivDir, AltBase]), - ?line ok = file:write_file(AltScript, + ?line ok = file:write_file(AltScript, [Shebang, "\n", Mode, "\n", Flags, " -escript main archive_script_main2\n", ArchiveBin]), - ?line ok = file:write_file_info(AltScript, OrigFI), + ?line ok = file:write_file_info(AltScript, OrigFI), ?line run(PrivDir, AltBase ++ " -arg1 arg2 arg3", [<<"main2:[\"-arg1\",\"arg2\",\"arg3\"]\n" @@ -445,7 +451,7 @@ archive_script(Config) when is_list(Config) -> "dummy:[{archive_script_dummy,[\"bar\"]}]\n" "priv:{ok,<<\"Some private data...\\n\">>}\n" "ExitCode:0">>]), - + ok. compile_app(TopDir, AppName) -> @@ -482,6 +488,254 @@ epp(Config) when is_list(Config) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +create_and_extract(Config) when is_list(Config) -> + {NewFile, FileInfo, + EmuArg, Source, + _ErlBase, ErlCode, + _BeamBase, BeamCode, + ArchiveBin} = + prepare_creation("create_and_extract", Config), + + Bodies = + [[{source, ErlCode}], + [{beam, BeamCode}], + [{archive, ArchiveBin}]], + + %% Verify all combinations of scripts with shebangs + [verify_sections(NewFile, FileInfo, S ++ C ++ E ++ B) || + S <- [[{shebang, default}], + [{shebang, "/usr/bin/env escript"}]], + C <- [[], + [{comment, undefined}], + [{comment, default}], + [{comment, "This is a nonsense comment"}]], + E <- [[], + [{emu_args, undefined}], + [{emu_args, EmuArg}]], + B <- [[{source, Source}] | Bodies]], + + %% Verify all combinations of scripts without shebangs + [verify_sections(NewFile, FileInfo, S ++ C ++ E ++ B) || + S <- [[], [{shebang, undefined}]], + C <- [[], [{comment, undefined}]], + E <- [[], [{emu_args, undefined}]], + B <- Bodies], + + %% Verify the compile_source option + file:delete(NewFile), + ?line ok = escript:create(NewFile, [{source, Source}]), + ?line {ok, [_, _, _, {source, Source}]} = escript:extract(NewFile, []), + ?line {ok, [_, _, _, {source, BeamCode2}]} = + escript:extract(NewFile, [compile_source]), + verify_sections(NewFile, FileInfo, + [{shebang, default}, + {comment, default}, + {beam, BeamCode2}]), + + file:delete(NewFile), + ok. + +prepare_creation(Base, Config) -> + %% Read the source + PrivDir = ?config(priv_dir, Config), + DataDir = ?config(data_dir, Config), + OrigFile = filename:join([DataDir,"emulator_flags"]), + ?line {ok, FileInfo} = file:read_file_info(OrigFile), + NewFile = filename:join([PrivDir, Base]), + ?line {ok, [{shebang, default}, + {comment, _}, + {emu_args, EmuArg}, + {source, Source}]} = + escript:extract(OrigFile, []), + + %% Compile the code + ErlFile = NewFile ++ ".erl", + ErlCode = list_to_binary(["\n-module(", Base, ").\n", + "-export([main/1]).\n\n", + Source, "\n\n"]), + ?line ok = file:write_file(ErlFile, ErlCode), + + %% Compile the code + ?line {ok, _Mod, BeamCode} = + compile:file(ErlFile, [binary, debug_info]), + + %% Create an archive + ?line {ok, {_, ArchiveBin}} = + zip:create("dummy_archive_name", + [{Base ++ ".erl", ErlCode}, + {Base ++ ".beam", BeamCode}], + [{compress, []}, memory]), + {NewFile, FileInfo, + EmuArg, Source, + Base ++ ".erl", ErlCode, + Base ++ ".beam", BeamCode, + ArchiveBin}. + +verify_sections(File, FileInfo, Sections) -> + io:format("~p:verify_sections(\n\t~p,\n\t~p,\n\t~p).\n", + [?MODULE, File, FileInfo, Sections]), + + %% Create + file:delete(File), + ?line ok = escript:create(File, Sections), + ?line ok = file:write_file_info(File, FileInfo), + + %% Run + Dir = filename:absname(filename:dirname(File)), + Base = filename:basename(File), + + HasArg = fun(Tag) -> + case lists:keysearch(Tag, 1, Sections) of + false -> false; + {value, {_, undefined}} -> false; + {value, _} -> true + end + end, + ExpectedMain = <<"main:[\"-arg1\",\"arg2\",\"arg3\"]\n">>, + ExpectedOutput = + case HasArg(emu_args) of + true -> + <<"nostick:[{nostick,[]}]\n" + "mnesia:[{mnesia,[\"dir\",\"a/directory\"]},{mnesia,[\"debug\",\"verbose\"]}]\n" + "ERL_FLAGS=false\n" + "unknown:[]\n" + "ExitCode:0">>; + false -> + <<"nostick:[]\nmnesia:[]\nERL_FLAGS=false\nunknown:[]\nExitCode:0">> + end, + + InputArgs = Base ++ " -arg1 arg2 arg3", + Expected = <<ExpectedMain/binary, ExpectedOutput/binary>>, + case HasArg(shebang) of + true -> + ?line run(Dir, InputArgs, [Expected]); + false -> + ?line run_with_opts(Dir, [], InputArgs, [Expected]) + end, + + %% Verify + ?line {ok, Bin} = escript:create(binary, Sections), + ?line {ok, Read} = file:read_file(File), + ?line Bin = Read, % Assert + + Normalized = normalize_sections(Sections), + ?line {ok, Extracted} = escript:extract(File, []), + io:format("Normalized; ~p\n", [Normalized]), + io:format("Extracted ; ~p\n", [Extracted]), + ?line Normalized = Extracted, % Assert + ok. + +normalize_sections(Sections) -> + AtomToTuple = + fun(Val) -> + if + is_atom(Val) -> {Val, default}; + true -> Val + end + end, + case lists:map(AtomToTuple, [{K, V} || {K, V} <- Sections, V =/= undefined]) of + [{shebang, Shebang} | Rest] -> + [{shebang, Shebang} | + case Rest of + [{comment, Comment} | Rest2] -> + [{comment, Comment} | + case Rest2 of + [{emu_args, EmuArgs}, Body] -> + [{emu_args, EmuArgs}, Body]; + [Body] -> + [{emu_args, undefined}, Body] + end + ]; + [{emu_args, EmuArgs}, Body] -> + [{comment, undefined}, {emu_args, EmuArgs}, Body]; + [Body] -> + [{comment, undefined}, {emu_args, undefined}, Body] + end + ]; + [Body] -> + [{shebang, undefined}, {comment, undefined}, {emu_args, undefined}, Body] + end. +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +foldl(Config) when is_list(Config) -> + {NewFile, _FileInfo, + _EmuArg, _Source, + ErlBase, ErlCode, + BeamBase, _BeamCode, + ArchiveBin} = + prepare_creation("foldl", Config), + + Collect = fun(Name, GetInfo, GetBin, Acc) -> + [{Name, GetInfo(), GetBin()} | Acc] + end, + + %% Get line numbers and the file attribute right + SourceFile = NewFile ++ ".erl", + <<_:1/binary, ErlCode2/binary>> = ErlCode, + ?line ok = file:write_file(SourceFile, ErlCode2), + ?line {ok, _Mod, BeamCode} = + compile:file(SourceFile, [binary, debug_info]), + + %% Verify source script + ?line ok = escript:create(SourceFile, [{source, ErlCode}]), + ?line {ok, [{".", _, BeamCode2}]} + = escript_foldl(Collect, [], SourceFile), + + ?line {ok, Abstr} = beam_lib:chunks(BeamCode, [abstract_code]), + ?line {ok, Abstr2} = beam_lib:chunks(BeamCode2, [abstract_code]), + %% io:format("abstr1=~p\n", [Abstr]), + %% io:format("abstr2=~p\n", [Abstr2]), + ?line Abstr = Abstr2, % Assert + + %% Verify beam script + ?line ok = escript:create(NewFile, [{beam, BeamCode}]), + ?line {ok, [{".", _, BeamCode}]} + = escript_foldl(Collect, [], NewFile), + + %% Verify archive scripts + ?line ok = escript:create(NewFile, [{archive, ArchiveBin}]), + ?line {ok, [{BeamBase, #file_info{}, _}, + {ErlBase, #file_info{}, _}]} + = escript_foldl(Collect, [], NewFile), + + ArchiveFiles = [{ErlBase, ErlCode}, {BeamBase, BeamCode}], + ?line ok = escript:create(NewFile, [{archive, ArchiveFiles, []}]), + ?line {ok, [{BeamBase, _, _}, + {ErlBase, _, _}]} + = escript_foldl(Collect, [], NewFile), + + ok. + +escript_foldl(Fun, Acc, File) -> + code:ensure_loaded(zip), + case erlang:function_exported(zip, foldl, 3) of + true -> + emulate_escript_foldl(Fun, Acc, File); + false -> + escript:foldl(Fun, Acc, File) + end. + +emulate_escript_foldl(Fun, Acc, File) -> + case escript:extract(File, [compile_source]) of + {ok, [_Shebang, _Comment, _EmuArgs, Body]} -> + case Body of + {source, BeamCode} -> + GetInfo = fun() -> file:read_file_info(File) end, + GetBin = fun() -> BeamCode end, + {ok, Fun(".", GetInfo, GetBin, Acc)}; + {beam, BeamCode} -> + GetInfo = fun() -> file:read_file_info(File) end, + GetBin = fun() -> BeamCode end, + {ok, Fun(".", GetInfo, GetBin, Acc)}; + {archive, ArchiveBin} -> + zip:foldl(Fun, Acc, {File, ArchiveBin}) + end; + {error, Reason} -> + {error, Reason} + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + run(Dir, Cmd0, Expected0) -> Expected = iolist_to_binary(expected_output(Expected0, Dir)), Cmd = case os:type() of @@ -490,7 +744,7 @@ run(Dir, Cmd0, Expected0) -> end, do_run(Dir, Cmd, Expected). -run(Dir, Opts, Cmd0, Expected) -> +run_with_opts(Dir, Opts, Cmd0, Expected) -> Cmd = case os:type() of {win32,_} -> "escript " ++ Opts ++ " " ++ filename:nativename(Dir) ++ "\\" ++ Cmd0; _ -> "escript " ++ Opts ++ " " ++ Dir ++ "/" ++ Cmd0 @@ -533,8 +787,8 @@ expected_output([data_dir|T], Data) -> [filename:nativename(Data)++Slash|expected_output(T, Data)]; expected_output([H|T], Data) -> [H|expected_output(T, Data)]; -expected_output([], _) -> +expected_output([], _) -> []; -expected_output(Bin, _) when is_binary(Bin) -> +expected_output(Bin, _) when is_binary(Bin) -> Bin. diff --git a/lib/stdlib/test/gen_server_SUITE.erl b/lib/stdlib/test/gen_server_SUITE.erl index 6efdce78a1..0f60c2c4ee 100644 --- a/lib/stdlib/test/gen_server_SUITE.erl +++ b/lib/stdlib/test/gen_server_SUITE.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% -module(gen_server_SUITE). @@ -30,7 +30,8 @@ call_remote_n1/1, call_remote_n2/1, call_remote_n3/1, spec_init/1, spec_init_local_registered_parent/1, spec_init_global_registered_parent/1, - otp_5854/1, hibernate/1, otp_7669/1, call_format_status/1 + otp_5854/1, hibernate/1, otp_7669/1, call_format_status/1, + call_with_huge_message_queue/1 ]). % spawn export @@ -51,7 +52,8 @@ all(suite) -> call_remote_n2, call_remote_n3, spec_init, spec_init_local_registered_parent, spec_init_global_registered_parent, - otp_5854, hibernate, otp_7669, call_format_status]. + otp_5854, hibernate, otp_7669, call_format_status, + call_with_huge_message_queue]. -define(default_timeout, ?t:minutes(1)). @@ -904,6 +906,45 @@ call_format_status(Config) when is_list(Config) -> ?line [format_status_called | _] = lists:reverse(Data2), ok. +%% Test that the time for a huge message queue is not +%% significantly slower than with an empty message queue. +call_with_huge_message_queue(Config) when is_list(Config) -> + ?line Pid = spawn_link(fun echo_loop/0), + + ?line {Time,ok} = tc(fun() -> calls(10, Pid) end), + + ?line [self() ! {msg,N} || N <- lists:seq(1, 500000)], + erlang:garbage_collect(), + ?line {NewTime,ok} = tc(fun() -> calls(10, Pid) end), + io:format("Time for empty message queue: ~p", [Time]), + io:format("Time for huge message queue: ~p", [NewTime]), + + case (NewTime+1) / (Time+1) of + Q when Q < 10 -> + ok; + Q -> + io:format("Q = ~p", [Q]), + ?line ?t:fail() + end, + ok. + +calls(0, _) -> ok; +calls(N, Pid) -> + {ultimate_answer,42} = call(Pid, {ultimate_answer,42}), + calls(N-1, Pid). + +call(Pid, Msg) -> + gen_server:call(Pid, Msg, infinity). + +tc(Fun) -> + timer:tc(erlang, apply, [Fun,[]]). + +echo_loop() -> + receive + {'$gen_call',{Pid,Ref},Msg} -> + Pid ! {Ref,Msg}, + echo_loop() + end. %%-------------------------------------------------------------- %% Help functions to spec_init_* diff --git a/lib/stdlib/test/io_proto_SUITE.erl b/lib/stdlib/test/io_proto_SUITE.erl index 93159fbd5b..d9672a8c7b 100644 --- a/lib/stdlib/test/io_proto_SUITE.erl +++ b/lib/stdlib/test/io_proto_SUITE.erl @@ -17,6 +17,7 @@ %% %CopyrightEnd% %% -module(io_proto_SUITE). +-compile(r12). -export([all/1]). diff --git a/lib/stdlib/test/qlc_SUITE.erl b/lib/stdlib/test/qlc_SUITE.erl index ff11ebc6bf..aa12ed57da 100644 --- a/lib/stdlib/test/qlc_SUITE.erl +++ b/lib/stdlib/test/qlc_SUITE.erl @@ -1,25 +1,26 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2004-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% %%%---------------------------------------------------------------- %%% Purpose:Test Suite for the 'qlc' module. %%%----------------------------------------------------------------- -module(qlc_SUITE). +-compile(r12). -define(QLC, qlc). -define(QLCs, "qlc"). diff --git a/lib/stdlib/test/re_SUITE.erl b/lib/stdlib/test/re_SUITE.erl index 02683f9f1a..46a84d4e24 100644 --- a/lib/stdlib/test/re_SUITE.erl +++ b/lib/stdlib/test/re_SUITE.erl @@ -18,12 +18,12 @@ %% -module(re_SUITE). --export([all/1, pcre/1,compile_options/1,run_options/1,combined_options/1,replace_autogen/1,global_capture/1,replace_input_types/1,replace_return/1,split_autogen/1,split_options/1,split_specials/1,error_handling/1,pcre_cve_2008_2371/1]). +-export([all/1, pcre/1,compile_options/1,run_options/1,combined_options/1,replace_autogen/1,global_capture/1,replace_input_types/1,replace_return/1,split_autogen/1,split_options/1,split_specials/1,error_handling/1,pcre_cve_2008_2371/1,pcre_compile_workspace_overflow/1,re_infinite_loop/1]). -include("test_server.hrl"). -include_lib("kernel/include/file.hrl"). -all(suite) -> [pcre,compile_options,run_options,combined_options,replace_autogen,global_capture,replace_input_types,replace_return,split_autogen,split_options,split_specials,error_handling,pcre_cve_2008_2371]. +all(suite) -> [pcre,compile_options,run_options,combined_options,replace_autogen,global_capture,replace_input_types,replace_return,split_autogen,split_options,split_specials,error_handling,pcre_cve_2008_2371,pcre_compile_workspace_overflow,re_infinite_loop]. pcre(doc) -> ["Run all applicable tests from the PCRE testsuites."]; @@ -544,3 +544,25 @@ pcre_cve_2008_2371(Config) when is_list(Config) -> %% Make sure it doesn't crash the emulator. re:compile(<<"(?i)[\xc3\xa9\xc3\xbd]|[\xc3\xa9\xc3\xbdA]">>, [unicode]), ok. + +pcre_compile_workspace_overflow(doc) -> + "Patch from http://vcs.pcre.org/viewvc/code/trunk/pcre_compile.c?r1=504&r2=505&view=patch"; +pcre_compile_workspace_overflow(Config) when is_list(Config) -> + N = 819, + ?line {error,{"internal error: overran compiling workspace",799}} = + re:compile([lists:duplicate(N, $(), lists:duplicate(N, $))]), + ok. +re_infinite_loop(doc) -> + "Make sure matches that really loop infinitely actually fail"; +re_infinite_loop(Config) when is_list(Config) -> + Dog = ?t:timetrap(?t:minutes(1)), + ?line Str = + "http:/www.flickr.com/slideShow/index.gne?group_id=&user_id=69845378@N0", + ?line EMail_regex = "[a-z0-9!#$%&'*+/=?^_`{|}~-]+" + ++ "(\.[a-z0-9!#$%&'*+/=?^_`{|}~-]+)*" + ++ "@.*([a-z0-9](?:[a-z0-9-]*[a-z0-9])?\.)+" + ++ "([a-zA-Z]{2}|com|org|net|gov|mil" + ++ "|biz|info|mobi|name|aero|jobs|museum)", + ?line nomatch = re:run(Str, EMail_regex), + ?t:timetrap_cancel(Dog), + ok. diff --git a/lib/stdlib/test/zip_SUITE.erl b/lib/stdlib/test/zip_SUITE.erl index 12ca655000..48b14396c1 100644 --- a/lib/stdlib/test/zip_SUITE.erl +++ b/lib/stdlib/test/zip_SUITE.erl @@ -18,12 +18,13 @@ %% -module(zip_SUITE). --export([all/1, borderline/1, atomic/1, +-export([all/1, borderline/1, atomic/1, bad_zip/1, unzip_from_binary/1, unzip_to_binary/1, zip_to_binary/1, unzip_options/1, zip_options/1, list_dir_options/1, aliases/1, openzip_api/1, zip_api/1, unzip_jar/1, - compress_control/1]). + compress_control/1, + foldl/1]). -include("test_server.hrl"). -include("test_server_line.hrl"). @@ -35,7 +36,8 @@ all(suite) -> [borderline, atomic, bad_zip, zip_to_binary, unzip_options, zip_options, list_dir_options, aliases, openzip_api, zip_api, unzip_jar, - compress_control]. + compress_control, + foldl]. borderline(doc) -> ["Test creating, listing and extracting one file from an archive " @@ -110,17 +112,17 @@ get_data(Port, Expect) -> {Port, {data, Bytes}} -> get_data(Port, match_output(Bytes, Expect, Port)); {Port, eof} -> - Port ! {self(), close}, + Port ! {self(), close}, receive {Port, closed} -> true - end, + end, receive - {'EXIT', Port, _} -> + {'EXIT', Port, _} -> ok after 1 -> % force context switch ok - end, + end, match_output(eof, Expect, Port) end. @@ -290,7 +292,7 @@ unzip_options(Config) when is_list(Config) -> DataDir = ?config(data_dir, Config), PrivDir = ?config(priv_dir, Config), Long = filename:join(DataDir, "abc.zip"), - + %% create a temp directory Subdir = filename:join(PrivDir, "t"), ok = file:make_dir(Subdir), @@ -303,7 +305,7 @@ unzip_options(Config) when is_list(Config) -> %% Verify. ?line true = (length(FList) =:= length(RetList)), - ?line lists:foreach(fun(F)-> {ok,B} = file:read_file(filename:join(DataDir, F)), + ?line lists:foreach(fun(F)-> {ok,B} = file:read_file(filename:join(DataDir, F)), {ok,B} = file:read_file(filename:join(Subdir, F)) end, FList), ?line lists:foreach(fun(F)-> ok = file:delete(F) end, @@ -321,7 +323,7 @@ unzip_jar(Config) when is_list(Config) -> DataDir = ?config(data_dir, Config), PrivDir = ?config(priv_dir, Config), JarFile = filename:join(DataDir, "test.jar"), - + %% create a temp directory Subdir = filename:join(PrivDir, "jartest"), ok = file:make_dir(Subdir), @@ -479,7 +481,7 @@ unzip_to_binary(Config) when is_list(Config) -> DataDir = ?config(data_dir, Config), PrivDir = ?config(priv_dir, Config), - delete_all_in(PrivDir), + delete_all_in(PrivDir), file:set_cwd(PrivDir), Long = filename:join(DataDir, "abc.zip"), @@ -595,17 +597,17 @@ do_delete_files([],Cnt) -> Cnt; do_delete_files([Item|Rest], Cnt) -> case file:delete(Item) of - ok -> + ok -> DelCnt = 1; {error,eperm} -> file:change_mode(Item, 8#777), DelCnt = delete_files(filelib:wildcard(filename:join(Item, "*"))), - file:del_dir(Item); + file:del_dir(Item); {error,eacces} -> %% We'll see about that! file:change_mode(Item, 8#777), case file:delete(Item) of - ok -> + ok -> DelCnt = 1; {error,_} -> erlang:yield(), @@ -643,22 +645,22 @@ compress_control(Config) when is_list(Config) -> ], test_compress_control(Dir, - Files, + Files, [{compress, []}], []), test_compress_control(Dir, - Files, + Files, [{uncompress, all}], []), test_compress_control(Dir, - Files, + Files, [{uncompress, []}], [".txt", ".exe", ".zip", ".lzh", ".arj"]), test_compress_control(Dir, - Files, + Files, [], [".txt", ".exe"]), @@ -686,7 +688,7 @@ test_compress_control(Dir, Files, ZipOptions, Expected) -> create_files(Files), {ok, Zip} = zip:create(Zip, [Dir], ZipOptions), - + {ok, OpenZip} = zip:openzip_open(Zip, [memory]), {ok,[#zip_comment{comment = ""} | ZipList]} = zip:openzip_list_dir(OpenZip), io:format("compress_control: -> ~p -> ~p\n -> ~pn", [Expected, ZipOptions, ZipList]), @@ -698,19 +700,19 @@ test_compress_control(Dir, Files, ZipOptions, Expected) -> delete_files(lists:reverse(Names)), % Remove plain files before directories ok. - + verify_compression([{Name, Kind, _Filler} | Files], ZipList, OpenZip, ZipOptions, Expected) -> {Name2, BinSz} = case Kind of - dir -> + dir -> {Name ++ "/", 0}; - _ -> + _ -> {ok, {Name, Bin}} = zip:openzip_get(Name, OpenZip), {Name, size(Bin)} end, {Name2, {value, ZipFile}} = {Name2, lists:keysearch(Name2, #zip_file.name, ZipList)}, #zip_file{info = #file_info{size = InfoSz, type = InfoType}, comp_size = InfoCompSz} = ZipFile, - + Ext = filename:extension(Name), IsComp = is_compressed(Ext, Kind, ZipOptions), ExpComp = lists:member(Ext, Expected), @@ -757,3 +759,33 @@ extensions([H | T], Old) -> extensions([], Old) -> Old. +foldl(Config) -> + PrivDir = ?config(priv_dir, Config), + File = filename:join([PrivDir, "foldl.zip"]), + + FooBin = <<"FOO">>, + BarBin = <<"BAR">>, + Files = [{"foo", FooBin}, {"bar", BarBin}], + ?line {ok, {File, Bin}} = zip:create(File, Files, [memory]), + ZipFun = fun(N, I, B, Acc) -> [{N, B(), I()} | Acc] end, + ?line {ok, FileSpec} = zip:foldl(ZipFun, [], {File, Bin}), + ?line [{"bar", BarBin, #file_info{}}, {"foo", FooBin, #file_info{}}] = FileSpec, + ?line {ok, {File, Bin}} = zip:create(File, lists:reverse(FileSpec), [memory]), + ?line {foo_bin, FooBin} = + try + zip:foldl(fun("foo", _, B, _) -> throw(B()); (_, _, _, Acc) -> Acc end, [], {File, Bin}) + catch + throw:FooBin -> + {foo_bin, FooBin} + end, + ?line ok = file:write_file(File, Bin), + ?line {ok, FileSpec} = zip:foldl(ZipFun, [], File), + + ?line {error, einval} = zip:foldl(fun() -> ok end, [], File), + ?line {error, einval} = zip:foldl(ZipFun, [], 42), + ?line {error, einval} = zip:foldl(ZipFun, [], {File, 42}), + + ?line ok = file:delete(File), + ?line {error, enoent} = zip:foldl(ZipFun, [], File), + + ok. |