diff options
Diffstat (limited to 'lib/stdlib')
| -rw-r--r-- | lib/stdlib/doc/src/io_protocol.xml | 4 | ||||
| -rw-r--r-- | lib/stdlib/doc/src/ms_transform.xml | 8 | ||||
| -rw-r--r-- | lib/stdlib/doc/src/unicode_usage.xml | 4 | ||||
| -rw-r--r-- | lib/stdlib/doc/src/zip.xml | 90 | ||||
| -rw-r--r-- | lib/stdlib/src/erl_expand_records.erl | 14 | ||||
| -rw-r--r-- | lib/stdlib/src/erl_lint.erl | 41 | ||||
| -rw-r--r-- | lib/stdlib/src/erl_parse.yrl | 37 | ||||
| -rw-r--r-- | lib/stdlib/src/escript.erl | 441 | ||||
| -rw-r--r-- | lib/stdlib/src/zip.erl | 80 | ||||
| -rw-r--r-- | lib/stdlib/test/erl_pp_SUITE.erl | 39 | ||||
| -rw-r--r-- | lib/stdlib/test/escript_SUITE.erl | 396 | ||||
| -rw-r--r-- | lib/stdlib/test/zip_SUITE.erl | 78 |
12 files changed, 889 insertions, 343 deletions
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/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/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 af407f1925..4d98a20206 100644 --- a/lib/stdlib/doc/src/zip.xml +++ b/lib/stdlib/doc/src/zip.xml @@ -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/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 22f435aff8..94ad560549 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -1940,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) -> @@ -2717,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..ea91ec5927 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% %% @@ -57,7 +57,6 @@ char integer float atom string var '(' ')' ',' '->' ':-' '{' '}' '[' ']' '|' '||' '<-' ';' ':' '#' '.' 'after' 'begin' 'case' 'try' 'catch' 'end' 'fun' 'if' 'of' 'receive' 'when' 'andalso' 'orelse' 'query' 'spec' -%% 'cond' 'bnot' 'not' '*' '/' 'div' 'rem' 'band' 'and' '+' '-' 'bor' 'bxor' 'bsl' 'bsr' 'or' 'xor' @@ -422,14 +421,6 @@ 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'}. @@ -743,13 +734,29 @@ record_fields([{typed,Expr,TypeInfo}|Fields]) -> case Expr of {match, _, _, _} -> TypeInfo; %% If we have an initializer. {atom, La, _} -> - lift_unions(abstract(undefined, La), TypeInfo) + 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") 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/zip.erl b/lib/stdlib/src/zip.erl index e76d588cb5..d41aeefa59 100644 --- a/lib/stdlib/src/zip.erl +++ b/lib/stdlib/src/zip.erl @@ -20,7 +20,7 @@ %% 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/erl_pp_SUITE.erl b/lib/stdlib/test/erl_pp_SUITE.erl index a695374908..92a54108aa 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]). %% Internal export. -export([ehook/6]). @@ -764,7 +764,7 @@ 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_6321(doc) -> "OTP_6321. Bug fix of exprs()."; @@ -847,7 +847,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 +883,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()} |" @@ -922,6 +922,33 @@ otp_8473(Config) when is_list(Config) -> {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. + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% compile(Config, Tests) -> diff --git a/lib/stdlib/test/escript_SUITE.erl b/lib/stdlib/test/escript_SUITE.erl index f36ae34633..77fd190e45 100644 --- a/lib/stdlib/test/escript_SUITE.erl +++ b/lib/stdlib/test/escript_SUITE.erl @@ -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/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. |