aboutsummaryrefslogtreecommitdiffstats
path: root/lib/stdlib/src
diff options
context:
space:
mode:
Diffstat (limited to 'lib/stdlib/src')
-rw-r--r--lib/stdlib/src/Makefile1
-rw-r--r--lib/stdlib/src/beam_lib.erl42
-rw-r--r--lib/stdlib/src/binary.erl177
-rw-r--r--lib/stdlib/src/c.erl141
-rw-r--r--lib/stdlib/src/dets.erl122
-rw-r--r--lib/stdlib/src/dets.hrl4
-rw-r--r--lib/stdlib/src/dets_sup.erl17
-rw-r--r--lib/stdlib/src/dets_v8.erl2
-rw-r--r--lib/stdlib/src/dets_v9.erl5
-rw-r--r--lib/stdlib/src/digraph.erl12
-rw-r--r--lib/stdlib/src/edlin.erl5
-rw-r--r--lib/stdlib/src/epp.erl143
-rw-r--r--lib/stdlib/src/erl_compile.erl12
-rw-r--r--lib/stdlib/src/erl_expand_records.erl151
-rw-r--r--lib/stdlib/src/erl_internal.erl159
-rw-r--r--lib/stdlib/src/erl_lint.erl512
-rw-r--r--lib/stdlib/src/erl_parse.yrl192
-rw-r--r--lib/stdlib/src/erl_pp.erl52
-rw-r--r--lib/stdlib/src/erl_scan.erl134
-rw-r--r--lib/stdlib/src/escript.erl487
-rw-r--r--lib/stdlib/src/ets.erl164
-rw-r--r--lib/stdlib/src/eval_bits.erl4
-rw-r--r--lib/stdlib/src/file_sorter.erl11
-rw-r--r--lib/stdlib/src/filelib.erl94
-rw-r--r--lib/stdlib/src/filename.erl436
-rw-r--r--lib/stdlib/src/gb_sets.erl2
-rw-r--r--lib/stdlib/src/gen.erl45
-rw-r--r--lib/stdlib/src/gen_event.erl42
-rw-r--r--lib/stdlib/src/gen_fsm.erl58
-rw-r--r--lib/stdlib/src/gen_server.erl62
-rw-r--r--lib/stdlib/src/io.erl11
-rw-r--r--lib/stdlib/src/io_lib.erl2
-rw-r--r--lib/stdlib/src/io_lib_fread.erl12
-rw-r--r--lib/stdlib/src/lists.erl92
-rw-r--r--lib/stdlib/src/ms_transform.erl193
-rw-r--r--lib/stdlib/src/orddict.erl2
-rw-r--r--lib/stdlib/src/ordsets.erl18
-rw-r--r--lib/stdlib/src/otp_internal.erl152
-rw-r--r--lib/stdlib/src/proc_lib.erl12
-rw-r--r--lib/stdlib/src/proplists.erl12
-rw-r--r--lib/stdlib/src/qlc.erl2
-rw-r--r--lib/stdlib/src/stdlib.app.src11
-rw-r--r--lib/stdlib/src/string.erl2
-rw-r--r--lib/stdlib/src/supervisor.erl199
-rw-r--r--lib/stdlib/src/timer.erl82
-rw-r--r--lib/stdlib/src/unicode.erl11
-rw-r--r--lib/stdlib/src/zip.erl90
47 files changed, 2814 insertions, 1377 deletions
diff --git a/lib/stdlib/src/Makefile b/lib/stdlib/src/Makefile
index 237818c08b..600303d7e1 100644
--- a/lib/stdlib/src/Makefile
+++ b/lib/stdlib/src/Makefile
@@ -43,6 +43,7 @@ MODULES= \
array \
base64 \
beam_lib \
+ binary \
c \
calendar \
dets \
diff --git a/lib/stdlib/src/beam_lib.erl b/lib/stdlib/src/beam_lib.erl
index 820afd3739..74d4ad3da7 100644
--- a/lib/stdlib/src/beam_lib.erl
+++ b/lib/stdlib/src/beam_lib.erl
@@ -1,24 +1,28 @@
%%
%% %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).
-behaviour(gen_server).
+%% Avoid warning for local function error/1 clashing with autoimported BIF.
+-compile({no_auto_import,[error/1]}).
+%% Avoid warning for local function error/2 clashing with autoimported BIF.
+-compile({no_auto_import,[error/2]}).
-export([info/1,
cmp/2,
cmp_dirs/2,
@@ -41,12 +45,11 @@
terminate/2,code_change/3]).
-export([make_crypto_key/2, get_crypto_key/1]). %Utilities used by compiler
+-export_type([attrib_entry/0, compinfo_entry/0, labeled_entry/0]).
+
-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().
@@ -106,6 +109,7 @@
| info_rsn().
-type cmp_rsn() :: {'modules_different', module(), module()}
| {'chunks_different', chunkid()}
+ | 'different_chunks'
| info_rsn().
%%-------------------------------------------------------------------------
@@ -331,13 +335,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 +410,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/binary.erl b/lib/stdlib/src/binary.erl
new file mode 100644
index 0000000000..f6489788b2
--- /dev/null
+++ b/lib/stdlib/src/binary.erl
@@ -0,0 +1,177 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 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(binary).
+%%
+%% The following functions implemented as BIF's
+%% binary:compile_pattern/1
+%% binary:match/{2,3}
+%% binary:matches/{2,3}
+%% binary:longest_common_prefix/1
+%% binary:longest_common_suffix/1
+%% binary:first/1
+%% binary:last/1
+%% binary:at/2
+%% binary:part/{2,3}
+%% binary:bin_to_list/{1,2,3}
+%% binary:list_to_bin/1
+%% binary:copy/{1,2}
+%% binary:referenced_byte_size/1
+%% binary:decode_unsigned/{1,2}
+%% - Not yet:
+%%
+%% Implemented in this module:
+-export([split/2,split/3,replace/3,replace/4]).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% split
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+split(H,N) ->
+ split(H,N,[]).
+split(Haystack,Needles,Options) ->
+ try
+ {Part,Global,Trim} = get_opts_split(Options,{no,false,false}),
+ Moptlist = case Part of
+ no ->
+ [];
+ {A,B} ->
+ [{scope,{A,B}}]
+ end,
+ MList = if
+ Global ->
+ binary:matches(Haystack,Needles,Moptlist);
+ true ->
+ case binary:match(Haystack,Needles,Moptlist) of
+ nomatch -> [];
+ Match -> [Match]
+ end
+ end,
+ do_split(Haystack,MList,0,Trim)
+ catch
+ _:_ ->
+ erlang:error(badarg)
+ end.
+
+do_split(H,[],N,true) when N >= byte_size(H) ->
+ [];
+do_split(H,[],N,_) ->
+ [binary:part(H,{N,byte_size(H)-N})];
+do_split(H,[{A,B}|T],N,Trim) ->
+ case binary:part(H,{N,A-N}) of
+ <<>> ->
+ Rest = do_split(H,T,A+B,Trim),
+ case {Trim, Rest} of
+ {true,[]} ->
+ [];
+ _ ->
+ [<<>> | Rest]
+ end;
+ Oth ->
+ [Oth | do_split(H,T,A+B,Trim)]
+ end.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% replace
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+replace(H,N,R) ->
+ replace(H,N,R,[]).
+replace(Haystack,Needles,Replacement,Options) ->
+ try
+ true = is_binary(Replacement), % Make badarg instead of function clause
+ {Part,Global,Insert} = get_opts_replace(Options,{no,false,[]}),
+ Moptlist = case Part of
+ no ->
+ [];
+ {A,B} ->
+ [{scope,{A,B}}]
+ end,
+ MList = if
+ Global ->
+ binary:matches(Haystack,Needles,Moptlist);
+ true ->
+ case binary:match(Haystack,Needles,Moptlist) of
+ nomatch -> [];
+ Match -> [Match]
+ end
+ end,
+ ReplList = case Insert of
+ [] ->
+ Replacement;
+ Y when is_integer(Y) ->
+ splitat(Replacement,0,[Y]);
+ Li when is_list(Li) ->
+ splitat(Replacement,0,lists:sort(Li))
+ end,
+ erlang:iolist_to_binary(do_replace(Haystack,MList,ReplList,0))
+ catch
+ _:_ ->
+ erlang:error(badarg)
+ end.
+
+
+do_replace(H,[],_,N) ->
+ [binary:part(H,{N,byte_size(H)-N})];
+do_replace(H,[{A,B}|T],Replacement,N) ->
+ [binary:part(H,{N,A-N}),
+ if
+ is_list(Replacement) ->
+ do_insert(Replacement, binary:part(H,{A,B}));
+ true ->
+ Replacement
+ end
+ | do_replace(H,T,Replacement,A+B)].
+
+do_insert([X],_) ->
+ [X];
+do_insert([H|T],R) ->
+ [H,R|do_insert(T,R)].
+
+splitat(H,N,[]) ->
+ [binary:part(H,{N,byte_size(H)-N})];
+splitat(H,N,[I|T]) ->
+ [binary:part(H,{N,I-N})|splitat(H,I,T)].
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Simple helper functions
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+get_opts_split([],{Part,Global,Trim}) ->
+ {Part,Global,Trim};
+get_opts_split([{scope,{A,B}} | T],{_Part,Global,Trim}) ->
+ get_opts_split(T,{{A,B},Global,Trim});
+get_opts_split([global | T],{Part,_Global,Trim}) ->
+ get_opts_split(T,{Part,true,Trim});
+get_opts_split([trim | T],{Part,Global,_Trim}) ->
+ get_opts_split(T,{Part,Global,true});
+get_opts_split(_,_) ->
+ throw(badopt).
+
+get_opts_replace([],{Part,Global,Insert}) ->
+ {Part,Global,Insert};
+get_opts_replace([{scope,{A,B}} | T],{_Part,Global,Insert}) ->
+ get_opts_replace(T,{{A,B},Global,Insert});
+get_opts_replace([global | T],{Part,_Global,Insert}) ->
+ get_opts_replace(T,{Part,true,Insert});
+get_opts_replace([{insert_replaced,N} | T],{Part,Global,_Insert}) ->
+ get_opts_replace(T,{Part,Global,N});
+get_opts_replace(_,_) ->
+ throw(badopt).
+
diff --git a/lib/stdlib/src/c.erl b/lib/stdlib/src/c.erl
index 433833e233..d04d8f191f 100644
--- a/lib/stdlib/src/c.erl
+++ b/lib/stdlib/src/c.erl
@@ -1,25 +1,27 @@
%%
%% %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).
%% Utilities to use from shell.
+%% Avoid warning for local function error/2 clashing with autoimported BIF.
+-compile({no_auto_import,[error/2]}).
-export([help/0,lc/1,c/1,c/2,nc/1,nc/2, nl/1,l/1,i/0,i/1,ni/0,
y/1, y/2,
lc_batch/0, lc_batch/1,
@@ -31,10 +33,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 +71,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 +92,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 +130,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 +140,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 +159,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 +205,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 +234,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 +305,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 +314,6 @@ choice(F) ->
_ ->
choice(F)
end.
-
get_line(P, Default) ->
case io:get_line(P) of
@@ -305,7 +333,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 +344,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 +391,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 +423,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 +452,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 +476,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 +509,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 +562,8 @@ month(11) -> "November";
month(12) -> "December".
%% Just because we can't eval receive statements...
+-spec flush() -> 'ok'.
+
flush() ->
receive
X ->
@@ -533,9 +574,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,14 +654,18 @@ 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} ->
- ok = io:format("~s\n", [Str]);
+ ok = io:format("~ts\n", [fixup_one_bin(Str)]);
{error, _} ->
ok = io:format("Cannot determine current directory\n")
end.
+-spec cd(file:name()) -> 'ok'.
+
cd(Dir) ->
file:set_cwd(Dir),
pwd().
@@ -625,17 +674,37 @@ 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} ->
- ls_print(sort(Entries));
+ ls_print(sort(fixup_bin(Entries)));
{error,_E} ->
format("Invalid directory\n")
end.
+fixup_one_bin(X) when is_binary(X) ->
+ L = binary_to_list(X),
+ [ if
+ El > 127 ->
+ $?;
+ true ->
+ El
+ end || El <- L];
+fixup_one_bin(X) ->
+ X.
+fixup_bin([H|T]) ->
+ [fixup_one_bin(H) | fixup_bin(T)];
+fixup_bin([]) ->
+ [].
+
+
ls_print([]) -> ok;
ls_print(L) ->
Width = min([max(lengths(L, [])), 40]) + 5,
@@ -645,7 +714,7 @@ ls_print(X, Width, Len) when Width + Len >= 80 ->
io:nl(),
ls_print(X, Width, 0);
ls_print([H|T], Width, Len) ->
- io:format("~-*s",[Width,H]),
+ io:format("~-*ts",[Width,H]),
ls_print(T, Width, Len+Width);
ls_print([], _, _) ->
io:nl().
@@ -660,24 +729,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 +775,3 @@ appcall(App, M, F, Args) ->
erlang:raise(error, undef, Stk)
end
end.
-
diff --git a/lib/stdlib/src/dets.erl b/lib/stdlib/src/dets.erl
index 7f1c13770b..6c91f1efb7 100644
--- a/lib/stdlib/src/dets.erl
+++ b/lib/stdlib/src/dets.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(dets).
@@ -88,6 +88,7 @@
%% Not documented, or not ready for publication.
-export([lookup_keys/2]).
+-export_type([tab_name/0]).
-compile({inline, [{einval,2},{badarg,2},{undefined,1},
{badarg_exit,2},{lookup_reply,2}]}).
@@ -146,6 +147,7 @@
bin, % small chunk not consumed, or 'eof' at end-of-file
alloc, % the part of the file not yet scanned, mostly a binary
tab,
+ proc, % the pid of the Dets process
match_program % true | compiled_match_spec() | undefined
}).
@@ -207,8 +209,6 @@ all() ->
bchunk(Tab, start) ->
badarg(treq(Tab, {bchunk_init, Tab}), [Tab, start]);
-bchunk(Tab, #dets_cont{bin = eof, tab = Tab}) ->
- '$end_of_table';
bchunk(Tab, #dets_cont{what = bchunk, tab = Tab} = State) ->
badarg(treq(Tab, {bchunk, State}), [Tab, State]);
bchunk(Tab, Term) ->
@@ -721,11 +721,14 @@ init_chunk_match(Tab, Pat, What, N) when is_integer(N), N >= 0;
N =:= default ->
case compile_match_spec(What, Pat) of
{Spec, MP} ->
- case req(dets_server:get_pid(Tab), {match, MP, Spec, N}) of
+ Proc = dets_server:get_pid(Tab),
+ case req(Proc, {match, MP, Spec, N}) of
{done, L} ->
- {L, #dets_cont{tab = Tab, what = What, bin = eof}};
+ {L, #dets_cont{tab = Tab, proc = Proc, what = What,
+ bin = eof}};
{cont, State} ->
- chunk_match(State#dets_cont{what = What, tab = Tab});
+ chunk_match(State#dets_cont{what = What, tab = Tab,
+ proc = Proc});
Error ->
Error
end;
@@ -735,34 +738,28 @@ init_chunk_match(Tab, Pat, What, N) when is_integer(N), N >= 0;
init_chunk_match(_Tab, _Pat, _What, _) ->
badarg.
-chunk_match(State) ->
- case catch dets_server:get_pid(State#dets_cont.tab) of
- {'EXIT', _Reason} ->
- badarg;
- _Proc when State#dets_cont.bin =:= eof ->
- '$end_of_table';
- Proc ->
- case req(Proc, {match_init, State}) of
- {cont, {Bins, NewState}} ->
- MP = NewState#dets_cont.match_program,
- case catch do_foldl_bins(Bins, MP) of
- {'EXIT', _} ->
- case ets:is_compiled_ms(MP) of
- true ->
- Bad = dets_utils:bad_object(chunk_match,
- Bins),
- req(Proc, {corrupt, Bad});
- false ->
- badarg
- end;
- [] ->
- chunk_match(NewState);
- Terms ->
- {Terms, NewState}
- end;
- Error ->
- Error
- end
+chunk_match(#dets_cont{proc = Proc}=State) ->
+ case req(Proc, {match_init, State}) of
+ '$end_of_table'=Reply ->
+ Reply;
+ {cont, {Bins, NewState}} ->
+ MP = NewState#dets_cont.match_program,
+ case catch do_foldl_bins(Bins, MP) of
+ {'EXIT', _} ->
+ case ets:is_compiled_ms(MP) of
+ true ->
+ Bad = dets_utils:bad_object(chunk_match, Bins),
+ req(Proc, {corrupt, Bad});
+ false ->
+ badarg
+ end;
+ [] ->
+ chunk_match(NewState);
+ Terms ->
+ {Terms, NewState}
+ end;
+ Error ->
+ Error
end.
do_foldl_bins(Bins, true) ->
@@ -1093,7 +1090,9 @@ do_apply_op(Op, From, Head, N) ->
{N2, H2} when is_record(H2, head), is_integer(N2) ->
open_file_loop(H2, N2);
H2 when is_record(H2, head) ->
- open_file_loop(H2, N)
+ open_file_loop(H2, N);
+ {{more,From1,Op1,N1}, NewHead} ->
+ do_apply_op(Op1, From1, NewHead, N1)
catch
exit:normal ->
exit(normal);
@@ -1362,37 +1361,35 @@ start_auto_save_timer(Head) ->
%% lookup requests in parallel. Evalute delete_object, delete and
%% insert as well.
stream_op(Op, Pid, Pids, Head, N) ->
- stream_op(Head, Pids, [], N, Pid, Op, Head#head.fixed).
+ #head{fixed = Fxd, update_mode = M} = Head,
+ stream_op(Head, Pids, [], N, Pid, Op, Fxd, M).
-stream_loop(Head, Pids, C, N, false = Fxd) ->
+stream_loop(Head, Pids, C, N, false = Fxd, M) ->
receive
?DETS_CALL(From, Message) ->
- stream_op(Head, Pids, C, N, From, Message, Fxd)
+ stream_op(Head, Pids, C, N, From, Message, Fxd, M)
after 0 ->
stream_end(Head, Pids, C, N, no_more)
end;
-stream_loop(Head, Pids, C, N, _Fxd) ->
+stream_loop(Head, Pids, C, N, _Fxd, _M) ->
stream_end(Head, Pids, C, N, no_more).
-stream_op(Head, Pids, C, N, Pid, {lookup_keys,Keys}, Fxd) ->
+stream_op(Head, Pids, C, N, Pid, {lookup_keys,Keys}, Fxd, M) ->
NC = [{{lookup,Pid},Keys} | C],
- stream_loop(Head, Pids, NC, N, Fxd);
-stream_op(Head, Pids, C, N, Pid, {insert, _Objects} = Op, Fxd) ->
+ stream_loop(Head, Pids, NC, N, Fxd, M);
+stream_op(Head, Pids, C, N, Pid, {insert, _Objects} = Op, Fxd, dirty = M) ->
NC = [Op | C],
- stream_loop(Head, [Pid | Pids], NC, N, Fxd);
-stream_op(Head, Pids, C, N, Pid, {insert_new, _Objects} = Op, Fxd) ->
+ stream_loop(Head, [Pid | Pids], NC, N, Fxd, M);
+stream_op(Head, Pids, C, N, Pid, {delete_key, _Keys} = Op, Fxd, dirty = M) ->
NC = [Op | C],
- stream_loop(Head, [Pid | Pids], NC, N, Fxd);
-stream_op(Head, Pids, C, N, Pid, {delete_key, _Keys} = Op, Fxd) ->
+ stream_loop(Head, [Pid | Pids], NC, N, Fxd, M);
+stream_op(Head, Pids, C, N, Pid, {delete_object, _Os} = Op, Fxd, dirty = M) ->
NC = [Op | C],
- stream_loop(Head, [Pid | Pids], NC, N, Fxd);
-stream_op(Head, Pids, C, N, Pid, {delete_object, _Objects} = Op, Fxd) ->
- NC = [Op | C],
- stream_loop(Head, [Pid | Pids], NC, N, Fxd);
-stream_op(Head, Pids, C, N, Pid, {member, Key}, Fxd) ->
+ stream_loop(Head, [Pid | Pids], NC, N, Fxd, M);
+stream_op(Head, Pids, C, N, Pid, {member, Key}, Fxd, M) ->
NC = [{{lookup,[Pid]},[Key]} | C],
- stream_loop(Head, Pids, NC, N, Fxd);
-stream_op(Head, Pids, C, N, Pid, Op, _Fxd) ->
+ stream_loop(Head, Pids, NC, N, Fxd, M);
+stream_op(Head, Pids, C, N, Pid, Op, _Fxd, _M) ->
stream_end(Head, Pids, C, N, {Pid,Op}).
stream_end(Head, Pids0, C, N, Next) ->
@@ -1437,7 +1434,7 @@ stream_end2([], Ps, no_more, N, C, Head, _Reply) ->
penalty(Head, Ps, C),
{N, Head};
stream_end2([], _Ps, {From, Op}, N, _C, Head, _Reply) ->
- apply_op(Op, From, Head, N).
+ {{more,From,Op,N},Head}.
penalty(H, _Ps, _C) when H#head.fixed =:= false ->
ok;
@@ -1577,13 +1574,18 @@ do_bchunk_init(Head, Tab) ->
L = dets_utils:all_allocated(H2),
C0 = #dets_cont{no_objs = default, bin = <<>>, alloc = L},
BinParms = term_to_binary(Parms),
- {H2, {C0#dets_cont{tab = Tab, what = bchunk}, [BinParms]}}
+ {H2, {C0#dets_cont{tab = Tab, proc = self(),what = bchunk},
+ [BinParms]}}
end;
{NewHead, _} = HeadError when is_record(NewHead, head) ->
HeadError
end.
%% -> {NewHead, {cont(), [binary()]}} | {NewHead, Error}
+do_bchunk(Head, #dets_cont{proc = Proc}) when Proc =/= self() ->
+ {Head, badarg};
+do_bchunk(Head, #dets_cont{bin = eof}) ->
+ {Head, '$end_of_table'};
do_bchunk(Head, State) ->
case dets_v9:read_bchunks(Head, State#dets_cont.alloc) of
{error, Reason} ->
@@ -1953,6 +1955,8 @@ flookup_keys(Head, Keys) ->
end.
%% -> {NewHead, Result}
+fmatch_init(Head, #dets_cont{bin = eof}) ->
+ {Head, '$end_of_table'};
fmatch_init(Head, C) ->
case scan(Head, C) of
{scan_error, Reason} ->
diff --git a/lib/stdlib/src/dets.hrl b/lib/stdlib/src/dets.hrl
index 6e59770753..fbffc9d008 100644
--- a/lib/stdlib/src/dets.hrl
+++ b/lib/stdlib/src/dets.hrl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2001-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
@@ -18,7 +18,7 @@
%%
-define(DEFAULT_MIN_NO_SLOTS, 256).
--define(DEFAULT_MAX_NO_SLOTS, 2*1024*1024).
+-define(DEFAULT_MAX_NO_SLOTS, 32*1024*1024).
-define(DEFAULT_AUTOSAVE, 3). % minutes
-define(DEFAULT_CACHE, {3000, 14000}). % {delay,size} in {milliseconds,bytes}
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/dets_v8.erl b/lib/stdlib/src/dets_v8.erl
index 1f9f84cd27..af36958c1c 100644
--- a/lib/stdlib/src/dets_v8.erl
+++ b/lib/stdlib/src/dets_v8.erl
@@ -1074,6 +1074,8 @@ wl([], _Type, Del, Lookup, I, Objs) ->
[{Del, Lookup, Objs} | I].
%% -> {NewHead, ok} | {NewHead, Error}
+may_grow(Head, 0, once) ->
+ {Head, ok};
may_grow(Head, _N, _How) when Head#head.fixed =/= false ->
{Head, ok};
may_grow(#head{access = read}=Head, _N, _How) ->
diff --git a/lib/stdlib/src/dets_v9.erl b/lib/stdlib/src/dets_v9.erl
index 53238e962f..132af01f79 100644
--- a/lib/stdlib/src/dets_v9.erl
+++ b/lib/stdlib/src/dets_v9.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2001-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
@@ -1908,6 +1908,9 @@ write_cache(Head) ->
end.
%% -> {NewHead, ok} | {NewHead, Error}
+may_grow(Head, 0, once) ->
+ %% Do not re-hash if there is a chance that the file is not dirty.
+ {Head, ok};
may_grow(Head, _N, _How) when Head#head.fixed =/= false ->
{Head, ok};
may_grow(#head{access = read}=Head, _N, _How) ->
diff --git a/lib/stdlib/src/digraph.erl b/lib/stdlib/src/digraph.erl
index 9bdea671a9..5edc868a94 100644
--- a/lib/stdlib/src/digraph.erl
+++ b/lib/stdlib/src/digraph.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(digraph).
@@ -36,6 +36,8 @@
-export([get_short_path/3, get_short_cycle/2]).
+-export_type([digraph/0, d_type/0, vertex/0]).
+
-record(digraph, {vtab = notable :: ets:tab(),
etab = notable :: ets:tab(),
ntab = notable :: ets:tab(),
diff --git a/lib/stdlib/src/edlin.erl b/lib/stdlib/src/edlin.erl
index 6cb441dbed..026bd9038f 100644
--- a/lib/stdlib/src/edlin.erl
+++ b/lib/stdlib/src/edlin.erl
@@ -24,6 +24,7 @@
-export([init/0,start/1,edit_line/2,prefix_arg/1]).
-export([erase_line/1,erase_inp/1,redraw_line/1]).
-export([length_before/1,length_after/1,prompt/1]).
+-export([current_line/1]).
%%-export([expand/1]).
-export([edit_line1/2]).
@@ -421,6 +422,7 @@ over_paren_auto([], _, _, _) ->
%% length_before(Line)
%% length_after(Line)
%% prompt(Line)
+%% current_line(Line)
%% Various functions for accessing bits of a line.
erase_line({line,Pbs,{Bef,Aft},_}) ->
@@ -447,6 +449,9 @@ length_after({line,_,{_Bef,Aft},_}) ->
prompt({line,Pbs,_,_}) ->
Pbs.
+current_line({line,_,{Bef, Aft},_}) ->
+ reverse(Bef, Aft ++ "\n").
+
%% %% expand(CurrentBefore) ->
%% %% {yes,Expansion} | no
%% %% Try to expand the word before as either a module name or a function
diff --git a/lib/stdlib/src/epp.erl b/lib/stdlib/src/epp.erl
index 424aed3d2e..e5ccaddbb4 100644
--- a/lib/stdlib/src/epp.erl
+++ b/lib/stdlib/src/epp.erl
@@ -33,7 +33,9 @@
%% Epp state record.
-record(epp, {file, %Current file
location, %Current location
+ delta, %Offset from Location (-file)
name="", %Current file name
+ name2="", %-"-, modified by -file
istk=[], %Ifdef stack
sstk=[], %State stack
path=[], %Include-path
@@ -109,6 +111,10 @@ 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(premature_end) ->
+ "premature end";
format_error({call,What}) ->
io_lib:format("illegal macro call '~s'",[What]);
format_error({undefined,M,none}) ->
@@ -161,7 +167,7 @@ parse_file(Epp) ->
case normalize_typed_record_fields(Fields) of
{typed, NewFields} ->
[{attribute, La, record, {Record, NewFields}},
- {attribute, La, type,
+ {attribute, La, type,
{{record, Record}, Fields, []}}
|parse_file(Epp)];
not_typed ->
@@ -176,6 +182,8 @@ parse_file(Epp) ->
[{eof,Location}]
end.
+normalize_typed_record_fields([]) ->
+ {typed, []};
normalize_typed_record_fields(Fields) ->
normalize_typed_record_fields(Fields, [], false).
@@ -184,7 +192,7 @@ normalize_typed_record_fields([], NewFields, Typed) ->
true -> {typed, lists:reverse(NewFields)};
false -> not_typed
end;
-normalize_typed_record_fields([{typed_record_field,Field,_}|Rest],
+normalize_typed_record_fields([{typed_record_field,Field,_}|Rest],
NewFields, _Typed) ->
normalize_typed_record_fields(Rest, [Field|NewFields], true);
normalize_typed_record_fields([Field|Rest], NewFields, Typed) ->
@@ -228,8 +236,8 @@ init_server(Pid, Name, File, AtLocation, Path, Pdm, Pre) ->
case user_predef(Pdm, Ms0) of
{ok,Ms1} ->
epp_reply(Pid, {ok,self()}),
- St = #epp{file=File, location=AtLocation, name=Name,
- path=Path, macs=Ms1, pre_opened = Pre},
+ St = #epp{file=File, location=AtLocation, delta=0, name=Name,
+ name2=Name, path=Path, macs=Ms1, pre_opened = Pre},
From = wait_request(St),
enter_file_reply(From, Name, AtLocation, AtLocation),
wait_req_scan(St);
@@ -320,7 +328,7 @@ wait_req_scan(St) ->
wait_req_skip(St, Sis) ->
From = wait_request(St),
skip_toks(From, St, Sis).
-
+
%% enter_file(Path, FileName, IncludeToken, From, EppState)
%% leave_file(From, EppState)
%% Handle entering and leaving included files. Notify caller when the
@@ -352,8 +360,8 @@ enter_file2(NewF, Pname, From, St, AtLocation, ExtraPath) ->
enter_file_reply(From, Pname, Loc, AtLocation),
Ms = dict:store({atom,'FILE'}, {none,[{string,Loc,Pname}]}, St#epp.macs),
Path = St#epp.path ++ ExtraPath,
- #epp{location=Loc,file=NewF,
- name=Pname,sstk=[St|St#epp.sstk],path=Path,macs=Ms}.
+ #epp{file=NewF,location=Loc,name=Pname,delta=0,
+ sstk=[St|St#epp.sstk],path=Path,macs=Ms}.
enter_file_reply(From, Name, Location, AtLocation) ->
Attr = loc_attr(AtLocation),
@@ -376,23 +384,32 @@ file_name(N) when is_atom(N) ->
leave_file(From, St) ->
case St#epp.istk of
- [I|Cis] ->
+ [I|Cis] ->
epp_reply(From,
- {error,{St#epp.location,epp,
+ {error,{St#epp.location,epp,
{illegal,"unterminated",I}}}),
leave_file(wait_request(St),St#epp{istk=Cis});
[] ->
case St#epp.sstk of
[OldSt|Sts] ->
close_file(St),
- enter_file_reply(From, OldSt#epp.name,
- OldSt#epp.location, OldSt#epp.location),
+ #epp{location=OldLoc, delta=Delta, name=OldName,
+ name2=OldName2} = OldSt,
+ CurrLoc = add_line(OldLoc, Delta),
Ms = dict:store({atom,'FILE'},
- {none,
- [{string,OldSt#epp.location,
- OldSt#epp.name}]},
+ {none,[{string,CurrLoc,OldName2}]},
St#epp.macs),
- wait_req_scan(OldSt#epp{sstk=Sts,macs=Ms});
+ NextSt = OldSt#epp{sstk=Sts,macs=Ms},
+ enter_file_reply(From, OldName, CurrLoc, CurrLoc),
+ case OldName2 =:= OldName of
+ true ->
+ From;
+ false ->
+ NFrom = wait_request(NextSt),
+ enter_file_reply(NFrom, OldName2, OldLoc,
+ neg_line(CurrLoc))
+ end,
+ wait_req_scan(NextSt);
[] ->
epp_reply(From, {eof,St#epp.location}),
wait_req_scan(St)
@@ -413,7 +430,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) ->
@@ -487,28 +504,34 @@ scan_extends(_Ts, _As, Ms) -> Ms.
%% scan_define(Tokens, DefineToken, From, EppState)
-scan_define([{'(',_Lp},{Type,_Lm,M}=Mac,{',',_Lc}|Toks], _Def, From, St)
+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, Lc) 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 +557,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)
@@ -595,7 +621,7 @@ scan_undef(_Toks, Undef, From, St) ->
%% scan_include(Tokens, IncludeToken, From, St)
-scan_include([{'(',_Llp},{string,_Lf,NewName0},{')',_Lrp},{dot,_Ld}], Inc,
+scan_include([{'(',_Llp},{string,_Lf,NewName0},{')',_Lrp},{dot,_Ld}], Inc,
From, St) ->
NewName = expand_var(NewName0),
enter_file(St#epp.path, NewName, Inc, From, St);
@@ -631,7 +657,7 @@ scan_include_lib([{'(',_Llp},{string,_Lf,NewName0},{')',_Lrp},{dot,_Ld}],
case file:open(LibName, [read]) of
{ok,NewF} ->
ExtraPath = [filename:dirname(LibName)],
- wait_req_scan(enter_file2(NewF, LibName, From,
+ wait_req_scan(enter_file2(NewF, LibName, From,
St, Loc, ExtraPath));
{error,_E2} ->
epp_reply(From,
@@ -753,14 +779,15 @@ scan_file([{'(',_Llp},{string,_Ls,Name},{',',_Lc},{integer,_Li,Ln},{')',_Lrp},
Ms = dict:store({atom,'FILE'}, {none,[{string,1,Name}]}, St#epp.macs),
Locf = loc(Tf),
NewLoc = new_location(Ln, St#epp.location, Locf),
- scan_toks(From, St#epp{name=Name,location=NewLoc,macs=Ms});
+ Delta = abs(get_line(element(2, Tf)))-Ln + St#epp.delta,
+ wait_req_scan(St#epp{name2=Name,location=NewLoc,delta=Delta,macs=Ms});
scan_file(_Toks, Tf, From, St) ->
epp_reply(From, {error,{loc(Tf),epp,{bad,file}}}),
wait_req_scan(St).
new_location(Ln, Le, Lf) when is_integer(Lf) ->
Ln+(Le-Lf);
-new_location(Ln, {Le,_}, {Lf,_}) ->
+new_location(Ln, {Le,_}, {Lf,_}) ->
{Ln+(Le-Lf),1}.
%% skip_toks(From, EppState, SkipIstack)
@@ -787,7 +814,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).
@@ -801,22 +828,23 @@ skip_else(_Else, From, St, Sis) ->
skip_toks(From, St, Sis).
%% macro_pars(Tokens, ArgStack)
-%% macro_expansion(Tokens)
+%% macro_expansion(Tokens, Line)
%% Extract the macro parameters and the expansion from a macro definition.
-macro_pars([{')',_Lp}, {',',_Ld}|Ex], Args) ->
- {ok, {lists:reverse(Args), macro_expansion(Ex)}};
-macro_pars([{var,_,Name}, {')',_Lp}, {',',_Ld}|Ex], Args) ->
+macro_pars([{')',_Lp}, {',',Ld}|Ex], Args) ->
+ {ok, {lists:reverse(Args), macro_expansion(Ex, Ld)}};
+macro_pars([{var,_,Name}, {')',_Lp}, {',',Ld}|Ex], Args) ->
false = lists:member(Name, Args), %Prolog is nice
- {ok, {lists:reverse([Name|Args]), macro_expansion(Ex)}};
+ {ok, {lists:reverse([Name|Args]), macro_expansion(Ex, Ld)}};
macro_pars([{var,_L,Name}, {',',_}|Ts], Args) ->
- false = lists:member(Name, Args),
+ false = lists:member(Name, Args),
macro_pars(Ts, [Name|Args]).
-macro_expansion([{')',_Lp},{dot,_Ld}]) -> [];
-macro_expansion([{dot,_Ld}]) -> []; %Be nice, allow no right paren!
-macro_expansion([T|Ts]) ->
- [T|macro_expansion(Ts)].
+macro_expansion([{')',_Lp},{dot,_Ld}], _L0) -> [];
+macro_expansion([{dot,Ld}], _L0) -> throw({error,Ld,missing_parenthesis});
+macro_expansion([T|Ts], _L0) ->
+ [T|macro_expansion(Ts, element(2, T))];
+macro_expansion([], L0) -> throw({error,L0,premature_end}).
%% expand_macros(Tokens, Macros)
%% expand_macro(Tokens, MacroToken, RestTokens)
@@ -1071,11 +1099,11 @@ epp_reply(From, Rep) ->
wait_epp_reply(Epp, Mref) ->
receive
- {epp_reply,Epp,Rep} ->
+ {epp_reply,Epp,Rep} ->
erlang:demonitor(Mref),
receive {'DOWN',Mref,_,_,_} -> ok after 0 -> ok end,
Rep;
- {'DOWN',Mref,_,_,E} ->
+ {'DOWN',Mref,_,_,E} ->
receive {epp_reply,Epp,Rep} -> Rep
after 0 -> exit(E)
end
@@ -1116,6 +1144,9 @@ neg_line(L) ->
abs_line(L) ->
erl_scan:set_attribute(line, L, fun(Line) -> abs(Line) end).
+add_line(L, Offset) ->
+ erl_scan:set_attribute(line, L, fun(Line) -> Line+Offset end).
+
start_loc(Line) when is_integer(Line) ->
1;
start_loc({_Line, _Column}) ->
@@ -1132,7 +1163,7 @@ get_line({Line,_Column}) ->
%% mainly aimed at yecc, the parser generator, which uses the -file
%% attribute to get correct lines in messages referring to code
%% supplied by the user (actions etc in .yrl files).
-%%
+%%
%% In a perfect world (read: perfectly implemented applications such
%% as Xref, Cover, Debugger, etc.) it would not be necessary to
%% distinguish -file attributes from epp and the input file. The
@@ -1152,7 +1183,7 @@ get_line({Line,_Column}) ->
%% have been output by epp (corresponding to -include and
%% -include_lib) are kept, but the user's -file attributes are
%% removed. This seems sufficient for now.
-%%
+%%
%% It turns out to be difficult to distinguish -file attributes in the
%% input file from the ones added by epp unless some action is taken.
%% The (less than perfect) solution employed is to let epp assign
@@ -1164,7 +1195,7 @@ get_line({Line,_Column}) ->
interpret_file_attribute(Forms) ->
interpret_file_attr(Forms, 0, []).
-interpret_file_attr([{attribute,Loc,file,{File,Line}}=Form | Forms],
+interpret_file_attr([{attribute,Loc,file,{File,Line}}=Form | Forms],
Delta, Fs) ->
{line, L} = erl_scan:attributes_info(Loc, line),
if
@@ -1175,10 +1206,10 @@ interpret_file_attr([{attribute,Loc,file,{File,Line}}=Form | Forms],
%% -include or -include_lib
% true = L =:= Line,
case Fs of
- [_, Delta1, File | Fs1] -> % end of included file
- [Form | interpret_file_attr(Forms, Delta1, [File | Fs1])];
+ [_, File | Fs1] -> % end of included file
+ [Form | interpret_file_attr(Forms, 0, [File | Fs1])];
_ -> % start of included file
- [Form | interpret_file_attr(Forms, 0, [File, Delta | Fs])]
+ [Form | interpret_file_attr(Forms, 0, [File | Fs])]
end
end;
interpret_file_attr([Form0 | Forms], Delta, Fs) ->
diff --git a/lib/stdlib/src/erl_compile.erl b/lib/stdlib/src/erl_compile.erl
index d9d15e05f8..abff37e4bc 100644
--- a/lib/stdlib/src/erl_compile.erl
+++ b/lib/stdlib/src/erl_compile.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(erl_compile).
@@ -23,6 +23,8 @@
-export([compile_cmdline/1]).
+-export_type([cmd_line_arg/0]).
+
%% Mapping from extension to {M,F} to run the correct compiler.
compiler(".erl") -> {compile, compile};
diff --git a/lib/stdlib/src/erl_expand_records.erl b/lib/stdlib/src/erl_expand_records.erl
index 6fa77f2c3b..61ce41f714 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.
@@ -95,8 +95,9 @@ forms([F | Fs0], St0) ->
forms([], St) -> {[],St}.
clauses([{clause,Line,H0,G0,B0} | Cs0], St0) ->
- {H,St1} = head(H0, St0),
- {G,St2} = guard(G0, St1),
+ {H1,St1} = head(H0, St0),
+ {G1,St2} = guard(G0, St1),
+ {H,G} = optimize_is_record(H1, G1, St2),
{B,St3} = exprs(B0, St2),
{Cs,St4} = clauses(Cs0, St3),
{[{clause,Line,H,G,B} | Cs],St4};
@@ -191,7 +192,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 +346,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);
@@ -804,5 +801,137 @@ imported(F, A, St) ->
error -> no
end.
+%%%
+%%% Replace is_record/3 in guards with matching if possible.
+%%%
+
+optimize_is_record(H0, G0, #exprec{compile=Opts}) ->
+ case opt_rec_vars(G0) of
+ [] ->
+ {H0,G0};
+ Rs0 ->
+ case lists:member(no_is_record_optimization, Opts) of
+ true ->
+ {H0,G0};
+ false ->
+ {H,Rs} = opt_pattern_list(H0, Rs0),
+ G = opt_remove(G0, Rs),
+ {H,G}
+ end
+ end.
+
+
+%% opt_rec_vars(Guards) -> Vars.
+%% Search through the guard expression, looking for
+%% variables referenced in those is_record/3 calls that
+%% will fail the entire guard if they evaluate to 'false'
+%%
+%% In the following code
+%%
+%% f(X, Y, Z) when is_record(X, r1) andalso
+%% (is_record(Y, r2) orelse is_record(Z, r3))
+%%
+%% the entire guard will be false if the record test for
+%% X fails, and the clause can be rewritten to:
+%%
+%% f({r1,...}=X, Y, Z) when true andalso
+%% (is_record(Y, r2) or is_record(Z, r3))
+%%
+opt_rec_vars([G|Gs]) ->
+ Rs = opt_rec_vars_1(G, orddict:new()),
+ opt_rec_vars(Gs, Rs);
+opt_rec_vars([]) -> orddict:new().
+
+opt_rec_vars([G|Gs], Rs0) ->
+ Rs1 = opt_rec_vars_1(G, orddict:new()),
+ Rs = ordsets:intersection(Rs0, Rs1),
+ opt_rec_vars(Gs, Rs);
+opt_rec_vars([], Rs) -> Rs.
+
+opt_rec_vars_1([T|Ts], Rs0) ->
+ Rs = opt_rec_vars_2(T, Rs0),
+ opt_rec_vars_1(Ts, Rs);
+opt_rec_vars_1([], Rs) -> Rs.
+
+opt_rec_vars_2({op,_,'and',A1,A2}, Rs) ->
+ opt_rec_vars_1([A1,A2], Rs);
+opt_rec_vars_2({op,_,'andalso',A1,A2}, Rs) ->
+ opt_rec_vars_1([A1,A2], Rs);
+opt_rec_vars_2({op,_,'orelse',Arg,{atom,_,fail}}, Rs) ->
+ %% Since the second argument guarantees failure,
+ %% it is safe to inspect the first argument.
+ opt_rec_vars_2(Arg, Rs);
+opt_rec_vars_2({call,_,{remote,_,{atom,_,erlang},{atom,_,is_record}},
+ [{var,_,V},{atom,_,Tag},{integer,_,Sz}]}, Rs) ->
+ orddict:store(V, {Tag,Sz}, Rs);
+opt_rec_vars_2({call,_,{atom,_,is_record},
+ [{var,_,V},{atom,_,Tag},{integer,_,Sz}]}, Rs) ->
+ orddict:store(V, {Tag,Sz}, Rs);
+opt_rec_vars_2(_, Rs) -> Rs.
+
+opt_pattern_list(Ps, Rs) ->
+ opt_pattern_list(Ps, Rs, []).
+
+opt_pattern_list([P0|Ps], Rs0, Acc) ->
+ {P,Rs} = opt_pattern(P0, Rs0),
+ opt_pattern_list(Ps, Rs, [P|Acc]);
+opt_pattern_list([], Rs, Acc) ->
+ {reverse(Acc),Rs}.
+
+opt_pattern({var,_,V}=Var, Rs0) ->
+ case orddict:find(V, Rs0) of
+ {ok,{Tag,Sz}} ->
+ Rs = orddict:store(V, {remove,Tag,Sz}, Rs0),
+ {opt_var(Var, Tag, Sz),Rs};
+ _ ->
+ {Var,Rs0}
+ end;
+opt_pattern({cons,Line,H0,T0}, Rs0) ->
+ {H,Rs1} = opt_pattern(H0, Rs0),
+ {T,Rs} = opt_pattern(T0, Rs1),
+ {{cons,Line,H,T},Rs};
+opt_pattern({tuple,Line,Es0}, Rs0) ->
+ {Es,Rs} = opt_pattern_list(Es0, Rs0),
+ {{tuple,Line,Es},Rs};
+opt_pattern({match,Line,Pa0,Pb0}, Rs0) ->
+ {Pa,Rs1} = opt_pattern(Pa0, Rs0),
+ {Pb,Rs} = opt_pattern(Pb0, Rs1),
+ {{match,Line,Pa,Pb},Rs};
+opt_pattern(P, Rs) -> {P,Rs}.
+
+opt_var({var,Line,_}=Var, Tag, Sz) ->
+ Rp = record_pattern(2, -1, ignore, Sz, Line, [{atom,Line,Tag}]),
+ {match,Line,{tuple,Line,Rp},Var}.
+
+opt_remove(Gs, Rs) ->
+ [opt_remove_1(G, Rs) || G <- Gs].
+
+opt_remove_1(Ts, Rs) ->
+ [opt_remove_2(T, Rs) || T <- Ts].
+
+opt_remove_2({op,L,'and'=Op,A1,A2}, Rs) ->
+ {op,L,Op,opt_remove_2(A1, Rs),opt_remove_2(A2, Rs)};
+opt_remove_2({op,L,'andalso'=Op,A1,A2}, Rs) ->
+ {op,L,Op,opt_remove_2(A1, Rs),opt_remove_2(A2, Rs)};
+opt_remove_2({op,L,'orelse',A1,A2}, Rs) ->
+ {op,L,'orelse',opt_remove_2(A1, Rs),A2};
+opt_remove_2({call,Line,{remote,_,{atom,_,erlang},{atom,_,is_record}},
+ [{var,_,V},{atom,_,Tag},{integer,_,Sz}]}=A, Rs) ->
+ case orddict:find(V, Rs) of
+ {ok,{remove,Tag,Sz}} ->
+ {atom,Line,true};
+ _ ->
+ A
+ end;
+opt_remove_2({call,Line,{atom,_,is_record},
+ [{var,_,V},{atom,_,Tag},{integer,_,Sz}]}=A, Rs) ->
+ case orddict:find(V, Rs) of
+ {ok,{remove,Tag,Sz}} ->
+ {atom,Line,true};
+ _ ->
+ A
+ end;
+opt_remove_2(A, _) -> A.
+
neg_line(L) ->
erl_parse:set_line(L, fun(Line) -> -abs(Line) end).
diff --git a/lib/stdlib/src/erl_internal.erl b/lib/stdlib/src/erl_internal.erl
index 16173d8210..b30b02a96f 100644
--- a/lib/stdlib/src/erl_internal.erl
+++ b/lib/stdlib/src/erl_internal.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_internal).
@@ -48,7 +48,7 @@
%%
-export([bif/2,bif/3,guard_bif/2,
- type_test/2,new_type_test/2,old_type_test/2]).
+ type_test/2,new_type_test/2,old_type_test/2,old_bif/2]).
-export([arith_op/2,bool_op/2,comp_op/2,list_op/2,send_op/2,op_type/2]).
%%---------------------------------------------------------------------------
@@ -87,6 +87,8 @@ guard_bif(is_reference, 1) -> true;
guard_bif(is_tuple, 1) -> true;
guard_bif(is_record, 2) -> true;
guard_bif(is_record, 3) -> true;
+guard_bif(binary_part, 2) -> true;
+guard_bif(binary_part, 3) -> true;
guard_bif(Name, A) when is_atom(Name), is_integer(A) -> false.
%% Erlang type tests.
@@ -229,11 +231,14 @@ bif(apply, 2) -> true;
bif(apply, 3) -> true;
bif(atom_to_binary, 2) -> true;
bif(atom_to_list, 1) -> true;
+bif(binary_part, 2) -> true;
+bif(binary_part, 3) -> true;
bif(binary_to_atom, 2) -> true;
bif(binary_to_existing_atom, 2) -> true;
bif(binary_to_list, 1) -> true;
bif(binary_to_list, 3) -> true;
bif(binary_to_term, 1) -> true;
+bif(binary_to_term, 2) -> true;
bif(bitsize, 1) -> true;
bif(bit_size, 1) -> true;
bif(bitstring_to_list, 1) -> true;
@@ -242,10 +247,14 @@ bif(check_process_code, 2) -> true;
bif(concat_binary, 1) -> true;
bif(date, 0) -> true;
bif(delete_module, 1) -> true;
+bif(demonitor, 1) -> true;
+bif(demonitor, 2) -> true;
bif(disconnect_node, 1) -> true;
bif(element, 2) -> true;
bif(erase, 0) -> true;
bif(erase, 1) -> true;
+bif(error, 1) -> true;
+bif(error, 2) -> true;
bif(exit, 1) -> true;
bif(exit, 2) -> true;
bif(float, 1) -> true;
@@ -261,6 +270,7 @@ bif(halt, 0) -> true;
bif(halt, 1) -> true;
bif(hd, 1) -> true;
bif(integer_to_list, 1) -> true;
+bif(integer_to_list, 2) -> true;
bif(iolist_size, 1) -> true;
bif(iolist_to_binary, 1) -> true;
bif(is_alive, 0) -> true;
@@ -290,11 +300,16 @@ bif(list_to_bitstring, 1) -> true;
bif(list_to_existing_atom, 1) -> true;
bif(list_to_float, 1) -> true;
bif(list_to_integer, 1) -> true;
+bif(list_to_integer, 2) -> true;
bif(list_to_pid, 1) -> true;
bif(list_to_tuple, 1) -> true;
bif(load_module, 2) -> true;
bif(make_ref, 0) -> true;
+bif(max,2) -> true;
+bif(min,2) -> true;
bif(module_loaded, 1) -> true;
+bif(monitor, 2) -> true;
+bif(monitor, 3) -> true;
bif(monitor_node, 2) -> true;
bif(node, 0) -> true;
bif(node, 1) -> true;
@@ -305,6 +320,7 @@ bif(open_port, 2) -> true;
bif(pid_to_list, 1) -> true;
bif(port_close, 1) -> true;
bif(port_command, 2) -> true;
+bif(port_command, 3) -> true;
bif(port_connect, 2) -> true;
bif(port_control, 3) -> true;
bif(pre_loaded, 0) -> true;
@@ -349,3 +365,134 @@ bif(unlink, 1) -> true;
bif(unregister, 1) -> true;
bif(whereis, 1) -> true;
bif(Name, A) when is_atom(Name), is_integer(A) -> false.
+
+-spec old_bif(Name::atom(), Arity::arity()) -> boolean().
+%% Returns true if erlang:Name/Arity is an old (pre R14) auto-imported BIF, false otherwise.
+%% Use erlang:is_bultin(Mod, Name, Arity) to find whether a function is a BIF
+%% (meaning implemented in C) or not.
+
+old_bif(abs, 1) -> true;
+old_bif(apply, 2) -> true;
+old_bif(apply, 3) -> true;
+old_bif(atom_to_binary, 2) -> true;
+old_bif(atom_to_list, 1) -> true;
+old_bif(binary_to_atom, 2) -> true;
+old_bif(binary_to_existing_atom, 2) -> true;
+old_bif(binary_to_list, 1) -> true;
+old_bif(binary_to_list, 3) -> true;
+old_bif(binary_to_term, 1) -> true;
+old_bif(bitsize, 1) -> true;
+old_bif(bit_size, 1) -> true;
+old_bif(bitstring_to_list, 1) -> true;
+old_bif(byte_size, 1) -> true;
+old_bif(check_process_code, 2) -> true;
+old_bif(concat_binary, 1) -> true;
+old_bif(date, 0) -> true;
+old_bif(delete_module, 1) -> true;
+old_bif(disconnect_node, 1) -> true;
+old_bif(element, 2) -> true;
+old_bif(erase, 0) -> true;
+old_bif(erase, 1) -> true;
+old_bif(exit, 1) -> true;
+old_bif(exit, 2) -> true;
+old_bif(float, 1) -> true;
+old_bif(float_to_list, 1) -> true;
+old_bif(garbage_collect, 0) -> true;
+old_bif(garbage_collect, 1) -> true;
+old_bif(get, 0) -> true;
+old_bif(get, 1) -> true;
+old_bif(get_keys, 1) -> true;
+old_bif(group_leader, 0) -> true;
+old_bif(group_leader, 2) -> true;
+old_bif(halt, 0) -> true;
+old_bif(halt, 1) -> true;
+old_bif(hd, 1) -> true;
+old_bif(integer_to_list, 1) -> true;
+old_bif(iolist_size, 1) -> true;
+old_bif(iolist_to_binary, 1) -> true;
+old_bif(is_alive, 0) -> true;
+old_bif(is_process_alive, 1) -> true;
+old_bif(is_atom, 1) -> true;
+old_bif(is_boolean, 1) -> true;
+old_bif(is_binary, 1) -> true;
+old_bif(is_bitstr, 1) -> true;
+old_bif(is_bitstring, 1) -> true;
+old_bif(is_float, 1) -> true;
+old_bif(is_function, 1) -> true;
+old_bif(is_function, 2) -> true;
+old_bif(is_integer, 1) -> true;
+old_bif(is_list, 1) -> true;
+old_bif(is_number, 1) -> true;
+old_bif(is_pid, 1) -> true;
+old_bif(is_port, 1) -> true;
+old_bif(is_reference, 1) -> true;
+old_bif(is_tuple, 1) -> true;
+old_bif(is_record, 2) -> true;
+old_bif(is_record, 3) -> true;
+old_bif(length, 1) -> true;
+old_bif(link, 1) -> true;
+old_bif(list_to_atom, 1) -> true;
+old_bif(list_to_binary, 1) -> true;
+old_bif(list_to_bitstring, 1) -> true;
+old_bif(list_to_existing_atom, 1) -> true;
+old_bif(list_to_float, 1) -> true;
+old_bif(list_to_integer, 1) -> true;
+old_bif(list_to_pid, 1) -> true;
+old_bif(list_to_tuple, 1) -> true;
+old_bif(load_module, 2) -> true;
+old_bif(make_ref, 0) -> true;
+old_bif(module_loaded, 1) -> true;
+old_bif(monitor_node, 2) -> true;
+old_bif(node, 0) -> true;
+old_bif(node, 1) -> true;
+old_bif(nodes, 0) -> true;
+old_bif(nodes, 1) -> true;
+old_bif(now, 0) -> true;
+old_bif(open_port, 2) -> true;
+old_bif(pid_to_list, 1) -> true;
+old_bif(port_close, 1) -> true;
+old_bif(port_command, 2) -> true;
+old_bif(port_connect, 2) -> true;
+old_bif(port_control, 3) -> true;
+old_bif(pre_loaded, 0) -> true;
+old_bif(process_flag, 2) -> true;
+old_bif(process_flag, 3) -> true;
+old_bif(process_info, 1) -> true;
+old_bif(process_info, 2) -> true;
+old_bif(processes, 0) -> true;
+old_bif(purge_module, 1) -> true;
+old_bif(put, 2) -> true;
+old_bif(register, 2) -> true;
+old_bif(registered, 0) -> true;
+old_bif(round, 1) -> true;
+old_bif(self, 0) -> true;
+old_bif(setelement, 3) -> true;
+old_bif(size, 1) -> true;
+old_bif(spawn, 1) -> true;
+old_bif(spawn, 2) -> true;
+old_bif(spawn, 3) -> true;
+old_bif(spawn, 4) -> true;
+old_bif(spawn_link, 1) -> true;
+old_bif(spawn_link, 2) -> true;
+old_bif(spawn_link, 3) -> true;
+old_bif(spawn_link, 4) -> true;
+old_bif(spawn_monitor, 1) -> true;
+old_bif(spawn_monitor, 3) -> true;
+old_bif(spawn_opt, 2) -> true;
+old_bif(spawn_opt, 3) -> true;
+old_bif(spawn_opt, 4) -> true;
+old_bif(spawn_opt, 5) -> true;
+old_bif(split_binary, 2) -> true;
+old_bif(statistics, 1) -> true;
+old_bif(term_to_binary, 1) -> true;
+old_bif(term_to_binary, 2) -> true;
+old_bif(throw, 1) -> true;
+old_bif(time, 0) -> true;
+old_bif(tl, 1) -> true;
+old_bif(trunc, 1) -> true;
+old_bif(tuple_size, 1) -> true;
+old_bif(tuple_to_list, 1) -> true;
+old_bif(unlink, 1) -> true;
+old_bif(unregister, 1) -> true;
+old_bif(whereis, 1) -> true;
+old_bif(Name, A) when is_atom(Name), is_integer(A) -> false.
diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl
index 91f7641af7..0c2d3db8ec 100644
--- a/lib/stdlib/src/erl_lint.erl
+++ b/lib/stdlib/src/erl_lint.erl
@@ -40,7 +40,7 @@
%% Value.
%% The option handling functions.
--spec bool_option(atom(), atom(), boolean(), [_]) -> boolean().
+-spec bool_option(atom(), atom(), boolean(), [compile:option()]) -> boolean().
bool_option(On, Off, Default, Opts) ->
foldl(fun (Opt, _Def) when Opt =:= On -> true;
@@ -72,6 +72,10 @@ value_option(Flag, Default, On, OnVal, Off, OffVal, Opts) ->
%%-define(DEBUGF(X,Y), io:format(X, Y)).
-define(DEBUGF(X,Y), void).
+-type line() :: erl_scan:line(). % a convenient alias
+-type fa() :: {atom(), arity()}. % function+arity
+-type ta() :: {atom(), arity()}. % type+arity
+
%% Usage of records, functions, and imports. The variable table, which
%% is passed on as an argument, holds the usage of variables.
-record(usage, {
@@ -94,9 +98,11 @@ value_option(Flag, Default, On, OnVal, Off, OffVal, Opts) ->
mod_imports=dict:new() :: dict(), %Module Imports
compile=[], %Compile flags
records=dict:new() :: dict(), %Record definitions
+ locals=gb_sets:empty() :: gb_set(), %All defined functions (prescanned)
+ no_auto=gb_sets:empty() :: gb_set(), %Functions explicitly not autoimported
defined=gb_sets:empty() :: gb_set(), %Defined fuctions
- on_load=[] :: [{atom(),integer()}], %On-load function
- on_load_line=0 :: integer(), %Line for on_load
+ on_load=[] :: [fa()], %On-load function
+ on_load_line=0 :: line(), %Line for on_load
clashes=[], %Exported functions named as BIFs
not_deprecated=[], %Not considered deprecated
func=[], %Current function
@@ -110,10 +116,11 @@ value_option(Flag, Default, On, OnVal, Off, OffVal, Opts) ->
%outside any fun or lc
xqlc= false :: boolean(), %true if qlc.hrl included
new = false :: boolean(), %Has user-defined 'new/N'
- called= [], %Called functions
+ called= [] :: [{fa(),line()}], %Called functions
usage = #usage{} :: #usage{},
specs = dict:new() :: dict(), %Type specifications
- types = dict:new() :: dict() %Type definitions
+ types = dict:new() :: dict(), %Type definitions
+ exp_types=gb_sets:empty():: gb_set() %Exported types
}).
-type lint_state() :: #lint{}.
@@ -161,6 +168,9 @@ format_error({bad_nowarn_unused_function,{F,A}}) ->
io_lib:format("function ~w/~w undefined", [F,A]);
format_error({bad_nowarn_bif_clash,{F,A}}) ->
io_lib:format("function ~w/~w undefined", [F,A]);
+format_error(disallowed_nowarn_bif_clash) ->
+ io_lib:format("compile directive nowarn_bif_clash is no longer allowed,~n"
+ " - use explicit module names or -compile({no_auto_import, [F/A]})", []);
format_error({bad_nowarn_deprecated_function,{M,F,A}}) ->
io_lib:format("~w:~w/~w is not a deprecated function", [M,F,A]);
format_error({bad_on_load,Term}) ->
@@ -186,13 +196,21 @@ format_error({define_import,{F,A}}) ->
io_lib:format("defining imported function ~w/~w", [F,A]);
format_error({unused_function,{F,A}}) ->
io_lib:format("function ~w/~w is unused", [F,A]);
-format_error({redefine_bif,{F,A}}) ->
- io_lib:format("defining BIF ~w/~w", [F,A]);
format_error({call_to_redefined_bif,{F,A}}) ->
- io_lib:format("call to ~w/~w will call erlang:~w/~w; "
- "not ~w/~w in this module \n"
- " (add an explicit module name to the call to avoid this error)",
- [F,A,F,A,F,A]);
+ io_lib:format("ambiguous call of overridden auto-imported BIF ~w/~w~n"
+ " - use erlang:~w/~w or \"-compile({no_auto_import,[~w/~w]}).\" "
+ "to resolve name clash", [F,A,F,A,F,A]);
+format_error({call_to_redefined_old_bif,{F,A}}) ->
+ io_lib:format("ambiguous call of overridden pre R14 auto-imported BIF ~w/~w~n"
+ " - use erlang:~w/~w or \"-compile({no_auto_import,[~w/~w]}).\" "
+ "to resolve name clash", [F,A,F,A,F,A]);
+format_error({redefine_old_bif_import,{F,A}}) ->
+ io_lib:format("import directive overrides pre R14 auto-imported BIF ~w/~w~n"
+ " - use \"-compile({no_auto_import,[~w/~w]}).\" "
+ "to resolve name clash", [F,A,F,A]);
+format_error({redefine_bif_import,{F,A}}) ->
+ io_lib:format("import directive overrides auto-imported BIF ~w/~w~n"
+ " - use \"-compile({no_auto_import,[~w/~w]}).\" to resolve name clash", [F,A,F,A]);
format_error({deprecated, MFA, ReplacementMFA, Rel}) ->
io_lib:format("~s is deprecated and will be removed in ~s; use ~s",
@@ -213,6 +231,9 @@ format_error(illegal_pattern) -> "illegal pattern";
format_error(illegal_bin_pattern) ->
"binary patterns cannot be matched in parallel using '='";
format_error(illegal_expr) -> "illegal expression";
+format_error({illegal_guard_local_call, {F,A}}) ->
+ io_lib:format("call to local/imported function ~w/~w is illegal in guard",
+ [F,A]);
format_error(illegal_guard_expr) -> "illegal guard expression";
%% --- exports ---
format_error({explicit_export,F,A}) ->
@@ -242,10 +263,10 @@ format_error({untyped_record,T}) ->
format_error({unbound_var,V}) ->
io_lib:format("variable ~w is unbound", [V]);
format_error({unsafe_var,V,{What,Where}}) ->
- io_lib:format("variable ~w unsafe in ~w ~s",
+ io_lib:format("variable ~w unsafe in ~w ~s",
[V,What,format_where(Where)]);
format_error({exported_var,V,{What,Where}}) ->
- io_lib:format("variable ~w exported from ~w ~s",
+ io_lib:format("variable ~w exported from ~w ~s",
[V,What,format_where(Where)]);
format_error({shadowed_var,V,In}) ->
io_lib:format("variable ~w shadowed in ~w", [V,In]);
@@ -290,22 +311,26 @@ format_error({ill_defined_behaviour_callbacks,Behaviour}) ->
%% --- types and specs ---
format_error({singleton_typevar, Name}) ->
io_lib:format("type variable ~w is only used once (is unbound)", [Name]);
+format_error({bad_export_type, _ETs}) ->
+ io_lib:format("bad export_type declaration", []);
+format_error({duplicated_export_type, {T, A}}) ->
+ io_lib:format("type ~w/~w already exported", [T, A]);
format_error({undefined_type, {TypeName, Arity}}) ->
io_lib:format("type ~w~s undefined", [TypeName, gen_type_paren(Arity)]);
format_error({unused_type, {TypeName, Arity}}) ->
io_lib:format("type ~w~s is unused", [TypeName, gen_type_paren(Arity)]);
format_error({new_builtin_type, {TypeName, Arity}}) ->
io_lib:format("type ~w~s is a new builtin type; "
- "its (re)definition is allowed only until the next release",
+ "its (re)definition is allowed only until the next release",
[TypeName, gen_type_paren(Arity)]);
format_error({builtin_type, {TypeName, Arity}}) ->
- io_lib:format("type ~w~s is a builtin type; it cannot be redefined",
+ io_lib:format("type ~w~s is a builtin type; it cannot be redefined",
[TypeName, gen_type_paren(Arity)]);
format_error({renamed_type, OldName, NewName}) ->
io_lib:format("type ~w() is now called ~w(); "
"please use the new name instead", [OldName, NewName]);
format_error({redefine_type, {TypeName, Arity}}) ->
- io_lib:format("type ~w~s already defined",
+ io_lib:format("type ~w~s already defined",
[TypeName, gen_type_paren(Arity)]);
format_error({type_syntax, Constr}) ->
io_lib:format("bad ~w type", [Constr]);
@@ -354,7 +379,7 @@ pseudolocals() ->
%%
%% Used by erl_eval.erl to check commands.
-%%
+%%
exprs(Exprs, BindingsList) ->
exprs_opt(Exprs, BindingsList, []).
@@ -362,7 +387,7 @@ exprs_opt(Exprs, BindingsList, Opts) ->
{St0,Vs} = foldl(fun({{record,_SequenceNumber,_Name},Attr0}, {St1,Vs1}) ->
Attr = zip_file_and_line(Attr0, "none"),
{attribute_state(Attr, St1),Vs1};
- ({V,_}, {St1,Vs1}) ->
+ ({V,_}, {St1,Vs1}) ->
{St1,[{V,{bound,unused,[]}} | Vs1]}
end, {start("nofile",Opts),[]}, BindingsList),
Vt = orddict:from_list(Vs),
@@ -391,7 +416,7 @@ module(Forms) ->
Opts = compiler_options(Forms),
St = forms(Forms, start("nofile", Opts)),
return_status(St).
-
+
module(Forms, FileName) ->
Opts = compiler_options(Forms),
St = forms(Forms, start(FileName, Opts)),
@@ -506,7 +531,7 @@ pack_errors(Es) ->
%% Sort on line number.
pack_warnings(Ws) ->
- [{File,lists:sort([W || {F,W} <- Ws, F =:= File])} ||
+ [{File,lists:sort([W || {F,W} <- Ws, F =:= File])} ||
File <- lists:usort([F || {F,_} <- Ws])].
%% add_error(ErrorDescriptor, State) -> State'
@@ -516,13 +541,13 @@ pack_warnings(Ws) ->
add_error(E, St) -> St#lint{errors=[{St#lint.file,E}|St#lint.errors]}.
-add_error(FileLine, E, St) ->
+add_error(FileLine, E, St) ->
{File,Location} = loc(FileLine),
add_error({Location,erl_lint,E}, St#lint{file = File}).
add_warning(W, St) -> St#lint{warnings=[{St#lint.file,W}|St#lint.warnings]}.
-add_warning(FileLine, W, St) ->
+add_warning(FileLine, W, St) ->
{File,Location} = loc(FileLine),
add_warning({Location,erl_lint,W}, St#lint{file = File}).
@@ -538,8 +563,12 @@ loc(L) ->
forms(Forms0, St0) ->
Forms = eval_file_attribute(Forms0, St0),
+ Locals = local_functions(Forms),
+ AutoImportSuppressed = auto_import_suppressed(St0#lint.compile),
+ StDeprecated = disallowed_compile_flags(Forms,St0),
%% Line numbers are from now on pairs {File,Line}.
- St1 = includes_qlc_hrl(Forms, St0),
+ St1 = includes_qlc_hrl(Forms, StDeprecated#lint{locals = Locals,
+ no_auto = AutoImportSuppressed}),
St2 = bif_clashes(Forms, St1),
St3 = not_deprecated(Forms, St2),
St4 = foldl(fun form/2, pre_scan(Forms, St3), Forms),
@@ -561,7 +590,7 @@ pre_scan([_ | Fs], St) ->
pre_scan(Fs, St);
pre_scan([], St) ->
St.
-
+
includes_qlc_hrl(Forms, St) ->
%% QLC calls erl_lint several times, sometimes with the compile
%% attribute removed. The file attribute, however, is left as is.
@@ -667,6 +696,8 @@ attribute_state({attribute,L,extends,_M}, St) ->
add_error(L, invalid_extends, St);
attribute_state({attribute,L,export,Es}, St) ->
export(L, Es, St);
+attribute_state({attribute,L,export_type,Es}, St) ->
+ export_type(L, Es, St);
attribute_state({attribute,L,import,Is}, St) ->
import(L, Is, St);
attribute_state({attribute,L,record,{Name,Fields}}, St) ->
@@ -724,27 +755,38 @@ bif_clashes(Forms, St) ->
Clashes = ordsets:subtract(ordsets:from_list(Clashes0), Nowarn),
St#lint{clashes=Clashes}.
--spec is_bif_clash(atom(), byte(), lint_state()) -> boolean().
-
-is_bif_clash(_Name, _Arity, #lint{clashes=[]}) ->
- false;
-is_bif_clash(Name, Arity, #lint{clashes=Clashes}) ->
- ordsets:is_element({Name,Arity}, Clashes).
-
%% not_deprecated(Forms, State0) -> State
not_deprecated(Forms, St0) ->
%% There are no line numbers in St0#lint.compile.
- MFAsL = [{MFA,L} ||
+ MFAsL = [{MFA,L} ||
{attribute, L, compile, Args} <- Forms,
{nowarn_deprecated_function, MFAs0} <- lists:flatten([Args]),
MFA <- lists:flatten([MFAs0])],
Nowarn = [MFA || {MFA,_L} <- MFAsL],
- Bad = [MFAL || {{M,F,A},_L}=MFAL <- MFAsL,
+ Bad = [MFAL || {{M,F,A},_L}=MFAL <- MFAsL,
otp_internal:obsolete(M, F, A) =:= no],
St1 = func_line_warning(bad_nowarn_deprecated_function, Bad, St0),
St1#lint{not_deprecated = ordsets:from_list(Nowarn)}.
+%% The nowarn_bif_clash directive is not only deprecated, it's actually an error from R14A
+disallowed_compile_flags(Forms, St0) ->
+ %% There are (still) no line numbers in St0#lint.compile.
+ Errors0 = [ {St0#lint.file,{L,erl_lint,disallowed_nowarn_bif_clash}} ||
+ {attribute,[{line,{_,L}}],compile,nowarn_bif_clash} <- Forms ],
+ Errors1 = [ {St0#lint.file,{L,erl_lint,disallowed_nowarn_bif_clash}} ||
+ {attribute,[{line,{_,L}}],compile,{nowarn_bif_clash, {_,_}}} <- Forms ],
+ Disabled = (not is_warn_enabled(bif_clash, St0)),
+ Errors = if
+ Disabled andalso Errors0 =:= [] ->
+ [{St0#lint.file,{erl_lint,disallowed_nowarn_bif_clash}} | St0#lint.errors];
+ Disabled ->
+ Errors0 ++ Errors1 ++ St0#lint.errors;
+ true ->
+ Errors1 ++ St0#lint.errors
+ end,
+ St0#lint{errors=Errors}.
+
%% post_traversal_check(Forms, State0) -> State.
%% Do some further checking after the forms have been traversed and
%% data about calls etc. have been collected.
@@ -862,7 +904,7 @@ check_deprecated(Forms, St0) ->
Bad = [{E,L} || {attribute, L, deprecated, Depr} <- Forms,
D <- lists:flatten([Depr]),
E <- depr_cat(D, X, Mod)],
- foldl(fun ({E,L}, St1) ->
+ foldl(fun ({E,L}, St1) ->
add_error(L, E, St1)
end, St0, Bad).
@@ -912,7 +954,7 @@ check_imports(Forms, St0) ->
true ->
Usage = St0#lint.usage,
Unused = ordsets:subtract(St0#lint.imports, Usage#usage.imported),
- Imports = [{{FA,list_to_atom(package_to_string(Mod))},L}
+ Imports = [{{FA,list_to_atom(package_to_string(Mod))},L}
|| {attribute,L,import,{Mod,Fs}} <- Forms,
FA <- lists:usort(Fs)],
Bad = [{FM,L} || FM <- Unused, {FM2,L} <- Imports, FM =:= FM2],
@@ -932,7 +974,7 @@ check_unused_functions(Forms, St0) ->
Opts = St1#lint.compile,
case member(export_all, Opts) orelse
not is_warn_enabled(unused_function, St1) of
- true ->
+ true ->
St1;
false ->
Nowarn = nowarn_function(nowarn_unused_function, Opts),
@@ -1003,12 +1045,13 @@ check_option_functions(Forms, Tag0, Type, St0) ->
{Tag, FAs0} <- lists:flatten([Args]),
Tag0 =:= Tag,
FA <- lists:flatten([FAs0])],
- DefFunctions = gb_sets:to_list(St0#lint.defined) -- pseudolocals(),
+ DefFunctions = (gb_sets:to_list(St0#lint.defined) -- pseudolocals()) ++
+ [{F,A} || {{F,A},_} <- orddict:to_list(St0#lint.imports)],
Bad = [{FA,L} || {FA,L} <- FAsL, not member(FA, DefFunctions)],
func_line_error(Type, Bad, St0).
nowarn_function(Tag, Opts) ->
- ordsets:from_list([FA || {Tag1,FAs} <- Opts,
+ ordsets:from_list([FA || {Tag1,FAs} <- Opts,
Tag1 =:= Tag,
FA <- lists:flatten([FAs])]).
@@ -1021,11 +1064,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 +1078,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.
@@ -1051,10 +1091,10 @@ check_unused_records(Forms, St0) ->
%% functions count.
Usage = St0#lint.usage,
UsedRecords = sets:to_list(Usage#usage.used_records),
- URecs = foldl(fun (Used, Recs) ->
- dict:erase(Used, Recs)
+ URecs = foldl(fun (Used, Recs) ->
+ dict:erase(Used, Recs)
end, St0#lint.records, UsedRecords),
- Unused = [{Name,FileLine} ||
+ Unused = [{Name,FileLine} ||
{Name,{FileLine,_Fields}} <- dict:to_list(URecs),
element(1, loc(FileLine)) =:= FirstFile],
foldl(fun ({N,L}, St) ->
@@ -1064,18 +1104,19 @@ check_unused_records(Forms, St0) ->
St0
end.
-%% For storing the import list we use the orddict module.
+%% For storing the import list we use the orddict module.
%% We know an empty set is [].
-%% export(Line, Exports, State) -> State.
+-spec export(line(), [fa()], lint_state()) -> lint_state().
%% Mark functions as exported, also as called from the export line.
export(Line, Es, #lint{exports = Es0, called = Called} = St0) ->
- {Es1,C1,St1} =
+ {Es1,C1,St1} =
foldl(fun (NA, {E,C,St2}) ->
St = case gb_sets:is_element(NA, E) of
true ->
- add_warning(Line, {duplicated_export, NA}, St2);
+ Warn = {duplicated_export,NA},
+ add_warning(Line, Warn, St2);
false ->
St2
end,
@@ -1084,8 +1125,31 @@ export(Line, Es, #lint{exports = Es0, called = Called} = St0) ->
{Es0,Called,St0}, Es),
St1#lint{exports = Es1, called = C1}.
-%% import(Line, Imports, State) -> State.
-%% imported(Name, Arity, State) -> {yes,Module} | no.
+-spec export_type(line(), [ta()], lint_state()) -> lint_state().
+%% Mark types as exported; also mark them as used from the export line.
+
+export_type(Line, ETs, #lint{usage = Usage, exp_types = ETs0} = St0) ->
+ UTs0 = Usage#usage.used_types,
+ try foldl(fun ({T,A}=TA, {E,U,St2}) when is_atom(T), is_integer(A) ->
+ St = case gb_sets:is_element(TA, E) of
+ true ->
+ Warn = {duplicated_export_type,TA},
+ add_warning(Line, Warn, St2);
+ false ->
+ St2
+ end,
+ {gb_sets:add_element(TA, E), dict:store(TA, Line, U), St}
+ end,
+ {ETs0,UTs0,St0}, ETs) of
+ {ETs1,UTs1,St1} ->
+ St1#lint{usage = Usage#usage{used_types = UTs1}, exp_types = ETs1}
+ catch
+ error:_ ->
+ add_error(Line, {bad_export_type, ETs}, St0)
+ end.
+
+-type import() :: {module(), [fa()]} | module().
+-spec import(line(), import(), lint_state()) -> lint_state().
import(Line, {Mod,Fs}, St) ->
Mod1 = package_to_string(Mod),
@@ -1097,11 +1161,41 @@ import(Line, {Mod,Fs}, St) ->
St#lint{imports=add_imports(list_to_atom(Mod1), Mfs,
St#lint.imports)};
Efs ->
- foldl(fun (Ef, St0) ->
- add_error(Line, {redefine_import,Ef},
- St0)
+ {Err, St1} =
+ foldl(fun ({bif,{F,A},_}, {Err,St0}) ->
+ %% BifClash - import directive
+ Warn = is_warn_enabled(bif_clash, St0)
+ and (not bif_clash_specifically_disabled(St0,{F,A})),
+ AutoImpSup = is_autoimport_suppressed(St0#lint.no_auto,{F,A}),
+ OldBif = erl_internal:old_bif(F,A),
+ {Err,if
+ Warn and (not AutoImpSup) and OldBif ->
+ add_error
+ (Line,
+ {redefine_old_bif_import, {F,A}},
+ St0);
+ Warn and (not AutoImpSup) ->
+ add_warning
+ (Line,
+ {redefine_bif_import, {F,A}},
+ St0);
+ true ->
+ St0
+ end};
+ (Ef, {_Err,St0}) ->
+ {true,add_error(Line,
+ {redefine_import,Ef},
+ St0)}
end,
- St, Efs)
+ {false,St}, Efs),
+ if
+ not Err ->
+ St1#lint{imports=
+ add_imports(list_to_atom(Mod1), Mfs,
+ St#lint.imports)};
+ true ->
+ St1
+ end
end;
false ->
add_error(Line, {bad_module_name, Mod1}, St)
@@ -1144,13 +1238,15 @@ check_imports(_Line, Fs, Is) ->
add_imports(Mod, Fs, Is) ->
foldl(fun (F, Is0) -> orddict:store(F, Mod, Is0) end, Is, Fs).
+-spec imported(atom(), arity(), lint_state()) -> {'yes',module()} | 'no'.
+
imported(F, A, St) ->
case orddict:find({F,A}, St#lint.imports) of
{ok,Mod} -> {yes,Mod};
error -> no
end.
-%% on_load(Line, Val, State) -> State.
+-spec on_load(line(), fa(), lint_state()) -> lint_state().
%% Check an on_load directive and remember it.
on_load(Line, {Name,Arity}=Fa, #lint{on_load=OnLoad0}=St0)
@@ -1182,7 +1278,7 @@ check_on_load(#lint{defined=Defined,on_load=[{_,0}=Fa],
end;
check_on_load(St) -> St.
-%% call_function(Line, Name, Arity, State) -> State.
+-spec call_function(line(), atom(), arity(), lint_state()) -> lint_state().
%% Add to both called and calls.
call_function(Line, F, A, #lint{usage=Usage0,called=Cd,func=Func}=St) ->
@@ -1194,12 +1290,6 @@ call_function(Line, F, A, #lint{usage=Usage0,called=Cd,func=Func}=St) ->
end,
St#lint{called=[{NA,Line}|Cd], usage=Usage}.
-%% is_function_exported(Name, Arity, State) -> false|true.
-
-is_function_exported(Name, Arity, #lint{exports=Exports,compile=Compile}) ->
- gb_sets:is_element({Name,Arity}, Exports) orelse
- member(export_all, Compile).
-
%% function(Line, Name, Arity, Clauses, State) -> State.
function(Line, instance, _Arity, _Cs, St) when St#lint.global_vt =/= [] ->
@@ -1208,7 +1298,7 @@ function(Line, Name, Arity, Cs, St0) ->
St1 = define_function(Line, Name, Arity, St0#lint{func={Name,Arity}}),
clauses(Cs, St1#lint.global_vt, St1).
-%% define_function(Line, Name, Arity, State) -> State.
+-spec define_function(line(), atom(), arity(), lint_state()) -> lint_state().
define_function(Line, Name, Arity, St0) ->
St1 = keyword_warning(Line, Name, St0),
@@ -1218,14 +1308,9 @@ define_function(Line, Name, Arity, St0) ->
add_error(Line, {redefine_function,NA}, St1);
false ->
St2 = St1#lint{defined=gb_sets:add_element(NA, St1#lint.defined)},
- St = case erl_internal:bif(Name, Arity) andalso
- not is_function_exported(Name, Arity, St2) of
- true -> add_warning(Line, {redefine_bif,NA}, St2);
- false -> St2
- end,
- case imported(Name, Arity, St) of
- {yes,_M} -> add_error(Line, {define_import,NA}, St);
- no -> St
+ case imported(Name, Arity, St2) of
+ {yes,_M} -> add_error(Line, {define_import,NA}, St2);
+ no -> St2
end
end.
@@ -1261,7 +1346,7 @@ head([P|Ps], Vt, Old, St0) ->
{vtmerge_pat(Pvt, Psvt),vtmerge_pat(Bvt1,Bvt2),St2};
head([], _Vt, _Env, St) -> {[],[],St}.
-%% pattern(Pattern, VarTable, Old, BinVarTable, State) ->
+%% pattern(Pattern, VarTable, Old, BinVarTable, State) ->
%% {UpdVarTable,BinVarTable,State}.
%% Check pattern return variables. Old is the set of variables used for
%% deciding whether an occurrence is a binding occurrence or a use, and
@@ -1279,7 +1364,7 @@ pattern(P, Vt, St) ->
pattern({var,_Line,'_'}, _Vt, _Old, _Bvt, St) ->
{[],[],St}; %Ignore anonymous variable
-pattern({var,Line,V}, _Vt, Old, Bvt, St) ->
+pattern({var,Line,V}, _Vt, Old, Bvt, St) ->
pat_var(V, Line, Old, Bvt, St);
pattern({char,_Line,_C}, _Vt, _Old, _Bvt, St) -> {[],[],St};
pattern({integer,_Line,_I}, _Vt, _Old, _Bvt, St) -> {[],[],St};
@@ -1297,7 +1382,7 @@ pattern({tuple,_Line,Ps}, Vt, Old, Bvt, St) ->
%%pattern({struct,_Line,_Tag,Ps}, Vt, Old, Bvt, St) ->
%% pattern_list(Ps, Vt, Old, Bvt, St);
pattern({record_index,Line,Name,Field}, _Vt, _Old, _Bvt, St) ->
- {Vt1,St1} =
+ {Vt1,St1} =
check_record(Line, Name, St,
fun (Dfs, St1) ->
pattern_field(Field, Name, Dfs, St1)
@@ -1312,7 +1397,7 @@ pattern({record_field,Line,_,_}=M, _Vt, _Old, _Bvt, St0) ->
end;
pattern({record,Line,Name,Pfs}, Vt, Old, Bvt, St) ->
case dict:find(Name, St#lint.records) of
- {ok,{_Line,Fields}} ->
+ {ok,{_Line,Fields}} ->
St1 = used_record(Name, St),
pattern_fields(Pfs, Name, Fields, Vt, Old, Bvt, St1);
error -> {[],[],add_error(Line, {undefined_record,Name}, St)}
@@ -1372,7 +1457,7 @@ reject_bin_alias({cons,_,H1,T1}, {cons,_,H2,T2}, St0) ->
reject_bin_alias(T1, T2, St);
reject_bin_alias({tuple,_,Es1}, {tuple,_,Es2}, St) ->
reject_bin_alias_list(Es1, Es2, St);
-reject_bin_alias({record,_,Name1,Pfs1}, {record,_,Name2,Pfs2},
+reject_bin_alias({record,_,Name1,Pfs1}, {record,_,Name2,Pfs2},
#lint{records=Recs}=St) ->
case {dict:find(Name1, Recs),dict:find(Name2, Recs)} of
{{ok,{_Line1,Fields1}},{ok,{_Line2,Fields2}}} ->
@@ -1454,7 +1539,7 @@ is_pattern_expr_1({op,_Line,Op,A1,A2}) ->
erl_internal:arith_op(Op, 2) andalso all(fun is_pattern_expr/1, [A1,A2]);
is_pattern_expr_1(_Other) -> false.
-%% pattern_bin([Element], VarTable, Old, BinVarTable, State) ->
+%% pattern_bin([Element], VarTable, Old, BinVarTable, State) ->
%% {UpdVarTable,UpdBinVarTable,State}.
%% Check a pattern group. BinVarTable are used binsize variables.
@@ -1501,7 +1586,7 @@ good_string_size_type(default, Ts) ->
end, Ts);
good_string_size_type(_, _) -> false.
-%% pat_bit_expr(Pattern, OldVarTable, BinVarTable,State) ->
+%% pat_bit_expr(Pattern, OldVarTable, BinVarTable,State) ->
%% {UpdVarTable,UpdBinVarTable,State}.
%% Check pattern bit expression, only allow really valid patterns!
@@ -1516,7 +1601,7 @@ pat_bit_expr(P, _Old, _Bvt, St) ->
false -> {[],[],add_error(element(2, P), illegal_pattern, St)}
end.
-%% pat_bit_size(Size, VarTable, BinVarTable, State) ->
+%% pat_bit_size(Size, VarTable, BinVarTable, State) ->
%% {Value,UpdVarTable,UpdBinVarTable,State}.
%% Check pattern size expression, only allow really valid sizes!
@@ -1599,7 +1684,7 @@ bit_size_check(Line, Size, #bittype{type=Type,unit=Unit}, St) ->
Sz = Unit * Size, %Total number of bits!
St2 = elemtype_check(Line, Type, Sz, St),
{Sz,St2}.
-
+
elemtype_check(_Line, float, 32, St) -> St;
elemtype_check(_Line, float, 64, St) -> St;
elemtype_check(Line, float, _Size, St) ->
@@ -1681,8 +1766,6 @@ gexpr({cons,_Line,H,T}, Vt, St) ->
gexpr_list([H,T], Vt, St);
gexpr({tuple,_Line,Es}, Vt, St) ->
gexpr_list(Es, Vt, St);
-%%gexpr({struct,_Line,_Tag,Es}, Vt, St) ->
-%% gexpr_list(Es, Vt, St);
gexpr({record_index,Line,Name,Field}, _Vt, St) ->
check_record(Line, Name, St,
fun (Dfs, St1) -> record_field(Field, Name, Dfs, St1) end );
@@ -1713,7 +1796,7 @@ gexpr({call,_Line,{atom,_Lr,is_record},[E,{atom,Ln,Name}]}, Vt, St0) ->
gexpr({call,Line,{atom,_Lr,is_record},[E,R]}, Vt, St0) ->
{Asvt,St1} = gexpr_list([E,R], Vt, St0),
{Asvt,add_error(Line, illegal_guard_expr, St1)};
-gexpr({call,Line,{remote,_Lr,{atom,_Lm,erlang},{atom,Lf,is_record}},[E,A]},
+gexpr({call,Line,{remote,_Lr,{atom,_Lm,erlang},{atom,Lf,is_record}},[E,A]},
Vt, St0) ->
gexpr({call,Line,{atom,Lf,is_record},[E,A]}, Vt, St0);
gexpr({call,_Line,{atom,_Lr,is_record},[E,{atom,_,_Name},{integer,_,_}]},
@@ -1728,14 +1811,22 @@ gexpr({call,Line,{remote,_,{atom,_,erlang},{atom,_,is_record}=Isr},[_,_,_]=Args}
gexpr({call,Line,{atom,_La,F},As}, Vt, St0) ->
{Asvt,St1} = gexpr_list(As, Vt, St0),
A = length(As),
- case erl_internal:guard_bif(F, A) of
+ %% BifClash - Function called in guard
+ case erl_internal:guard_bif(F, A) andalso no_guard_bif_clash(St1,{F,A}) of
true ->
%% Also check that it is auto-imported.
case erl_internal:bif(F, A) of
true -> {Asvt,St1};
false -> {Asvt,add_error(Line, {explicit_export,F,A}, St1)}
end;
- false -> {Asvt,add_error(Line, illegal_guard_expr, St1)}
+ false ->
+ case is_local_function(St1#lint.locals,{F,A}) orelse
+ is_imported_function(St1#lint.imports,{F,A}) of
+ true ->
+ {Asvt,add_error(Line, {illegal_guard_local_call,{F,A}}, St1)};
+ _ ->
+ {Asvt,add_error(Line, illegal_guard_expr, St1)}
+ end
end;
gexpr({call,Line,{remote,_Lr,{atom,_Lm,erlang},{atom,_Lf,F}},As}, Vt, St0) ->
{Asvt,St1} = gexpr_list(As, Vt, St0),
@@ -1780,7 +1871,7 @@ is_guard_test(E) ->
%% is_guard_test(Expression, Forms) -> boolean().
is_guard_test(Expression, Forms) ->
RecordAttributes = [A || A = {attribute, _, record, _D} <- Forms],
- St0 = foldl(fun(Attr0, St1) ->
+ St0 = foldl(fun(Attr0, St1) ->
Attr = zip_file_and_line(Attr0, "none"),
attribute_state(Attr, St1)
end, start(), RecordAttributes),
@@ -1801,7 +1892,7 @@ is_guard_test2(G, RDs) ->
%% is_guard_expr(Expression) -> boolean().
%% Test if an expression is a guard expression.
-is_guard_expr(E) -> is_gexpr(E, []).
+is_guard_expr(E) -> is_gexpr(E, []).
is_gexpr({var,_L,_V}, _RDs) -> true;
is_gexpr({char,_L,_C}, _RDs) -> true;
@@ -1823,7 +1914,7 @@ is_gexpr({record_field,_L,Rec,_Name,Field}, RDs) ->
is_gexpr({record,L,Name,Inits}, RDs) ->
is_gexpr_fields(Inits, L, Name, RDs);
is_gexpr({bin,_L,Fs}, RDs) ->
- all(fun ({bin_element,_Line,E,Sz,_Ts}) ->
+ all(fun ({bin_element,_Line,E,Sz,_Ts}) ->
is_gexpr(E, RDs) and (Sz =:= default orelse is_gexpr(Sz, RDs))
end, Fs);
is_gexpr({call,_L,{atom,_Lf,F},As}, RDs) ->
@@ -1898,15 +1989,13 @@ expr({bc,_Line,E,Qs}, Vt0, St0) ->
{vtold(Vt,Vt0),St}; %Don't export local variables
expr({tuple,_Line,Es}, Vt, St) ->
expr_list(Es, Vt, St);
-%%expr({struct,Line,Tag,Es}, Vt, St) ->
-%% expr_list(Es, Vt, St);
expr({record_index,Line,Name,Field}, _Vt, St) ->
check_record(Line, Name, St,
fun (Dfs, St1) -> record_field(Field, Name, Dfs, St1) end);
expr({record,Line,Name,Inits}, Vt, St) ->
check_record(Line, Name, St,
- fun (Dfs, St1) ->
- init_fields(Inits, Line, Name, Dfs, Vt, St1)
+ fun (Dfs, St1) ->
+ init_fields(Inits, Line, Name, Dfs, Vt, St1)
end);
expr({record_field,Line,_,_}=M, _Vt, St0) ->
case expand_package(M, St0) of
@@ -1943,8 +2032,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) ->
@@ -1963,8 +2050,11 @@ expr({'fun',Line,Body}, Vt, St) ->
{Bvt, St1} = fun_clauses(Cs, Vt, St),
{vtupdate(Bvt, Vt), St1};
{function,F,A} ->
+ %% BifClash - Fun expression
%% N.B. Only allows BIFs here as well, NO IMPORTS!!
- case erl_internal:bif(F, A) of
+ case ((not is_local_function(St#lint.locals,{F,A})) andalso
+ (erl_internal:bif(F, A) andalso
+ (not is_autoimport_suppressed(St#lint.no_auto,{F,A})))) of
true -> {[],St};
false -> {[],call_function(Line, F, A, St)}
end;
@@ -1974,7 +2064,7 @@ expr({'fun',Line,Body}, Vt, St) ->
expr({call,_Line,{atom,_Lr,is_record},[E,{atom,Ln,Name}]}, Vt, St0) ->
{Rvt,St1} = expr(E, Vt, St0),
{Rvt,exist_record(Ln, Name, St1)};
-expr({call,Line,{remote,_Lr,{atom,_Lm,erlang},{atom,Lf,is_record}},[E,A]},
+expr({call,Line,{remote,_Lr,{atom,_Lm,erlang},{atom,Lf,is_record}},[E,A]},
Vt, St0) ->
expr({call,Line,{atom,Lf,is_record},[E,A]}, Vt, St0);
expr({call,L,{tuple,Lt,[{atom,Lm,erlang},{atom,Lf,is_record}]},As}, Vt, St) ->
@@ -1997,29 +2087,54 @@ expr({call,Line,{atom,La,F},As}, Vt, St0) ->
St1 = keyword_warning(La, F, St0),
{Asvt,St2} = expr_list(As, Vt, St1),
A = length(As),
- case erl_internal:bif(F, A) of
+ IsLocal = is_local_function(St2#lint.locals,{F,A}),
+ IsAutoBif = erl_internal:bif(F, A),
+ AutoSuppressed = is_autoimport_suppressed(St2#lint.no_auto,{F,A}),
+ Warn = is_warn_enabled(bif_clash, St2) and (not bif_clash_specifically_disabled(St2,{F,A})),
+ Imported = imported(F, A, St2),
+ case ((not IsLocal) andalso (Imported =:= no) andalso
+ IsAutoBif andalso (not AutoSuppressed)) of
true ->
St3 = deprecated_function(Line, erlang, F, As, St2),
- {Asvt,case is_warn_enabled(bif_clash, St3) andalso
- is_bif_clash(F, A, St3) of
- false ->
- St3;
- true ->
- add_error(Line, {call_to_redefined_bif,{F,A}}, St3)
- end};
+ {Asvt,St3};
false ->
- {Asvt,case imported(F, A, St2) of
+ {Asvt,case Imported of
{yes,M} ->
St3 = check_remote_function(Line, M, F, As, St2),
U0 = St3#lint.usage,
Imp = ordsets:add_element({{F,A},M},U0#usage.imported),
St3#lint{usage=U0#usage{imported = Imp}};
no ->
- case {F,A} of
- {record_info,2} ->
+ case {F,A} of
+ {record_info,2} ->
check_record_info_call(Line,La,As,St2);
- N when N =:= St2#lint.func -> St2;
- _ -> call_function(Line, F, A, St2)
+ N ->
+ %% BifClash - function call
+ %% Issue these warnings/errors even if it's a recursive call
+ St3 = if
+ (not AutoSuppressed) andalso IsAutoBif andalso Warn ->
+ case erl_internal:old_bif(F,A) of
+ true ->
+ add_error
+ (Line,
+ {call_to_redefined_old_bif, {F,A}},
+ St2);
+ false ->
+ add_warning
+ (Line,
+ {call_to_redefined_bif, {F,A}},
+ St2)
+ end;
+ true ->
+ St2
+ end,
+ %% ...but don't lint recursive calls
+ if
+ N =:= St3#lint.func ->
+ St3;
+ true ->
+ call_function(Line, F, A, St3)
+ end
end
end}
end;
@@ -2160,7 +2275,7 @@ def_fields(Fs0, Name, St0) ->
foldl(fun ({record_field,Lf,{atom,La,F},V}, {Fs,St}) ->
case exist_field(F, Fs) of
true -> {Fs,add_error(Lf, {redefine_field,Name,F}, St)};
- false ->
+ false ->
St1 = St#lint{recdef_top = true},
{_,St2} = expr(V, [], St1),
%% Warnings and errors found are kept, but
@@ -2311,7 +2426,7 @@ init_fields(Ifs, Line, Name, Dfs, Vt0, St0) ->
Defs = init_fields(Ifs, Line, Dfs),
{_,St2} = check_fields(Defs, Name, Dfs, Vt1, St1, fun expr/3),
{Vt1,St1#lint{usage = St2#lint.usage}}.
-
+
ginit_fields(Ifs, Line, Name, Dfs, Vt0, St0) ->
{Vt1,St1} = check_fields(Ifs, Name, Dfs, Vt0, St0, fun gexpr/3),
Defs = init_fields(Ifs, Line, Dfs),
@@ -2321,7 +2436,7 @@ ginit_fields(Ifs, Line, Name, Dfs, Vt0, St0) ->
IllErrs = [E || {_File,{_Line,erl_lint,illegal_guard_expr}}=E <- Errors],
St4 = St1#lint{usage = Usage, errors = IllErrs ++ St1#lint.errors},
{Vt1,St4}.
-
+
%% Default initializations to be carried out
init_fields(Ifs, Line, Dfs) ->
[ {record_field,Lf,{atom,La,F},copy_expr(Di, Line)} ||
@@ -2399,7 +2514,7 @@ check_type({ann_type, _L, [_Var, Type]}, SeenVars, St) ->
check_type(Type, SeenVars, St);
check_type({paren_type, _L, [Type]}, SeenVars, St) ->
check_type(Type, SeenVars, St);
-check_type({remote_type, L, [{atom, _, Mod}, {atom, _, Name}, Args]},
+check_type({remote_type, L, [{atom, _, Mod}, {atom, _, Name}, Args]},
SeenVars, #lint{module=CurrentMod} = St) ->
St1 =
case (dict:is_key({Name, length(Args)}, default_types())
@@ -2437,7 +2552,7 @@ check_type({type, L, 'fun', [Dom, Range]}, SeenVars, St) ->
check_type({type, -1, product, [Dom, Range]}, SeenVars, St1);
check_type({type, L, range, [From, To]}, SeenVars, St) ->
St1 =
- case {From, To} of
+ case {erl_eval:partial_eval(From), erl_eval:partial_eval(To)} of
{{integer, _, X}, {integer, _, Y}} when X < Y -> St;
_ -> add_error(L, {type_syntax, range}, St)
end,
@@ -2446,8 +2561,8 @@ check_type({type, _L, tuple, any}, SeenVars, St) -> {SeenVars, St};
check_type({type, _L, any}, SeenVars, St) -> {SeenVars, St};
check_type({type, L, binary, [Base, Unit]}, SeenVars, St) ->
St1 =
- case {Base, Unit} of
- {{integer, _, BaseVal},
+ case {erl_eval:partial_eval(Base), erl_eval:partial_eval(Unit)} of
+ {{integer, _, BaseVal},
{integer, _, UnitVal}} when BaseVal >= 0, UnitVal >= 0 -> St;
_ -> add_error(L, {type_syntax, binary}, St)
end,
@@ -2472,7 +2587,13 @@ check_type({type, La, TypeName, Args}, SeenVars, #lint{usage=Usage} = St) ->
UsedTypes = dict:store({TypeName, Arity}, La, OldUsed),
St#lint{usage=Usage#usage{used_types=UsedTypes}}
end,
- check_type({type, -1, product, Args}, SeenVars, St1).
+ check_type({type, -1, product, Args}, SeenVars, St1);
+check_type(I, SeenVars, St) ->
+ case erl_eval:partial_eval(I) of
+ {integer,_ILn,_Integer} -> {SeenVars, St};
+ _Other ->
+ {SeenVars, add_error(element(2, I), {type_syntax, integer}, St)}
+ end.
check_record_types(Line, Name, Fields, SeenVars, St) ->
case dict:find(Name, St#lint.records) of
@@ -2480,12 +2601,12 @@ check_record_types(Line, Name, Fields, SeenVars, St) ->
case lists:all(fun({type, _, field_type, _}) -> true;
(_) -> false
end, Fields) of
- true ->
+ true ->
check_record_types(Fields, Name, DefFields, SeenVars, St, []);
false ->
{SeenVars, add_error(Line, {type_syntax, record}, St)}
end;
- error ->
+ error ->
{SeenVars, add_error(Line, {undefined_record, Name}, St)}
end.
@@ -2568,7 +2689,6 @@ default_types() ->
{set, 0},
{string, 0},
{term, 0},
- {tid, 0},
{timeout, 0},
{var, 1}],
dict:from_list([{T, -1} || T <- DefTypes]).
@@ -2590,7 +2710,6 @@ is_newly_introduced_builtin_type({gb_tree, 0}) -> true; % opaque
is_newly_introduced_builtin_type({iodata, 0}) -> true;
is_newly_introduced_builtin_type({queue, 0}) -> true; % opaque
is_newly_introduced_builtin_type({set, 0}) -> true; % opaque
-is_newly_introduced_builtin_type({tid, 0}) -> true; % opaque
%% R13B01
is_newly_introduced_builtin_type({boolean, 0}) -> true;
is_newly_introduced_builtin_type({Name, _}) when is_atom(Name) -> false.
@@ -2611,7 +2730,7 @@ spec_decl(Line, MFA0, TypeSpecs, St0 = #lint{specs = Specs, module = Mod}) ->
check_specs([FunType|Left], Arity, St0) ->
{FunType1, CTypes} =
case FunType of
- {type, _, bounded_fun, [FT = {type, _, 'fun', _}, Cs]} ->
+ {type, _, bounded_fun, [FT = {type, _, 'fun', _}, Cs]} ->
Types0 = [T || {type, _, constraint, [_, T]} <- Cs],
{FT, lists:append(Types0)};
{type, _, 'fun', _} = FT -> {FT, []}
@@ -2671,10 +2790,12 @@ add_missing_spec_warnings(Forms, St0, Type) ->
add_warning(L, {missing_spec,FA}, St)
end, St0, Warns).
-check_unused_types(Forms, St = #lint{usage=Usage, types=Types}) ->
+check_unused_types(Forms, #lint{usage=Usage, types=Ts, exp_types=ExpTs}=St) ->
case [File || {attribute,_L,file,{File,_Line}} <- Forms] of
[FirstFile|_] ->
- UsedTypes = Usage#usage.used_types,
+ D = Usage#usage.used_types,
+ L = gb_sets:to_list(ExpTs) ++ dict:fetch_keys(D),
+ UsedTypes = gb_sets:from_list(L),
FoldFun =
fun(_Type, -1, AccSt) ->
%% Default type
@@ -2682,19 +2803,18 @@ check_unused_types(Forms, St = #lint{usage=Usage, types=Types}) ->
(Type, FileLine, AccSt) ->
case loc(FileLine) of
{FirstFile, _} ->
- case dict:is_key(Type, UsedTypes) of
+ case gb_sets:is_member(Type, UsedTypes) of
true -> AccSt;
- false ->
- add_warning(FileLine,
- {unused_type, Type},
- AccSt)
+ false ->
+ Warn = {unused_type,Type},
+ add_warning(FileLine, Warn, AccSt)
end;
_ ->
- %% Don't warn about unused types in include file
+ %% No warns about unused types in include files
AccSt
end
end,
- dict:fold(FoldFun, St, Types);
+ dict:fold(FoldFun, St, Ts);
[] ->
St
end.
@@ -2720,45 +2840,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)),
@@ -2878,7 +2959,7 @@ fun_clause({clause,_Line,H,G,B}, Vt0, St0) ->
%%
%% used variable has been used
%% unused variable has been bound but not used
-%%
+%%
%% Lines is a list of line numbers where the variable was bound.
%%
%% Report variable errors/warnings as soon as possible and then change
@@ -2908,9 +2989,9 @@ pat_var(V, Line, Vt, Bvt, St) ->
case orddict:find(V, Bvt) of
{ok, {bound,_Usage,Ls}} ->
{[],[{V,{bound,used,Ls}}],St};
- error ->
+ error ->
case orddict:find(V, Vt) of
- {ok,{bound,_Usage,Ls}} ->
+ {ok,{bound,_Usage,Ls}} ->
{[{V,{bound,used,Ls}}],[],St};
{ok,{{unsafe,In},_Usage,Ls}} ->
{[{V,{bound,used,Ls}}],[],
@@ -2963,7 +3044,7 @@ pat_binsize_var(V, Line, Vt, Bvt, St) ->
expr_var(V, Line, Vt, St0) ->
case orddict:find(V, Vt) of
- {ok,{bound,_Usage,Ls}} ->
+ {ok,{bound,_Usage,Ls}} ->
{[{V,{bound,used,Ls}}],St0};
{ok,{{unsafe,In},_Usage,Ls}} ->
{[{V,{bound,used,Ls}}],
@@ -3001,7 +3082,7 @@ check_old_unused_vars(Vt, Vt0, St0) ->
warn_unused_vars(U, Vt, St0).
unused_vars(Vt, Vt0, _St0) ->
- U0 = orddict:filter(fun (V, {_State,unused,_Ls}) ->
+ U0 = orddict:filter(fun (V, {_State,unused,_Ls}) ->
case atom_to_list(V) of
"_"++_ -> false;
_ -> true
@@ -3017,7 +3098,7 @@ warn_unused_vars(U, Vt, St0) ->
false -> St0;
true ->
foldl(fun ({V,{_,unused,Ls}}, St) ->
- foldl(fun (L, St2) ->
+ foldl(fun (L, St2) ->
add_warning(L, {unused_var,V},
St2)
end, St, Ls)
@@ -3117,7 +3198,7 @@ vt_no_unsafe(Vt) -> [V || {_,{S,_U,_L}}=V <- Vt,
-ifdef(NOTUSED).
vunion(Vs1, Vs2) -> ordsets:union(vtnames(Vs1), vtnames(Vs2)).
-vunion(Vss) -> foldl(fun (Vs, Uvs) ->
+vunion(Vss) -> foldl(fun (Vs, Uvs) ->
ordsets:union(vtnames(Vs), Uvs)
end, [], Vss).
@@ -3147,7 +3228,7 @@ modify_line(T, F0) ->
%% Forms.
modify_line1({function,F,A}, _Mf) -> {function,F,A};
modify_line1({function,M,F,A}, _Mf) -> {function,M,F,A};
-modify_line1({attribute,L,record,{Name,Fields}}, Mf) ->
+modify_line1({attribute,L,record,{Name,Fields}}, Mf) ->
{attribute,Mf(L),record,{Name,modify_line1(Fields, Mf)}};
modify_line1({attribute,L,spec,{Fun,Types}}, Mf) ->
{attribute,Mf(L),spec,{Fun,modify_line1(Types, Mf)}};
@@ -3162,7 +3243,7 @@ modify_line1({warning,W}, _Mf) -> {warning,W};
modify_line1({error,W}, _Mf) -> {error,W};
%% Expressions.
modify_line1({clauses,Cs}, Mf) -> {clauses,modify_line1(Cs, Mf)};
-modify_line1({typed_record_field,Field,Type}, Mf) ->
+modify_line1({typed_record_field,Field,Type}, Mf) ->
{typed_record_field,modify_line1(Field, Mf),modify_line1(Type, Mf)};
modify_line1({Tag,L}, Mf) -> {Tag,Mf(L)};
modify_line1({Tag,L,E1}, Mf) ->
@@ -3198,7 +3279,7 @@ check_record_info_call(Line,_La,_As,St) ->
has_wildcard_field([{record_field,_Lf,{var,_La,'_'},_Val}|_Fs]) -> true;
has_wildcard_field([_|Fs]) -> has_wildcard_field(Fs);
has_wildcard_field([]) -> false.
-
+
%% check_remote_function(Line, ModuleName, FuncName, [Arg], State) -> State.
%% Perform checks on known remote calls.
@@ -3214,7 +3295,7 @@ check_remote_function(Line, M, F, As, St0) ->
check_qlc_hrl(Line, M, F, As, St) ->
Arity = length(As),
case As of
- [{lc,_L,_E,_Qs}|_] when M =:= qlc, F =:= q,
+ [{lc,_L,_E,_Qs}|_] when M =:= qlc, F =:= q,
Arity < 3, not St#lint.xqlc ->
add_warning(Line, {missing_qlc_hrl, Arity}, St);
_ ->
@@ -3399,11 +3480,11 @@ extract_sequence(3, [$.,_|Fmt], Need) ->
extract_sequence(4, Fmt, Need);
extract_sequence(3, Fmt, Need) ->
extract_sequence(4, Fmt, Need);
-extract_sequence(4, [$t, $c | Fmt], Need) ->
- extract_sequence(5, [$c|Fmt], Need);
-extract_sequence(4, [$t, $s | Fmt], Need) ->
- extract_sequence(5, [$s|Fmt], Need);
-extract_sequence(4, [$t, C | _Fmt], _Need) ->
+extract_sequence(4, [$t, $c | Fmt], Need) ->
+ extract_sequence(5, [$c|Fmt], Need);
+extract_sequence(4, [$t, $s | Fmt], Need) ->
+ extract_sequence(5, [$s|Fmt], Need);
+extract_sequence(4, [$t, C | _Fmt], _Need) ->
{error,"invalid control ~t" ++ [C]};
extract_sequence(4, Fmt, Need) ->
extract_sequence(5, Fmt, Need);
@@ -3481,3 +3562,56 @@ expand_package(M, St0) ->
{error, St1}
end
end.
+
+
+%% Prebuild set of local functions (to override auto-import)
+local_functions(Forms) ->
+ gb_sets:from_list([ {Func,Arity} || {function,_,Func,Arity,_} <- Forms ]).
+%% Predicate to find out if the function is locally defined
+is_local_function(LocalSet,{Func,Arity}) ->
+ gb_sets:is_element({Func,Arity},LocalSet).
+%% Predicate to see if a function is explicitly imported
+is_imported_function(ImportSet,{Func,Arity}) ->
+ case orddict:find({Func,Arity}, ImportSet) of
+ {ok,_Mod} -> true;
+ error -> false
+ end.
+%% Predicate to see if a function is explicitly imported from the erlang module
+is_imported_from_erlang(ImportSet,{Func,Arity}) ->
+ case orddict:find({Func,Arity}, ImportSet) of
+ {ok,erlang} -> true;
+ _ -> false
+ end.
+%% Build set of functions where auto-import is explicitly supressed
+auto_import_suppressed(CompileFlags) ->
+ L0 = [ X || {no_auto_import,X} <- CompileFlags ],
+ L1 = [ {Y,Z} || {Y,Z} <- lists:flatten(L0), is_atom(Y), is_integer(Z) ],
+ gb_sets:from_list(L1).
+%% Predicate to find out if autoimport is explicitly supressed for a function
+is_autoimport_suppressed(NoAutoSet,{Func,Arity}) ->
+ gb_sets:is_element({Func,Arity},NoAutoSet).
+%% Predicate to find out if a function specific bif-clash supression (old deprecated) is present
+bif_clash_specifically_disabled(St,{F,A}) ->
+ Nowarn = nowarn_function(nowarn_bif_clash, St#lint.compile),
+ lists:member({F,A},Nowarn).
+
+%% Predicate to find out if an autoimported guard_bif is not overriden in some way
+%% Guard Bif without module name is disallowed if
+%% * It is overridden by local function
+%% * It is overridden by -import and that import is not of itself (i.e. from module erlang)
+%% * The autoimport is suppressed or it's not reimported by -import directive
+%% Otherwise it's OK (given that it's actually a guard bif and actually is autoimported)
+no_guard_bif_clash(St,{F,A}) ->
+ (
+ (not is_local_function(St#lint.locals,{F,A}))
+ andalso
+ (
+ (not is_imported_function(St#lint.imports,{F,A})) orelse
+ is_imported_from_erlang(St#lint.imports,{F,A})
+ )
+ andalso
+ (
+ (not is_autoimport_suppressed(St#lint.no_auto, {F,A})) orelse
+ is_imported_from_erlang(St#lint.imports,{F,A})
+ )
+ ).
diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl
index fd5d905797..bb4b18cf9b 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
@@ -49,22 +47,22 @@ opt_bit_size_expr bit_size_expr opt_bit_type_list bit_type_list bit_type
top_type top_type_100 top_types type typed_expr typed_attr_val
type_sig type_sigs type_guard type_guards fun_type fun_type_100 binary_type
type_spec spec_fun typed_exprs typed_record_fields field_types field_type
-bin_base_type bin_unit_type int_type.
+bin_base_type bin_unit_type type_200 type_300 type_400 type_500.
Terminals
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'
'++' '--'
'==' '/=' '=<' '<' '>=' '>' '=:=' '=/=' '<='
'<<' '>>'
-'!' '=' '::'
+'!' '=' '::' '..' '...'
+'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'].
@@ -124,58 +120,68 @@ top_types -> top_type ',' top_types : ['$1'|'$3'].
top_type -> var '::' top_type_100 : {ann_type, ?line('$1'), ['$1','$3']}.
top_type -> top_type_100 : '$1'.
-top_type_100 -> type : '$1'.
-top_type_100 -> type '|' top_type_100 : lift_unions('$1','$3').
+top_type_100 -> type_200 : '$1'.
+top_type_100 -> type_200 '|' top_type_100 : lift_unions('$1','$3').
+
+type_200 -> type_300 '..' type_300 : {type, ?line('$1'), range,
+ [skip_paren('$1'),
+ skip_paren('$3')]}.
+type_200 -> type_300 : '$1'.
+
+type_300 -> type_300 add_op type_400 : ?mkop2(skip_paren('$1'),
+ '$2', skip_paren('$3')).
+type_300 -> type_400 : '$1'.
+
+type_400 -> type_400 mult_op type_500 : ?mkop2(skip_paren('$1'),
+ '$2', skip_paren('$3')).
+type_400 -> type_500 : '$1'.
+
+type_500 -> prefix_op type : ?mkop1('$1', skip_paren('$2')).
+type_500 -> type : '$1'.
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,
- ['$1', '$4']}.
+type -> integer : '$1'.
type -> 'fun' '(' ')' : {type, ?line('$1'), 'fun', []}.
type -> 'fun' '(' fun_type_100 ')' : '$3'.
-int_type -> integer : '$1'.
-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']}.
+ [{type, ?line('$1'), any}, '$5']}.
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'))]}.
@@ -184,9 +190,9 @@ binary_type -> '<<' bin_unit_type '>>' : {type, ?line('$1'),binary,
binary_type -> '<<' bin_base_type ',' bin_unit_type '>>'
: {type, ?line('$1'), binary, ['$2', '$4']}.
-bin_base_type -> var ':' integer : build_bin_type(['$1'], '$3').
+bin_base_type -> var ':' type : build_bin_type(['$1'], '$3').
-bin_unit_type -> var ':' var '*' integer : build_bin_type(['$1', '$3'], '$5').
+bin_unit_type -> var ':' var '*' type : build_bin_type(['$1', '$3'], '$5').
attr_val -> expr : ['$1'].
attr_val -> expr ',' exprs : ['$1' | '$3'].
@@ -197,7 +203,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 +256,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 +276,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 +309,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 +330,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 +338,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 +358,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 +392,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 +424,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 +448,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 +493,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 +515,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 +534,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 +562,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 +585,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,11 +608,20 @@ 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) ->
{type, ?line(T1), union, [T1, T2]}.
+skip_paren({paren_type,_L,[Type]}) ->
+ skip_paren(Type);
+skip_paren(Type) ->
+ Type.
+
build_gen_type({atom, La, tuple}) ->
{type, La, tuple, any};
build_gen_type({atom, La, Name}) ->
@@ -618,7 +630,7 @@ build_gen_type({atom, La, Name}) ->
build_bin_type([{var, _, '_'}|Left], Int) ->
build_bin_type(Left, Int);
build_bin_type([], Int) ->
- Int;
+ skip_paren(Int);
build_bin_type([{var, La, _}|_], _) ->
ret_err(La, "Bad binary type").
@@ -716,7 +728,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 +751,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 +1017,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 b1b5bad294..df4a20b833 100644
--- a/lib/stdlib/src/erl_pp.erl
+++ b/lib/stdlib/src/erl_pp.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(erl_pp).
@@ -115,7 +115,7 @@ lattribute({attribute,_Line,Name,Arg}, Hook) ->
lattribute(module, {M,Vs}, _Hook) ->
attr("module",[{var,0,pname(M)},
- foldr(fun(V, C) -> {cons,0,{var,0,V},C}
+ foldr(fun(V, C) -> {cons,0,{var,0,V},C}
end, {nil,0}, Vs)]);
lattribute(module, M, _Hook) ->
attr("module", [{var,0,pname(M)}]);
@@ -140,7 +140,7 @@ typeattr(Tag, {TypeName,Type,Args}, _Hook) ->
ltype({ann_type,_Line,[V,T]}) ->
typed(lexpr(V, none), T);
ltype({paren_type,_Line,[T]}) ->
- [$(,ltype(T),$)];
+ [$(,ltype(T),$)];
ltype({type,_Line,union,Ts}) ->
{seq,[],[],[' |'],ltypes(Ts)};
ltype({type,_Line,list,[T]}) ->
@@ -153,7 +153,7 @@ ltype({type,Line,tuple,any}) ->
simple_type({atom,Line,tuple}, []);
ltype({type,_Line,tuple,Ts}) ->
tuple_type(Ts, fun ltype/1);
-ltype({type,_Line,record,[N|Fs]}) ->
+ltype({type,_Line,record,[{atom,_,N}|Fs]}) ->
record_type(N, Fs);
ltype({type,_Line,range,[_I1,_I2]=Es}) ->
expr_list(Es, '..', fun lexpr/2, none);
@@ -161,24 +161,28 @@ ltype({type,_Line,binary,[I1,I2]}) ->
binary_type(I1, I2); % except binary()
ltype({type,_Line,'fun',[]}) ->
leaf("fun()");
-ltype({type,_Line,'fun',_}=FunType) ->
+ltype({type,_,'fun',[{type,_,any},_]}=FunType) ->
+ [fun_type(['fun',$(], FunType),$)];
+ltype({type,_Line,'fun',[{type,_,product,_},_]}=FunType) ->
[fun_type(['fun',$(], FunType),$)];
ltype({type,Line,T,Ts}) ->
simple_type({atom,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).
-binary_type({integer,_,Int1}=I1, {integer,_,Int2}=I2) ->
- E1 = [[leaf("_:"),lexpr(I1, 0, none)] || Int1 =/= 0],
- E2 = [[leaf("_:_*"),lexpr(I2, 0, none)] || Int2 =/= 0],
+binary_type(I1, I2) ->
+ B = [[] || {integer,_,0} <- [I1]] =:= [],
+ U = [[] || {integer,_,0} <- [I2]] =:= [],
+ P = max_prec(),
+ E1 = [[leaf("_:"),lexpr(I1, P, none)] || B],
+ E2 = [[leaf("_:_*"),lexpr(I2, P, none)] || U],
{seq,'<<','>>',[$,],E1++E2}.
-record_type({atom,_,Name}, Fields) ->
+record_type(Name, Fields) ->
{first,[record_name(Name)],field_types(Fields)}.
field_types(Fs) ->
@@ -442,7 +446,7 @@ lexpr({op,_,Op,Arg}, Prec, Hook) ->
Ol = leaf(format("~s ", [Op])),
El = [Ol,lexpr(Arg, R, Hook)],
maybe_paren(P, Prec, El);
-lexpr({op,_,Op,Larg,Rarg}, Prec, Hook) when Op =:= 'orelse';
+lexpr({op,_,Op,Larg,Rarg}, Prec, Hook) when Op =:= 'orelse';
Op =:= 'andalso' ->
%% Breaks lines since R12B.
{L,P,R} = inop_prec(Op),
@@ -726,15 +730,15 @@ frmt(Item, I) ->
%%% and indentation are inserted between IPs.
%%% - {first,I,IP2}: IP2 follows after I, and is output with an indentation
%%% updated with the width of I.
-%%% - {seq,Before,After,Separator,IPs}: a sequence of Is separated by
-%%% Separator. Before is output before IPs, and the indentation of IPs
+%%% - {seq,Before,After,Separator,IPs}: a sequence of Is separated by
+%%% Separator. Before is output before IPs, and the indentation of IPs
%%% is updated with the width of Before. After follows after IPs.
%%% - {force_nl,ExtraInfo,I}: fun-info (a comment) forces linebreak before I.
%%% - {prefer_nl,Sep,IPs}: forces linebreak between Is unlesss negative
%%% indentation.
%%% - {string,S}: a string.
%%% - {hook,...}, {ehook,...}: hook expressions.
-%%%
+%%%
%%% list, first, seq, force_nl, and prefer_nl all accept IPs, where each
%%% element is either an item or a tuple {step|cstep,I1,I2}. step means
%%% that I2 is output after linebreak and an incremented indentation.
@@ -760,7 +764,7 @@ f({seq,Before,After,Sep,LItems}, I0, ST, WT) ->
{CharsL,SizeL} = unz(CharsSizeL),
{BCharsL,BSizeL} = unz1([BCharsSize]),
Sizes = BSizeL ++ SizeL,
- NSepChars = if
+ NSepChars = if
is_list(Sep), Sep =/= [] ->
erlang:max(0, length(CharsL)-1);
true ->
@@ -875,7 +879,7 @@ nl_indent(I, T) when I > 0 ->
[$\n|spaces(I, T)].
same_line(I0, SizeL, NSepChars) ->
- try
+ try
Size = lists:sum(SizeL) + NSepChars,
true = incr(I0, Size) =< ?MAXLINE,
{yes,Size}
@@ -955,9 +959,9 @@ write_a_string(S, N, Len) ->
-define(N_SPACES, 30).
spacetab() ->
- {[_|L],_} = mapfoldl(fun(_, A) -> {A,[$\s|A]}
+ {[_|L],_} = mapfoldl(fun(_, A) -> {A,[$\s|A]}
end, [], lists:seq(0, ?N_SPACES)),
- list_to_tuple(L).
+ list_to_tuple(L).
spaces(N, T) when N =< ?N_SPACES ->
element(N, T);
@@ -965,7 +969,7 @@ spaces(N, T) ->
[element(?N_SPACES, T)|spaces(N-?N_SPACES, T)].
wordtable() ->
- L = [begin {leaf,Sz,S} = leaf(W), {S,Sz} end ||
+ L = [begin {leaf,Sz,S} = leaf(W), {S,Sz} end ||
W <- [" ->"," =","<<",">>","[]","after","begin","case","catch",
"end","fun","if","of","receive","try","when"," ::","..",
" |"]],
diff --git a/lib/stdlib/src/erl_scan.erl b/lib/stdlib/src/erl_scan.erl
index 52ec81a78b..18f64c46d0 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,25 +48,20 @@
-module(erl_scan).
-%%% External exports
+%%% External exports
-export([string/1,string/2,string/3,tokens/3,tokens/4,
format_error/1,reserved_word/1,
token_info/1,token_info/2,
attributes_info/1,attributes_info/2,set_attribute/3]).
-%%% Local record.
--record(erl_scan,
- {resword_fun=fun reserved_word/1,
- ws=false,
- comment=false,
- text=false}).
+-export_type([error_info/0, line/0, tokens_result/0]).
%%%
-%%% Exported functions
+%%% Defines and type definitions
%%%
--define(COLUMN(C), is_integer(C), C >= 1).
+-define(COLUMN(C), (is_integer(C) andalso C >= 1)).
%% Line numbers less than zero have always been allowed:
-define(ALINE(L), is_integer(L)).
-define(STRING(S), is_list(S)).
@@ -95,44 +90,53 @@
-type error_description() :: term().
-type error_info() :: {location(), module(), error_description()}.
+%%% Local record.
+-record(erl_scan,
+ {resword_fun = fun reserved_word/1 :: resword_fun(),
+ ws = false :: boolean(),
+ comment = false :: boolean(),
+ text = false :: boolean()}).
+
+%%----------------------------------------------------------------------------
+
-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 +145,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 +161,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 +218,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 +234,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 +293,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),
@@ -307,10 +311,10 @@ options(Opt) ->
options([Opt]).
opts(Options, [Key|Keys], L) ->
- V = case lists:keysearch(Key, 1, Options) of
- {value,{reserved_word_fun,F}} when ?RESWORDFUN(F) ->
+ V = case lists:keyfind(Key, 1, Options) of
+ {reserved_word_fun,F} when ?RESWORDFUN(F) ->
{ok,F};
- {value,{Key,_}} ->
+ {Key,_} ->
badarg;
false ->
{ok,default_option(Key)}
@@ -333,12 +337,13 @@ expand_opt(O, Os) ->
[O|Os].
attr_info(Attrs, Item) ->
- case catch lists:keysearch(Item, 1, Attrs) of
- {value,{Item,Value}} ->
- {Item,Value};
- false ->
- undefined;
- _ ->
+ try lists:keyfind(Item, 1, Attrs) of
+ {_Item, _Value} = T ->
+ T;
+ false ->
+ undefined
+ catch
+ _:_ ->
erlang:error(badarg, [Attrs, Item])
end.
@@ -442,6 +447,14 @@ scan1([$\%=C|Cs], St, Line, Col, Toks) ->
scan_comment(Cs, St, Line, Col, Toks, [C]);
scan1([C|Cs], St, Line, Col, Toks) when ?DIGIT(C) ->
scan_number(Cs, St, Line, Col, Toks, [C]);
+scan1("..."++Cs, St, Line, Col, Toks) ->
+ tok2(Cs, St, Line, Col, Toks, "...", '...', 3);
+scan1(".."=Cs, _St, Line, Col, Toks) ->
+ {more,{Cs,Col,Toks,Line,[],fun scan/6}};
+scan1(".."++Cs, St, Line, Col, Toks) ->
+ tok2(Cs, St, Line, Col, Toks, "..", '..', 2);
+scan1("."=Cs, _St, Line, Col, Toks) ->
+ {more,{Cs,Col,Toks,Line,[],fun scan/6}};
scan1([$.=C|Cs], St, Line, Col, Toks) ->
scan_dot(Cs, St, Line, Col, Toks, [C]);
scan1([$"|Cs], St, Line, Col, Toks) -> %" Emacs
@@ -591,12 +604,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 +623,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
@@ -644,8 +657,6 @@ scan_dot([$\n=C|Cs], St, Line, Col, Toks, Ncs) ->
scan_dot([C|Cs], St, Line, Col, Toks, Ncs) when ?WHITE_SPACE(C) ->
Attrs = attributes(Line, Col, St, Ncs++[C]),
{ok,[{dot,Attrs}|Toks],Cs,Line,incr_column(Col, 2)};
-scan_dot([]=Cs, _St, Line, Col, Toks, Ncs) ->
- {more,{Cs,Col,Toks,Line,Ncs,fun scan_dot/6}};
scan_dot(eof=Cs, St, Line, Col, Toks, Ncs) ->
Attrs = attributes(Line, Col, St, Ncs),
{ok,[{dot,Attrs}|Toks],Cs,Line,incr_column(Col, 1)};
@@ -690,7 +701,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 +712,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 +725,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 +734,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 +800,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 +907,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 +920,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 +981,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 +1097,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 +1273,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 +1314,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..99e454f593 100644
--- a/lib/stdlib/src/escript.erl
+++ b/lib/stdlib/src/escript.erl
@@ -19,102 +19,254 @@
-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]).
--record(state, {file,
- module,
+%%-----------------------------------------------------------------------
+
+-define(SHEBANG, "/usr/bin/env escript").
+-define(COMMENT, "This is an -*- erlang -*- file").
+
+%%-----------------------------------------------------------------------
+
+-type mode() :: 'compile' | 'debug' | 'interpret' | 'run'.
+-type source() :: 'archive' | 'beam' | 'text'.
+
+-record(state, {file :: file:filename(),
+ module :: module(),
forms_or_bin,
- source,
- n_errors,
- mode,
- exports_main,
- has_records}).
-
+ source :: source(),
+ n_errors :: non_neg_integer(),
+ mode :: mode(),
+ exports_main :: boolean(),
+ has_records :: boolean()}).
+
+-type shebang() :: string().
+-type comment() :: string().
+-type emu_args() :: string().
+
+-record(sections, {type,
+ shebang :: shebang(),
+ comment :: comment(),
+ emu_args :: emu_args(),
+ body}).
+
+-record(extract_options, {compile_source}).
+
+-type zip_file() ::
+ file:filename()
+ | {file:filename(), binary()}
+ | {file:filename(), binary(), file:file_info()}.
+-type zip_create_option() :: term().
+-type section() ::
+ shebang
+ | {shebang, shebang()}
+ | comment
+ | {comment, comment()}
+ | {emu_args, emu_args()}
+ | {source, file:filename() | binary()}
+ | {beam, file:filename() | binary()}
+ | {archive, file:filename() | binary()}
+ | {archive, [zip_file()], [zip_create_option()]}.
+
+%%-----------------------------------------------------------------------
+
+%% Create a complete escript file with both header and body
+-spec create(file: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(file: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 +295,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 +329,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 +342,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 +366,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 +376,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 +385,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,63 +408,101 @@ 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
- [$\#, $\! | _] ->
- shebang;
- [$P, $K | _] ->
- archive;
- [$F, $O, $R, $1 | _] ->
- beam;
- [$\%, $\%, $\! | _] ->
- emu_args;
- _ ->
- undefined
+ "#!" ++ _ -> shebang;
+ "PK" ++ _ -> archive;
+ "FOR1" ++ _ -> beam;
+ "%%!" ++ _ -> emu_args;
+ "%" ++ _ -> comment;
+ _ -> undefined
end.
guess_type(Line) ->
@@ -336,8 +522,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 +531,13 @@ 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 +550,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 +584,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]);
@@ -408,8 +593,8 @@ parse_source(S, File, Fd, StartLine, HeaderSz, CheckOnly) ->
epp_parse_file2(Epp, S2, [ModForm, FileForm], OptModRes);
{error, _} ->
epp_parse_file2(Epp, S2, [FileForm], OptModRes);
- {eof,LastLine} ->
- S#state{forms_or_bin = [FileForm, {eof,LastLine}]}
+ {eof, _LastLine} = Eof ->
+ S#state{forms_or_bin = [FileForm, Eof]}
end,
ok = epp:close(Epp),
ok = file:close(Fd),
@@ -448,12 +633,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 ++ "__" ++
@@ -504,8 +689,8 @@ epp_parse_file2(Epp, S, Forms, Parsed) ->
io:format("~s:~w: ~s\n",
[S#state.file,Ln,Mod:format_error(Args)]),
epp_parse_file(Epp, S#state{n_errors = S#state.n_errors + 1}, [Form | Forms]);
- {eof,LastLine} ->
- S#state{forms_or_bin = lists:reverse([{eof, LastLine} | Forms])}
+ {eof, _LastLine} = Eof ->
+ S#state{forms_or_bin = lists:reverse([Eof | Forms])}
end.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -642,8 +827,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 +836,7 @@ format_exception(Class, Reason) ->
fatal(Str) ->
throw(Str).
-
+
my_halt(Reason) ->
case process_info(group_leader(), status) of
{_,waiting} ->
@@ -675,7 +860,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..6e6e949e2c 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).
@@ -42,10 +42,15 @@
-export([i/0, i/1, i/2, i/3]).
-%%------------------------------------------------------------------------------
+-export_type([tab/0, tid/0]).
+
+%%-----------------------------------------------------------------------------
-type tab() :: atom() | tid().
+%% a similar definition is also in erl_types
+-opaque tid() :: integer().
+
-type ext_info() :: 'md5sum' | 'object_count'.
-type protection() :: 'private' | 'protected' | 'public'.
-type type() :: 'bag' | 'duplicate_bag' | 'ordered_set' | 'set'.
@@ -63,7 +68,7 @@
-type match_pattern() :: atom() | tuple().
-type match_specs() :: [{match_pattern(), [_], [_]}].
-%%------------------------------------------------------------------------------
+%%-----------------------------------------------------------------------------
%% The following functions used to be found in this module, but
%% are now BIFs (i.e. implemented in C).
@@ -230,7 +235,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
@@ -507,7 +512,7 @@ file2tab(File) ->
file2tab(File, Opts) ->
try
- {ok,Verify} = parse_f2t_opts(Opts,false),
+ {ok,Verify,TabArg} = parse_f2t_opts(Opts,false,[]),
Name = make_ref(),
{ok, Major, Minor, FtOptions, MD5State, FullHeader, DLContext} =
case disk_log:open([{name, Name},
@@ -535,7 +540,7 @@ file2tab(File, Opts) ->
true ->
ok
end,
- {ok, Tab, HeadCount} = create_tab(FullHeader),
+ {ok, Tab, HeadCount} = create_tab(FullHeader, TabArg),
StrippedOptions =
case Verify of
true ->
@@ -622,14 +627,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
@@ -671,15 +676,17 @@ do_read_and_verify(ReadFun,InitState,Tab,FtOptions,HeadCount,Verify) ->
{ok,Tab}
end.
-parse_f2t_opts([],Verify) ->
- {ok,Verify};
-parse_f2t_opts([{verify, true}|T],_OV) ->
- parse_f2t_opts(T,true);
-parse_f2t_opts([{verify,false}|T],OV) ->
- parse_f2t_opts(T,OV);
-parse_f2t_opts([Unexpected|_],_) ->
+parse_f2t_opts([],Verify,Tab) ->
+ {ok,Verify,Tab};
+parse_f2t_opts([{verify, true}|T],_OV,Tab) ->
+ parse_f2t_opts(T,true,Tab);
+parse_f2t_opts([{verify,false}|T],OV,Tab) ->
+ parse_f2t_opts(T,OV,Tab);
+parse_f2t_opts([{table,Tab}|T],OV,[]) ->
+ parse_f2t_opts(T,OV,Tab);
+parse_f2t_opts([Unexpected|_],_,_) ->
throw({unknown_option,Unexpected});
-parse_f2t_opts(Malformed,_) ->
+parse_f2t_opts(Malformed,_,_) ->
throw({malformed_option,Malformed}).
count_mandatory([]) ->
@@ -742,22 +749,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 +792,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 +830,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,23 +858,32 @@ 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),
- try
- Tab = ets:new(Name, [Type, P, {keypos, Kp} | named_table(Val)]),
- {ok, Tab, Sz}
- catch
- _:_ ->
- throw(cannot_create_table)
+create_tab(I, TabArg) ->
+ {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),
+ Comp = case lists:keyfind(compressed, 1, I) of
+ {compressed, true} -> [compressed];
+ {compressed, false} -> [];
+ false -> []
+ end,
+ case TabArg of
+ [] ->
+ try
+ Tab = ets:new(Name, [Type, P, Keypos] ++ named_table(Val) ++ Comp),
+ {ok, Tab, Sz}
+ catch _:_ ->
+ throw(cannot_create_table)
+ end;
+ _ ->
+ {ok, TabArg, Sz}
end.
named_table(true) -> [named_table];
@@ -905,9 +920,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 +1036,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/eval_bits.erl b/lib/stdlib/src/eval_bits.erl
index 3671aecdcb..2cbd6cdae7 100644
--- a/lib/stdlib/src/eval_bits.erl
+++ b/lib/stdlib/src/eval_bits.erl
@@ -2,7 +2,7 @@
%%
%% %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
@@ -19,6 +19,8 @@
%%
-module(eval_bits).
+%% Avoid warning for local function error/1 clashing with autoimported BIF.
+-compile({no_auto_import,[error/1]}).
-export([expr_grp/3,expr_grp/5,match_bits/6,
match_bits/7,bin_gen/6]).
diff --git a/lib/stdlib/src/file_sorter.erl b/lib/stdlib/src/file_sorter.erl
index e21a0c88f3..2a5b08b581 100644
--- a/lib/stdlib/src/file_sorter.erl
+++ b/lib/stdlib/src/file_sorter.erl
@@ -18,6 +18,8 @@
%%
-module(file_sorter).
+%% Avoid warning for local function error/2 clashing with autoimported BIF.
+-compile({no_auto_import,[error/2]}).
-export([sort/1, sort/2, sort/3,
keysort/2, keysort/3, keysort/4,
merge/2, merge/3,
@@ -191,7 +193,7 @@ options([{format, Format} | L], Opts) when Format =:= binary;
options([{format, binary_term} | L], Opts) ->
options(L, Opts#opts{format = binary_term_fun()});
options([{size, Size} | L], Opts) when is_integer(Size), Size >= 0 ->
- options(L, Opts#opts{size = max(Size, 1)});
+ options(L, Opts#opts{size = erlang:max(Size, 1)});
options([{no_files, NoFiles} | L], Opts) when is_integer(NoFiles),
NoFiles > 1 ->
options(L, Opts#opts{no_files = NoFiles});
@@ -997,10 +999,10 @@ close_read_fun(Fd, FileName, fsort) ->
file:delete(FileName).
read_objs(Fd, FileName, I, L, Bin0, Size0, LSz, W) ->
- Max = max(Size0, ?CHUNKSIZE),
+ Max = erlang:max(Size0, ?CHUNKSIZE),
BSz0 = byte_size(Bin0),
Min = Size0 - BSz0 + W#w.hdlen, % Min > 0
- NoBytes = max(Min, Max),
+ NoBytes = erlang:max(Min, Max),
case read(Fd, FileName, NoBytes, W) of
{ok, Bin} ->
BSz = byte_size(Bin),
@@ -1180,9 +1182,6 @@ make_key2([Kp], T) ->
make_key2([Kp | Kps], T) ->
[element(Kp, T) | make_key2(Kps, T)].
-max(A, B) when A < B -> B;
-max(A, _) -> A.
-
infun(W) ->
W1 = W#w{in = undefined},
try (W#w.in)(read) of
diff --git a/lib/stdlib/src/filelib.erl b/lib/stdlib/src/filelib.erl
index 74c5172137..c845b61204 100644
--- a/lib/stdlib/src/filelib.erl
+++ b/lib/stdlib/src/filelib.erl
@@ -20,6 +20,8 @@
%% File utilities.
+%% Avoid warning for local function error/1 clashing with autoimported BIF.
+-compile({no_auto_import,[error/1]}).
-export([wildcard/1, wildcard/2, is_dir/1, is_file/1, is_regular/1,
compile_wildcard/1]).
-export([fold_files/5, last_modified/1, file_size/1, ensure_dir/1]).
@@ -40,66 +42,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()].
-wildcard(Pattern, Cwd) when is_list(Pattern), is_list(Cwd) ->
+-spec wildcard(file:name(), file:name() | atom()) -> [file:filename()].
+wildcard(Pattern, Cwd) when is_list(Pattern), (is_list(Cwd) or is_binary(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) ->
+ when is_list(Pattern), (is_list(Cwd) or is_binary(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).
@@ -116,7 +118,7 @@ do_wildcard_comp({compiled_wildcard,{exists,File}}, Mod) ->
do_wildcard_comp({compiled_wildcard,[Base|Rest]}, Mod) ->
do_wildcard_1([Base], Rest, Mod).
-do_wildcard(Pattern, Cwd, Mod) when is_list(Pattern), is_list(Cwd) ->
+do_wildcard(Pattern, Cwd, Mod) when is_list(Pattern), (is_list(Cwd) or is_binary(Cwd)) ->
do_wildcard_comp(do_compile_wildcard(Pattern), Cwd, Mod).
do_wildcard_comp({compiled_wildcard,{exists,File}}, Cwd, Mod) ->
@@ -125,9 +127,18 @@ do_wildcard_comp({compiled_wildcard,{exists,File}}, Cwd, Mod) ->
_ -> []
end;
do_wildcard_comp({compiled_wildcard,[current|Rest]}, Cwd0, Mod) ->
- Cwd = filename:join([Cwd0]), %Slash away redundant slashes.
- PrefixLen = length(Cwd)+1,
- [lists:nthtail(PrefixLen, N) || N <- do_wildcard_1([Cwd], Rest, Mod)];
+ {Cwd,PrefixLen} = case filename:join([Cwd0]) of
+ Bin when is_binary(Bin) -> {Bin,byte_size(Bin)+1};
+ Other -> {Other,length(Other)+1}
+ end, %Slash away redundant slashes.
+ [
+ if
+ is_binary(N) ->
+ <<_:PrefixLen/binary,Res/binary>> = N,
+ Res;
+ true ->
+ lists:nthtail(PrefixLen, N)
+ end || N <- do_wildcard_1([Cwd], Rest, Mod)];
do_wildcard_comp({compiled_wildcard,[Base|Rest]}, _Cwd, Mod) ->
do_wildcard_1([Base], Rest, Mod).
@@ -164,36 +175,44 @@ do_is_regular(File, Mod) ->
%% If <Recursive> is true all sub-directories to <Dir> are processed
do_fold_files(Dir, RegExp, Recursive, Fun, Acc, Mod) ->
- {ok, Re1} = re:compile(RegExp),
- do_fold_files1(Dir, Re1, Recursive, Fun, Acc, Mod).
+ {ok, Re1} = re:compile(RegExp,[unicode]),
+ do_fold_files1(Dir, Re1, RegExp, Recursive, Fun, Acc, Mod).
-do_fold_files1(Dir, RegExp, Recursive, Fun, Acc, Mod) ->
+do_fold_files1(Dir, RegExp, OrigRE, Recursive, Fun, Acc, Mod) ->
case eval_list_dir(Dir, Mod) of
- {ok, Files} -> do_fold_files2(Files, Dir, RegExp, Recursive, Fun, Acc, Mod);
+ {ok, Files} -> do_fold_files2(Files, Dir, RegExp, OrigRE,
+ Recursive, Fun, Acc, Mod);
{error, _} -> Acc
end.
-do_fold_files2([], _Dir, _RegExp, _Recursive, _Fun, Acc, _Mod) ->
+%% OrigRE is not to be compiled as it's for non conforming filenames,
+%% i.e. for filenames that does not comply to the current encoding, which should
+%% be very rare. We use it only in those cases and do not want to precompile.
+do_fold_files2([], _Dir, _RegExp, _OrigRE, _Recursive, _Fun, Acc, _Mod) ->
Acc;
-do_fold_files2([File|T], Dir, RegExp, Recursive, Fun, Acc0, Mod) ->
+do_fold_files2([File|T], Dir, RegExp, OrigRE, Recursive, Fun, Acc0, Mod) ->
FullName = filename:join(Dir, File),
case do_is_regular(FullName, Mod) of
true ->
- case re:run(File, RegExp, [{capture,none}]) of
+ case (catch re:run(File, if is_binary(File) -> OrigRE;
+ true -> RegExp end,
+ [{capture,none}])) of
match ->
Acc = Fun(FullName, Acc0),
- do_fold_files2(T, Dir, RegExp, Recursive, Fun, Acc, Mod);
+ do_fold_files2(T, Dir, RegExp, OrigRE, Recursive, Fun, Acc, Mod);
+ {'EXIT',_} ->
+ do_fold_files2(T, Dir, RegExp, OrigRE, Recursive, Fun, Acc0, Mod);
nomatch ->
- do_fold_files2(T, Dir, RegExp, Recursive, Fun, Acc0, Mod)
+ do_fold_files2(T, Dir, RegExp, OrigRE, Recursive, Fun, Acc0, Mod)
end;
false ->
case Recursive andalso do_is_dir(FullName, Mod) of
true ->
- Acc1 = do_fold_files1(FullName, RegExp, Recursive,
+ Acc1 = do_fold_files1(FullName, RegExp, OrigRE, Recursive,
Fun, Acc0, Mod),
- do_fold_files2(T, Dir, RegExp, Recursive, Fun, Acc1, Mod);
+ do_fold_files2(T, Dir, RegExp, OrigRE, Recursive, Fun, Acc1, Mod);
false ->
- do_fold_files2(T, Dir, RegExp, Recursive, Fun, Acc0, Mod)
+ do_fold_files2(T, Dir, RegExp, OrigRE, Recursive, Fun, Acc0, Mod)
end
end.
@@ -218,7 +237,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) ->
@@ -266,6 +285,13 @@ do_wildcard_3(Base, [Pattern|Rest], Result, Mod) ->
do_wildcard_3(Base, [], Result, _Mod) ->
[Base|Result].
+wildcard_4(Pattern, [File|Rest], Base, Result) when is_binary(File) ->
+ case wildcard_5(Pattern, binary_to_list(File)) of
+ true ->
+ wildcard_4(Pattern, Rest, Base, [join(Base, File)|Result]);
+ false ->
+ wildcard_4(Pattern, Rest, Base, Result)
+ end;
wildcard_4(Pattern, [File|Rest], Base, Result) ->
case wildcard_5(Pattern, File) of
true ->
diff --git a/lib/stdlib/src/filename.erl b/lib/stdlib/src/filename.erl
index cd26b2e219..e38b8957f2 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).
@@ -41,6 +41,9 @@
-include_lib("kernel/include/file.hrl").
+-define(IS_DRIVELETTER(Letter),(((Letter >= $A) andalso (Letter =< $Z)) orelse
+ ((Letter >= $a) andalso (Letter =< $z)))).
+
%% Converts a relative filename to an absolute filename
%% or the filename itself if it already is an absolute filename
%% Note that no attempt is made to create the most beatiful
@@ -57,12 +60,18 @@
%% (for Unix) : absname("/") -> "/"
%% (for WIN32): absname("/") -> "D:/"
--spec absname(name()) -> string().
+
+-spec absname(file:name()) -> file:filename().
absname(Name) ->
{ok, Cwd} = file:get_cwd(),
absname(Name, Cwd).
--spec absname(name(), string()) -> string().
+-spec absname(file:name(), file:filename()) -> file:filename().
+absname(Name, AbsBase) when is_binary(Name), is_list(AbsBase) ->
+ absname(Name,filename_string_to_binary(AbsBase));
+absname(Name, AbsBase) when is_list(Name), is_binary(AbsBase) ->
+ absname(filename_string_to_binary(Name),AbsBase);
+
absname(Name, AbsBase) ->
case pathtype(Name) of
relative ->
@@ -77,6 +86,20 @@ absname(Name, AbsBase) ->
%% Handles volumerelative names (on Windows only).
+absname_vr([<<"/">>|Rest1], [Volume|_], _AbsBase) ->
+ %% Absolute path on current drive.
+ join([Volume|Rest1]);
+absname_vr([<<X, $:>>|Rest1], [<<X,_/binary>>|_], AbsBase) ->
+ %% Relative to current directory on current drive.
+ absname(join(Rest1), AbsBase);
+absname_vr([<<X, $:>>|Name], _, _AbsBase) ->
+ %% Relative to current directory on another drive.
+ Dcwd =
+ case file:get_cwd([X, $:]) of
+ {ok, Dir} -> filename_string_to_binary(Dir);
+ {error, _} -> <<X, $:, $/>>
+ end,
+ absname(join(Name), Dcwd);
absname_vr(["/"|Rest1], [Volume|_], _AbsBase) ->
%% Absolute path on current drive.
join([Volume|Rest1]);
@@ -92,41 +115,13 @@ absname_vr([[X, $:]|Name], _, _AbsBase) ->
end,
absname(join(Name), Dcwd).
-%% Joins a relative filename to an absolute base. For VxWorks the
-%% resulting name is fixed to minimize the length by collapsing
-%% ".." directories.
-%% For other systems this is just a join/2, but assumes that
+%% Joins a relative filename to an absolute base.
+%% 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(file:filename(), file:name()) -> file:filename().
absname_join(AbsBase, Name) ->
- case major_os_type() of
- vxworks ->
- absname_pretty(AbsBase, split(Name), lists:reverse(split(AbsBase)));
- _Else ->
- join(AbsBase, flatten(Name))
- end.
-
-%% Handles absolute filenames for VxWorks - these are 'pretty-printed',
-%% since a C function call chdir("/erlang/lib/../bin") really sets
-%% cwd to '/erlang/lib/../bin' which also works, but the long term
-%% effect is potentially not so good ...
-%%
-%% absname_pretty("../bin", "/erlang/lib") -> "/erlang/bin"
-%% absname_pretty("../../../..", "/erlang") -> "/erlang"
-
-absname_pretty(Abspath, Relpath, []) ->
- %% AbsBase _must_ begin with a vxworks device name
- {device, _Rest, Dev} = vxworks_first(Abspath),
- absname_pretty(Abspath, Relpath, [lists:reverse(Dev)]);
-absname_pretty(_Abspath, [], AbsBase) ->
- join(lists:reverse(AbsBase));
-absname_pretty(Abspath, [[$.]|Rest], AbsBase) ->
- absname_pretty(Abspath, Rest, AbsBase);
-absname_pretty(Abspath, [[$.,$.]|Rest], [_|AbsRest]) ->
- absname_pretty(Abspath, Rest, AbsRest);
-absname_pretty(Abspath, [First|Rest], AbsBase) ->
- absname_pretty(Abspath, Rest, [First|AbsBase]).
+ join(AbsBase, flatten(Name)).
%% Returns the part of the filename after the last directory separator,
%% or the filename itself if it has no separators.
@@ -136,12 +131,36 @@ absname_pretty(Abspath, [First|Rest], AbsBase) ->
%% basename("/usr/foo/") -> "foo" (trailing slashes ignored)
%% basename("/") -> []
--spec basename(name()) -> string().
+-spec basename(file:name()) -> file:filename().
+basename(Name) when is_binary(Name) ->
+ case os:type() of
+ {win32,_} ->
+ win_basenameb(Name);
+ _ ->
+ basenameb(Name,[<<"/">>])
+ end;
+
basename(Name0) ->
Name = flatten(Name0),
{DirSep2, DrvSep} = separators(),
basename1(skip_prefix(Name, DrvSep), [], DirSep2).
+win_basenameb(<<Letter,$:,Rest/binary>>) when ?IS_DRIVELETTER(Letter) ->
+ basenameb(Rest,[<<"/">>,<<"\\">>]);
+win_basenameb(O) ->
+ basenameb(O,[<<"/">>,<<"\\">>]).
+basenameb(Bin,Sep) ->
+ Parts = [ X || X <- binary:split(Bin,Sep,[global]),
+ X =/= <<>> ],
+ if
+ Parts =:= [] ->
+ <<>>;
+ true ->
+ lists:last(Parts)
+ end.
+
+
+
basename1([$/|[]], Tail, DirSep2) ->
basename1([], Tail, DirSep2);
basename1([$/|Rest], _Tail, DirSep2) ->
@@ -155,26 +174,11 @@ basename1([Char|Rest], Tail, DirSep2) when is_integer(Char) ->
basename1([], Tail, _DirSep2) ->
lists:reverse(Tail).
-skip_prefix(Name, false) -> % No prefix for unix, but for VxWorks.
- case major_os_type() of
- vxworks ->
- case vxworks_first(Name) of
- {device, Rest, _Device} ->
- Rest;
- {not_device, _Rest, _First} ->
- Name
- end;
- _Else ->
- Name
- end;
-skip_prefix(Name, DrvSep) ->
- skip_prefix1(Name, DrvSep).
-
-skip_prefix1([L, DrvSep|Name], DrvSep) when is_integer(L) ->
+skip_prefix(Name, false) ->
+ Name;
+skip_prefix([L, DrvSep|Name], DrvSep) when ?IS_DRIVELETTER(L) ->
Name;
-skip_prefix1([L], _) when is_integer(L) ->
- [L];
-skip_prefix1(Name, _) ->
+skip_prefix(Name, _) ->
Name.
%% Returns the last component of the filename, with the given
@@ -190,7 +194,29 @@ skip_prefix1(Name, _) ->
%% rootname(basename("xxx.jam")) -> "xxx"
%% rootname(basename("xxx.erl")) -> "xxx"
--spec basename(name(), name()) -> string().
+-spec basename(file:name(), file:name()) -> file:filename().
+basename(Name, Ext) when is_binary(Name), is_list(Ext) ->
+ basename(Name,filename_string_to_binary(Ext));
+basename(Name, Ext) when is_list(Name), is_binary(Ext) ->
+ basename(filename_string_to_binary(Name),Ext);
+basename(Name, Ext) when is_binary(Name), is_binary(Ext) ->
+ BName = basename(Name),
+ LAll = byte_size(Name),
+ LN = byte_size(BName),
+ LE = byte_size(Ext),
+ case LN - LE of
+ Neg when Neg < 0 ->
+ BName;
+ Pos ->
+ StartLen = LAll - Pos - LE,
+ case Name of
+ <<_:StartLen/binary,Part:Pos/binary,Ext/binary>> ->
+ Part;
+ _Other ->
+ BName
+ end
+ end;
+
basename(Name0, Ext0) ->
Name = flatten(Name0),
Ext = flatten(Ext0),
@@ -204,7 +230,7 @@ basename([$/|[]], Ext, Tail, DrvSep2) ->
basename([], Ext, Tail, DrvSep2);
basename([$/|Rest], Ext, _Tail, DrvSep2) ->
basename(Rest, Ext, [], DrvSep2);
-basename([$\\|Rest], Ext, Tail, DirSep2) when is_integer(DirSep2) ->
+basename([DirSep2|Rest], Ext, Tail, DirSep2) when is_integer(DirSep2) ->
basename([$/|Rest], Ext, Tail, DirSep2);
basename([Char|Rest], Ext, Tail, DrvSep2) when is_integer(Char) ->
basename(Rest, Ext, [Char|Tail], DrvSep2);
@@ -216,21 +242,43 @@ basename([], _Ext, Tail, _DrvSep2) ->
%% Example: dirname("/usr/src/kalle.erl") -> "/usr/src",
%% dirname("kalle.erl") -> "."
--spec dirname(name()) -> string().
+-spec dirname(file:name()) -> file:filename().
+dirname(Name) when is_binary(Name) ->
+ {Dsep,Drivesep} = separators(),
+ SList = case Dsep of
+ Sep when is_integer(Sep) ->
+ [ <<Sep>> ];
+ _ ->
+ []
+ end,
+ {XPart0,Dirs} = case Drivesep of
+ X when is_integer(X) ->
+ case Name of
+ <<DL,X,Rest/binary>> when ?IS_DRIVELETTER(DL) ->
+ {<<DL,X>>,Rest};
+ _ ->
+ {<<>>,Name}
+ end;
+ _ ->
+ {<<>>,Name}
+ end,
+ Parts0 = binary:split(Dirs,[<<"/">>|SList],[global]),
+ %% Fairly short lists of parts, OK to reverse twice...
+ Parts = case Parts0 of
+ [] -> [];
+ _ -> lists:reverse(fstrip(tl(lists:reverse(Parts0))))
+ end,
+ XPart = case {Parts,XPart0} of
+ {[],<<>>} ->
+ <<".">>;
+ _ ->
+ XPart0
+ end,
+ dirjoin(Parts,XPart,<<"/">>);
+
dirname(Name0) ->
Name = flatten(Name0),
- case os:type() of
- vxworks ->
- {Devicep, Restname, FirstComp} = vxworks_first(Name),
- case Devicep of
- device ->
- dirname(Restname, FirstComp, [], separators());
- _ ->
- dirname(Name, [], [], separators())
- end;
- _ ->
- dirname(Name, [], [], separators())
- end.
+ dirname(Name, [], [], separators()).
dirname([[_|_]=List|Rest], Dir, File, Seps) ->
dirname(List++Rest, Dir, File, Seps);
@@ -258,6 +306,26 @@ dirname([], [DrvSep,Dl], File, {_,DrvSep}) ->
end;
dirname([], Dir, _, _) ->
lists:reverse(Dir).
+
+%% Compatibility with lists variant, remove trailing slashes
+fstrip([<<>>,X|Y]) ->
+ fstrip([X|Y]);
+fstrip(A) ->
+ A.
+
+
+dirjoin([<<>>|T],Acc,Sep) ->
+ dirjoin1(T,<<Acc/binary,"/">>,Sep);
+dirjoin(A,B,C) ->
+ dirjoin1(A,B,C).
+
+dirjoin1([],Acc,_) ->
+ Acc;
+dirjoin1([One],Acc,_) ->
+ <<Acc/binary,One/binary>>;
+dirjoin1([H|T],Acc,Sep) ->
+ dirjoin(T,<<Acc/binary,H/binary,Sep/binary>>,Sep).
+
%% Given a filename string, returns the file extension,
%% including the period. Returns an empty list if there
@@ -268,7 +336,31 @@ dirname([], Dir, _, _) ->
%%
%% On Windows: fn:dirname("\\usr\\src/kalle.erl") -> "/usr/src"
--spec extension(name()) -> string().
+-spec extension(file:name()) -> file:filename().
+extension(Name) when is_binary(Name) ->
+ {Dsep,_} = separators(),
+ SList = case Dsep of
+ Sep when is_integer(Sep) ->
+ [ <<Sep>> ];
+ _ ->
+ []
+ end,
+ case binary:matches(Name,[<<".">>]) of
+ nomatch -> % Bug in binary workaround :(
+ <<>>;
+ [] ->
+ <<>>;
+ List ->
+ {Pos,_} = lists:last(List),
+ <<_:Pos/binary,Part/binary>> = Name,
+ case binary:match(Part,[<<"/">>|SList]) of
+ nomatch ->
+ Part;
+ _ ->
+ <<>>
+ end
+ end;
+
extension(Name0) ->
Name = flatten(Name0),
extension(Name, [], major_os_type()).
@@ -281,8 +373,6 @@ extension([$/|Rest], _Result, OsType) ->
extension(Rest, [], OsType);
extension([$\\|Rest], _Result, win32) ->
extension(Rest, [], win32);
-extension([$\\|Rest], _Result, vxworks) ->
- extension(Rest, [], vxworks);
extension([Char|Rest], Result, OsType) when is_integer(Char) ->
extension(Rest, [Char|Result], OsType);
extension([], Result, _OsType) ->
@@ -290,23 +380,36 @@ extension([], Result, _OsType) ->
%% Joins a list of filenames with directory separators.
--spec join([string()]) -> string().
+-spec join([file:filename()]) -> file:filename().
join([Name1, Name2|Rest]) ->
join([join(Name1, Name2)|Rest]);
join([Name]) when is_list(Name) ->
join1(Name, [], [], major_os_type());
+join([Name]) when is_binary(Name) ->
+ join1b(Name, <<>>, [], major_os_type());
join([Name]) when is_atom(Name) ->
join([atom_to_list(Name)]).
%% Joins two filenames with directory separators.
--spec join(string(), string()) -> string().
+-spec join(file:filename(), file:filename()) -> file:filename().
join(Name1, Name2) when is_list(Name1), is_list(Name2) ->
OsType = major_os_type(),
case pathtype(Name2) of
relative -> join1(Name1, Name2, [], OsType);
_Other -> join1(Name2, [], [], OsType)
end;
+join(Name1, Name2) when is_binary(Name1), is_list(Name2) ->
+ join(Name1,filename_string_to_binary(Name2));
+join(Name1, Name2) when is_list(Name1), is_binary(Name2) ->
+ join(filename_string_to_binary(Name1),Name2);
+join(Name1, Name2) when is_binary(Name1), is_binary(Name2) ->
+ OsType = major_os_type(),
+ case pathtype(Name2) of
+ relative -> join1b(Name1, Name2, [], OsType);
+ _Other -> join1b(Name2, <<>>, [], OsType)
+ end;
+
join(Name1, Name2) when is_atom(Name1) ->
join(atom_to_list(Name1), Name2);
join(Name1, Name2) when is_atom(Name2) ->
@@ -321,8 +424,6 @@ when is_integer(UcLetter), UcLetter >= $A, UcLetter =< $Z ->
join1(Rest, RelativeName, [$:, UcLetter+$a-$A], win32);
join1([$\\|Rest], RelativeName, Result, win32) ->
join1([$/|Rest], RelativeName, Result, win32);
-join1([$\\|Rest], RelativeName, Result, vxworks) ->
- join1([$/|Rest], RelativeName, Result, vxworks);
join1([$/|Rest], RelativeName, [$., $/|Result], OsType) ->
join1(Rest, RelativeName, [$/|Result], OsType);
join1([$/|Rest], RelativeName, [$/|Result], OsType) ->
@@ -344,6 +445,26 @@ join1([Char|Rest], RelativeName, Result, OsType) when is_integer(Char) ->
join1([Atom|Rest], RelativeName, Result, OsType) when is_atom(Atom) ->
join1(atom_to_list(Atom)++Rest, RelativeName, Result, OsType).
+join1b(<<UcLetter, $:, Rest/binary>>, RelativeName, [], win32)
+when is_integer(UcLetter), UcLetter >= $A, UcLetter =< $Z ->
+ join1b(Rest, RelativeName, [$:, UcLetter+$a-$A], win32);
+join1b(<<$\\,Rest/binary>>, RelativeName, Result, win32) ->
+ join1b(<<$/,Rest/binary>>, RelativeName, Result, win32);
+join1b(<<$/,Rest/binary>>, RelativeName, [$., $/|Result], OsType) ->
+ join1b(Rest, RelativeName, [$/|Result], OsType);
+join1b(<<$/,Rest/binary>>, RelativeName, [$/|Result], OsType) ->
+ join1b(Rest, RelativeName, [$/|Result], OsType);
+join1b(<<>>, <<>>, Result, OsType) ->
+ list_to_binary(maybe_remove_dirsep(Result, OsType));
+join1b(<<>>, RelativeName, [$:|Rest], win32) ->
+ join1b(RelativeName, <<>>, [$:|Rest], win32);
+join1b(<<>>, RelativeName, [$/|Result], OsType) ->
+ join1b(RelativeName, <<>>, [$/|Result], OsType);
+join1b(<<>>, RelativeName, Result, OsType) ->
+ join1b(RelativeName, <<>>, [$/|Result], OsType);
+join1b(<<Char,Rest/binary>>, RelativeName, Result, OsType) when is_integer(Char) ->
+ join1b(Rest, RelativeName, [Char|Result], OsType).
+
maybe_remove_dirsep([$/, $:, Letter], win32) ->
[Letter, $:, $/];
maybe_remove_dirsep([$/], _) ->
@@ -357,7 +478,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(file:filename(), file:name()) -> file:filename().
append(Dir, Name) ->
Dir ++ [$/|Name].
@@ -373,22 +494,17 @@ 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) ->
+pathtype(Name) when is_list(Name) or is_binary(Name) ->
case os:type() of
{unix, _} -> unix_pathtype(Name);
- {win32, _} -> win32_pathtype(Name);
- vxworks -> case vxworks_first(Name) of
- {device, _Rest, _Dev} ->
- absolute;
- _ ->
- relative
- end;
- {ose,_} -> unix_pathtype(Name)
+ {win32, _} -> win32_pathtype(Name)
end.
+unix_pathtype(<<$/,_/binary>>) ->
+ absolute;
unix_pathtype([$/|_]) ->
absolute;
unix_pathtype([List|Rest]) when is_list(List) ->
@@ -404,6 +520,15 @@ win32_pathtype([Atom|Rest]) when is_atom(Atom) ->
win32_pathtype(atom_to_list(Atom)++Rest);
win32_pathtype([Char, List|Rest]) when is_list(List) ->
win32_pathtype([Char|List++Rest]);
+win32_pathtype(<<$/, $/, _/binary>>) -> absolute;
+win32_pathtype(<<$\\, $/, _/binary>>) -> absolute;
+win32_pathtype(<<$/, $\\, _/binary>>) -> absolute;
+win32_pathtype(<<$\\, $\\, _/binary>>) -> absolute;
+win32_pathtype(<<$/, _/binary>>) -> volumerelative;
+win32_pathtype(<<$\\, _/binary>>) -> volumerelative;
+win32_pathtype(<<_Letter, $:, $/, _/binary>>) -> absolute;
+win32_pathtype(<<_Letter, $:, $\\, _/binary>>) -> absolute;
+win32_pathtype(<<_Letter, $:, _/binary>>) -> volumerelative;
win32_pathtype([$/, $/|_]) -> absolute;
win32_pathtype([$\\, $/|_]) -> absolute;
win32_pathtype([$/, $\\|_]) -> absolute;
@@ -422,7 +547,9 @@ 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()) -> file:filename().
+rootname(Name) when is_binary(Name) ->
+ list_to_binary(rootname(binary_to_list(Name))); % No need to handle unicode, . is < 128
rootname(Name0) ->
Name = flatten(Name0),
rootname(Name, [], [], major_os_type()).
@@ -431,8 +558,6 @@ rootname([$/|Rest], Root, Ext, OsType) ->
rootname(Rest, [$/]++Ext++Root, [], OsType);
rootname([$\\|Rest], Root, Ext, win32) ->
rootname(Rest, [$/]++Ext++Root, [], win32);
-rootname([$\\|Rest], Root, Ext, vxworks) ->
- rootname(Rest, [$/]++Ext++Root, [], vxworks);
rootname([$.|Rest], Root, [], OsType) ->
rootname(Rest, Root, ".", OsType);
rootname([$.|Rest], Root, Ext, OsType) ->
@@ -451,7 +576,13 @@ 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()) -> file:filename().
+rootname(Name, Ext) when is_binary(Name), is_binary(Ext) ->
+ list_to_binary(rootname(binary_to_list(Name),binary_to_list(Ext)));
+rootname(Name, Ext) when is_binary(Name) ->
+ rootname(Name,filename_string_to_binary(Ext));
+rootname(Name, Ext) when is_binary(Ext) ->
+ rootname(filename_string_to_binary(Name),Ext);
rootname(Name0, Ext0) ->
Name = flatten(Name0),
Ext = flatten(Ext0),
@@ -471,27 +602,55 @@ 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()) -> [file:filename()].
+split(Name) when is_binary(Name) ->
+ case os:type() of
+ {win32, _} -> win32_splitb(Name);
+ _ -> unix_splitb(Name)
+ end;
+
split(Name0) ->
Name = flatten(Name0),
case os:type() of
- {unix, _} -> unix_split(Name);
{win32, _} -> win32_split(Name);
- vxworks -> vxworks_split(Name);
- {ose,_} -> unix_split(Name)
+ _ -> unix_split(Name)
end.
-%% If a VxWorks filename starts with '[/\].*[^/\]' '[/\].*:' or '.*:'
-%% that part of the filename is considered a device.
-%% The rest of the name is interpreted exactly as for win32.
-%% XXX - dirty solution to make filename:split([]) return the same thing on
-%% VxWorks as on unix and win32.
-vxworks_split([]) ->
- [];
-vxworks_split(L) ->
- {_Devicep, Rest, FirstComp} = vxworks_first(L),
- split(Rest, [], [lists:reverse(FirstComp)], win32).
+unix_splitb(Name) ->
+ L = binary:split(Name,[<<"/">>],[global]),
+ LL = case L of
+ [<<>>|Rest] ->
+ [<<"/">>|Rest];
+ _ ->
+ L
+ end,
+ [ X || X <- LL, X =/= <<>>].
+
+
+fix_driveletter(Letter0) ->
+ if
+ Letter0 >= $A, Letter0 =< $Z ->
+ Letter0+$a-$A;
+ true ->
+ Letter0
+ end.
+win32_splitb(<<Letter0,$:, Slash, Rest/binary>>) when (((Slash =:= $\\) orelse (Slash =:= $/)) andalso
+ ?IS_DRIVELETTER(Letter0)) ->
+ Letter = fix_driveletter(Letter0),
+ L = binary:split(Rest,[<<"/">>,<<"\\">>],[global]),
+ [<<Letter,$:,$/>> | [ X || X <- L, X =/= <<>> ]];
+win32_splitb(<<Letter0,$:,Rest/binary>>) when ?IS_DRIVELETTER(Letter0) ->
+ Letter = fix_driveletter(Letter0),
+ L = binary:split(Rest,[<<"/">>,<<"\\">>],[global]),
+ [<<Letter,$:>> | [ X || X <- L, X =/= <<>> ]];
+win32_splitb(<<Slash,Rest/binary>>) when ((Slash =:= $\\) orelse (Slash =:= $/)) ->
+ L = binary:split(Rest,[<<"/">>,<<"\\">>],[global]),
+ [<<$/>> | [ X || X <- L, X =/= <<>> ]];
+win32_splitb(Name) ->
+ L = binary:split(Name,[<<"/">>,<<"\\">>],[global]),
+ [ X || X <- L, X =/= <<>> ].
+
unix_split(Name) ->
split(Name, [], unix).
@@ -502,8 +661,6 @@ win32_split([X, $\\|Rest]) when is_integer(X) ->
win32_split([X, $/|Rest]);
win32_split([X, Y, $\\|Rest]) when is_integer(X), is_integer(Y) ->
win32_split([X, Y, $/|Rest]);
-win32_split([$/, $/|Rest]) ->
- split(Rest, [], [[$/, $/]]);
win32_split([UcLetter, $:|Rest]) when UcLetter >= $A, UcLetter =< $Z ->
win32_split([UcLetter+$a-$A, $:|Rest]);
win32_split([Letter, $:, $/|Rest]) ->
@@ -540,7 +697,7 @@ split([], Comp, Components, OsType) ->
%% will be converted to backslashes. On all platforms, the
%% name will be normalized as done by join/1.
--spec nativename(string()) -> string().
+-spec nativename(file:filename()) -> file:filename().
nativename(Name0) ->
Name = join([Name0]), %Normalize.
case os:type() of
@@ -557,13 +714,12 @@ win32_nativename([]) ->
separators() ->
case os:type() of
- {unix, _} -> {false, false};
{win32, _} -> {$\\, $:};
- vxworks -> {$\\, false};
- {ose,_} -> {false, false}
+ _ -> {false, false}
end.
+
%% find_src(Module) --
%% find_src(Module, Rules) --
%%
@@ -733,45 +889,12 @@ major_os_type() ->
OsT -> OsT
end.
-%% Need to take care of the first pathname component separately
-%% due to VxWorks less than good device naming rules.
-%% (i.e. this is VxWorks specific ...)
-%% The following four all starts with device names
-%% elrond:/foo -> elrond:
-%% elrond:\\foo.bar -> elrond:
-%% /DISK1:foo -> /DISK1:
-%% /usr/include -> /usr
-%% This one doesn't:
-%% foo/bar
-
-vxworks_first([]) ->
- {not_device, [], []};
-vxworks_first([$/|T]) ->
- vxworks_first2(device, T, [$/]);
-vxworks_first([$\\|T]) ->
- vxworks_first2(device, T, [$/]);
-vxworks_first([H|T]) when is_list(H) ->
- vxworks_first(H++T);
-vxworks_first([H|T]) ->
- vxworks_first2(not_device, T, [H]).
-
-vxworks_first2(Devicep, [], FirstComp) ->
- {Devicep, [], FirstComp};
-vxworks_first2(Devicep, [$/|T], FirstComp) ->
- {Devicep, [$/|T], FirstComp};
-vxworks_first2(Devicep, [$\\|T], FirstComp) ->
- {Devicep, [$/|T], FirstComp};
-vxworks_first2(_Devicep, [$:|T], FirstComp)->
- {device, T, [$:|FirstComp]};
-vxworks_first2(Devicep, [H|T], FirstComp) when is_list(H) ->
- vxworks_first2(Devicep, H++T, FirstComp);
-vxworks_first2(Devicep, [H|T], FirstComp) ->
- vxworks_first2(Devicep, T, [H|FirstComp]).
-
%% flatten(List)
%% Flatten a list, also accepting atoms.
--spec flatten(name()) -> string().
+-spec flatten(file:name()) -> file:filename().
+flatten(Bin) when is_binary(Bin) ->
+ Bin;
flatten(List) ->
do_flatten(List, []).
@@ -785,3 +908,12 @@ do_flatten([], Tail) ->
Tail;
do_flatten(Atom, Tail) when is_atom(Atom) ->
atom_to_list(Atom) ++ flatten(Tail).
+
+filename_string_to_binary(List) ->
+ case unicode:characters_to_binary(flatten(List),unicode,file:native_name_encoding()) of
+ {error,_,_} ->
+ erlang:error(badarg);
+ Bin when is_binary(Bin) ->
+ Bin
+ end.
+
diff --git a/lib/stdlib/src/gb_sets.erl b/lib/stdlib/src/gb_sets.erl
index 086dc79b46..113f29e252 100644
--- a/lib/stdlib/src/gb_sets.erl
+++ b/lib/stdlib/src/gb_sets.erl
@@ -657,7 +657,7 @@ intersection_2([], _, As, S) ->
intersection_2(_, [], As, S) ->
{S, balance_revlist(As, S)}.
--spec intersection([gb_set()]) -> gb_set().
+-spec intersection([gb_set(),...]) -> gb_set().
intersection([S | Ss]) ->
intersection_list(S, Ss).
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..b1e9e3a02f 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.
@@ -678,12 +677,23 @@ report_error(Handler, Reason, State, LastIn, SName) ->
_ ->
Reason
end,
+ Mod = Handler#handler.module,
+ FmtState = case erlang:function_exported(Mod, format_status, 2) of
+ true ->
+ Args = [get(), State],
+ case catch Mod:format_status(terminate, Args) of
+ {'EXIT', _} -> State;
+ Else -> Else
+ end;
+ _ ->
+ State
+ end,
error_msg("** gen_event handler ~p crashed.~n"
"** Was installed in ~p~n"
"** Last event was: ~p~n"
"** When handler state == ~p~n"
"** Reason == ~p~n",
- [handler(Handler),SName,LastIn,State,Reason1]).
+ [handler(Handler),SName,LastIn,FmtState,Reason1]).
handler(Handler) when not Handler#handler.id ->
Handler#handler.module;
@@ -712,10 +722,20 @@ get_modules(MSL) ->
%%-----------------------------------------------------------------
%% Status information
%%-----------------------------------------------------------------
-format_status(_Opt, StatusData) ->
- [_PDict, SysState, Parent, _Debug, [ServerName, MSL, _Hib]] = StatusData,
+format_status(Opt, StatusData) ->
+ [PDict, SysState, Parent, _Debug, [ServerName, MSL, _Hib]] = StatusData,
Header = lists:concat(["Status for event handler ", ServerName]),
+ FmtMSL = [case erlang:function_exported(Mod, format_status, 2) of
+ true ->
+ Args = [PDict, State],
+ case catch Mod:format_status(Opt, Args) of
+ {'EXIT', _} -> MSL;
+ Else -> MS#handler{state = Else}
+ end;
+ _ ->
+ MS
+ end || #handler{module = Mod, state = State} = MS <- MSL],
[{header, Header},
{data, [{"Status", SysState},
{"Parent", Parent}]},
- {items, {"Installed handlers", MSL}}].
+ {items, {"Installed handlers", FmtMSL}}].
diff --git a/lib/stdlib/src/gen_fsm.erl b/lib/stdlib/src/gen_fsm.erl
index ba0275ae2b..7d9960b912 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}).
%%% ---------------------------------------------------
@@ -542,7 +542,18 @@ terminate(Reason, Name, Msg, Mod, StateName, StateData, Debug) ->
{shutdown,_}=Shutdown ->
exit(Shutdown);
_ ->
- error_info(Reason, Name, Msg, StateName, StateData, Debug),
+ FmtStateData =
+ case erlang:function_exported(Mod, format_status, 2) of
+ true ->
+ Args = [get(), StateData],
+ case catch Mod:format_status(terminate, Args) of
+ {'EXIT', _} -> StateData;
+ Else -> Else
+ end;
+ _ ->
+ StateData
+ end,
+ error_info(Reason,Name,Msg,StateName,FmtStateData,Debug),
exit(Reason)
end
end.
@@ -603,22 +614,27 @@ get_msg(Msg) -> Msg.
format_status(Opt, StatusData) ->
[PDict, SysState, Parent, Debug, [Name, StateName, StateData, Mod, _Time]] =
StatusData,
- NameTag = if is_pid(Name) ->
- pid_to_list(Name);
- is_atom(Name) ->
- Name
- end,
- Header = lists:concat(["Status for state machine ", NameTag]),
+ StatusHdr = "Status for state machine",
+ Header = if
+ is_pid(Name) ->
+ lists:concat([StatusHdr, " ", pid_to_list(Name)]);
+ is_atom(Name); is_list(Name) ->
+ lists:concat([StatusHdr, " ", Name]);
+ true ->
+ {StatusHdr, Name}
+ end,
Log = sys:get_debug(log, Debug, []),
- Specfic =
+ DefaultStatus = [{data, [{"StateData", StateData}]}],
+ Specfic =
case erlang:function_exported(Mod, format_status, 2) of
true ->
case catch Mod:format_status(Opt,[PDict,StateData]) of
- {'EXIT', _} -> [{data, [{"StateData", StateData}]}];
- Else -> Else
+ {'EXIT', _} -> DefaultStatus;
+ StatusList when is_list(StatusList) -> StatusList;
+ Else -> [Else]
end;
_ ->
- [{data, [{"StateData", StateData}]}]
+ DefaultStatus
end,
[{header, Header},
{data, [{"Status", SysState},
diff --git a/lib/stdlib/src/gen_server.erl b/lib/stdlib/src/gen_server.erl
index f1a9a31c63..ac81df9cab 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} ).
@@ -705,7 +705,18 @@ terminate(Reason, Name, Msg, Mod, State, Debug) ->
{shutdown,_}=Shutdown ->
exit(Shutdown);
_ ->
- error_info(Reason, Name, Msg, State, Debug),
+ FmtState =
+ case erlang:function_exported(Mod, format_status, 2) of
+ true ->
+ Args = [get(), State],
+ case catch Mod:format_status(terminate, Args) of
+ {'EXIT', _} -> State;
+ Else -> Else
+ end;
+ _ ->
+ State
+ end,
+ error_info(Reason, Name, Msg, FmtState, Debug),
exit(Reason)
end
end.
@@ -829,22 +840,27 @@ name_to_pid(Name) ->
%%-----------------------------------------------------------------
format_status(Opt, StatusData) ->
[PDict, SysState, Parent, Debug, [Name, State, Mod, _Time]] = StatusData,
- NameTag = if is_pid(Name) ->
- pid_to_list(Name);
- is_atom(Name) ->
- Name
- end,
- Header = lists:concat(["Status for generic server ", NameTag]),
+ StatusHdr = "Status for generic server",
+ Header = if
+ is_pid(Name) ->
+ lists:concat([StatusHdr, " ", pid_to_list(Name)]);
+ is_atom(Name); is_list(Name) ->
+ lists:concat([StatusHdr, " ", Name]);
+ true ->
+ {StatusHdr, Name}
+ end,
Log = sys:get_debug(log, Debug, []),
- Specfic =
+ DefaultStatus = [{data, [{"State", State}]}],
+ Specfic =
case erlang:function_exported(Mod, format_status, 2) of
true ->
case catch Mod:format_status(Opt, [PDict, State]) of
- {'EXIT', _} -> [{data, [{"State", State}]}];
- Else -> Else
+ {'EXIT', _} -> DefaultStatus;
+ StatusList when is_list(StatusList) -> StatusList;
+ Else -> [Else]
end;
_ ->
- [{data, [{"State", State}]}]
+ DefaultStatus
end,
[{header, Header},
{data, [{"Status", SysState},
diff --git a/lib/stdlib/src/io.erl b/lib/stdlib/src/io.erl
index 1f8076e864..1d0f9374bc 100644
--- a/lib/stdlib/src/io.erl
+++ b/lib/stdlib/src/io.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(io).
@@ -32,6 +32,7 @@
parse_erl_form/1,parse_erl_form/2,parse_erl_form/3]).
-export([request/1,request/2,requests/1,requests/2]).
+-export_type([device/0, format/0]).
%%-------------------------------------------------------------------------
diff --git a/lib/stdlib/src/io_lib.erl b/lib/stdlib/src/io_lib.erl
index 26f6ec8931..4ca9d079b7 100644
--- a/lib/stdlib/src/io_lib.erl
+++ b/lib/stdlib/src/io_lib.erl
@@ -75,6 +75,8 @@
collect_line/2, collect_line/3, collect_line/4,
get_until/3, get_until/4]).
+-export_type([chars/0]).
+
%%----------------------------------------------------------------------
%% XXX: overapproximates a deep list of (unicode) characters
diff --git a/lib/stdlib/src/io_lib_fread.erl b/lib/stdlib/src/io_lib_fread.erl
index 74316dc730..33553692bc 100644
--- a/lib/stdlib/src/io_lib_fread.erl
+++ b/lib/stdlib/src/io_lib_fread.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(io_lib_fread).
@@ -22,6 +22,8 @@
-export([fread/2,fread/3]).
+-export_type([continuation/0, fread_2_ret/0, fread_3_ret/0]).
+
-import(lists, [reverse/1,reverse/2]).
%%-----------------------------------------------------------------------
diff --git a/lib/stdlib/src/lists.erl b/lib/stdlib/src/lists.erl
index e1f8d1c200..c669c1f7c1 100644
--- a/lib/stdlib/src/lists.erl
+++ b/lib/stdlib/src/lists.erl
@@ -1,23 +1,26 @@
%%
%% %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).
+-compile({no_auto_import,[max/2]}).
+-compile({no_auto_import,[min/2]}).
+
-export([append/2, append/1, subtract/2, reverse/1,
nth/2, nthtail/2, prefix/2, suffix/2, last/1,
seq/2, seq/3, sum/1, duplicate/2, min/1, max/1, sublist/2, sublist/3,
@@ -25,7 +28,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 +43,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!
@@ -349,7 +350,7 @@ sort_1(X, [], R) ->
%% merge(List) -> L
%% merges a list of sorted lists
--spec merge([T]) -> [T].
+-spec merge([[T]]) -> [T].
merge(L) ->
mergel(L, []).
@@ -357,7 +358,7 @@ merge(L) ->
%% merge3(X, Y, Z) -> L
%% merges three sorted lists X, Y and Z
--spec merge3([_], [_], [_]) -> [_].
+-spec merge3([X], [Y], [Z]) -> [(X | Y | Z)].
merge3(L1, [], L3) ->
merge(L1, L3);
@@ -369,7 +370,7 @@ merge3(L1, [H2 | T2], [H3 | T3]) ->
%% rmerge3(X, Y, Z) -> L
%% merges three reversed sorted lists X, Y and Z
--spec rmerge3([_], [_], [_]) -> [_].
+-spec rmerge3([X], [Y], [Z]) -> [(X | Y | Z)].
rmerge3(L1, [], L3) ->
rmerge(L1, L3);
@@ -381,7 +382,7 @@ rmerge3(L1, [H2 | T2], [H3 | T3]) ->
%% merge(X, Y) -> L
%% merges two sorted lists X and Y
--spec merge([_], [_]) -> [_].
+-spec merge([X], [Y]) -> [(X | Y)].
merge(T1, []) ->
T1;
@@ -393,7 +394,7 @@ merge(T1, [H2 | T2]) ->
%% reverse(rmerge(reverse(A),reverse(B))) is equal to merge(I,A,B).
--spec rmerge([_], [_]) -> [_].
+-spec rmerge([X], [Y]) -> [(X | Y)].
rmerge(T1, []) ->
T1;
@@ -419,12 +420,12 @@ thing_to_list(X) when is_list(X) -> X. %Assumed to be a string
%% flatten(List, Tail)
%% Flatten a list, adding optional tail.
--spec flatten([_]) -> [_].
+-spec flatten([term()]) -> [term()].
flatten(List) when is_list(List) ->
do_flatten(List, []).
--spec flatten([_], [_]) -> [_].
+-spec flatten([term()], [term()]) -> [term()].
flatten(List, Tail) when is_list(List), is_list(Tail) ->
do_flatten(List, Tail).
@@ -436,17 +437,10 @@ 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.
--spec flatlength([_]) -> non_neg_integer().
+-spec flatlength([term()]) -> non_neg_integer().
flatlength(List) ->
flatlength(List, 0).
@@ -487,7 +481,7 @@ flatlength([], L) -> L.
% keysearch3(Key, N, T);
%keysearch3(Key, N, []) -> false.
--spec keydelete(_, pos_integer(), [T]) -> [T].
+-spec keydelete(term(), pos_integer(), [T]) -> [T] when T :: tuple().
keydelete(K, N, L) when is_integer(N), N > 0 ->
keydelete3(K, N, L).
@@ -497,7 +491,7 @@ keydelete3(Key, N, [H|T]) ->
[H|keydelete3(Key, N, T)];
keydelete3(_, _, []) -> [].
--spec keyreplace(_, pos_integer(), [_], tuple()) -> [_].
+-spec keyreplace(term(), pos_integer(), [tuple()], tuple()) -> [tuple()].
keyreplace(K, N, L, New) when is_integer(N), N > 0, is_tuple(New) ->
keyreplace3(K, N, L, New).
@@ -508,7 +502,8 @@ keyreplace3(Key, Pos, [H|T], New) ->
[H|keyreplace3(Key, Pos, T, New)];
keyreplace3(_, _, [], _) -> [].
--spec keytake(_, pos_integer(), [_]) -> {'value', tuple(), [_]} | 'false'.
+-spec keytake(term(), pos_integer(), [tuple()]) ->
+ {'value', tuple(), [tuple()]} | 'false'.
keytake(Key, N, L) when is_integer(N), N > 0 ->
keytake(Key, N, L, []).
@@ -519,7 +514,8 @@ keytake(Key, N, [H|T], L) ->
keytake(Key, N, T, [H|L]);
keytake(_K, _N, [], _L) -> false.
--spec keystore(_, pos_integer(), [_], tuple()) -> [_].
+-spec keystore(term(), pos_integer(), [tuple()], tuple()) -> [tuple(),...].
+
keystore(K, N, L, New) when is_integer(N), N > 0, is_tuple(New) ->
keystore2(K, N, L, New).
@@ -530,7 +526,7 @@ keystore2(Key, N, [H|T], New) ->
keystore2(_Key, _N, [], New) ->
[New].
--spec keysort(pos_integer(), [T]) -> [T] when is_subtype(T, tuple()).
+-spec keysort(pos_integer(), [T]) -> [T] when T :: tuple().
keysort(I, L) when is_integer(I), I > 0 ->
case L of
@@ -588,7 +584,7 @@ keysort_1(_I, X, _EX, [], R) ->
lists:reverse(R, [X]).
-spec keymerge(pos_integer(), [X], [Y]) ->
- [R] when is_subtype(X, tuple()), is_subtype(Y, tuple()), is_subtype(R, tuple()).
+ [R] when X :: tuple(), Y :: tuple(), R :: tuple().
keymerge(Index, T1, L2) when is_integer(Index), Index > 0 ->
case L2 of
@@ -603,7 +599,7 @@ keymerge(Index, T1, L2) when is_integer(Index), Index > 0 ->
%% reverse(rkeymerge(I,reverse(A),reverse(B))) is equal to keymerge(I,A,B).
-spec rkeymerge(pos_integer(), [X], [Y]) ->
- [R] when is_subtype(X, tuple()), is_subtype(Y, tuple()), is_subtype(R, tuple()).
+ [R] when X :: tuple(), Y :: tuple(), R :: tuple().
rkeymerge(Index, T1, L2) when is_integer(Index), Index > 0 ->
case L2 of
@@ -615,7 +611,7 @@ rkeymerge(Index, T1, L2) when is_integer(Index), Index > 0 ->
lists:reverse(M, [])
end.
--spec ukeysort(pos_integer(), [T]) -> [T] when is_subtype(T, tuple()).
+-spec ukeysort(pos_integer(), [T]) -> [T] when T :: tuple().
ukeysort(I, L) when is_integer(I), I > 0 ->
case L of
@@ -681,7 +677,7 @@ ukeysort_1(_I, X, _EX, []) ->
[X].
-spec ukeymerge(pos_integer(), [X], [Y]) ->
- [(X | Y)] when is_subtype(X, tuple()), is_subtype(Y, tuple()).
+ [(X | Y)] when X :: tuple(), Y :: tuple().
ukeymerge(Index, L1, T2) when is_integer(Index), Index > 0 ->
case L1 of
@@ -696,7 +692,7 @@ ukeymerge(Index, L1, T2) when is_integer(Index), Index > 0 ->
%% reverse(rukeymerge(I,reverse(A),reverse(B))) is equal to ukeymerge(I,A,B).
-spec rukeymerge(pos_integer(), [X], [Y]) ->
- [(X | Y)] when is_subtype(X, tuple()), is_subtype(Y, tuple()).
+ [(X | Y)] when X :: tuple(), Y :: tuple().
rukeymerge(Index, T1, L2) when is_integer(Index), Index > 0 ->
case L2 of
@@ -708,7 +704,7 @@ rukeymerge(Index, T1, L2) when is_integer(Index), Index > 0 ->
lists:reverse(M, [])
end.
--spec keymap(fun((_) -> _), pos_integer(), [tuple()]) -> [tuple()].
+-spec keymap(fun((term()) -> term()), pos_integer(), [tuple()]) -> [tuple()].
keymap(Fun, Index, [Tup|Tail]) ->
[setelement(Index, Tup, Fun(element(Index, Tup)))|keymap(Fun, Index, Tail)];
@@ -731,7 +727,7 @@ sort(Fun, [X, Y | T]) ->
fsplit_2(Y, X, Fun, T, [], [])
end.
--spec merge(fun((X, Y) -> boolean()), [X], [Y]) -> [_].
+-spec merge(fun((X, Y) -> boolean()), [X], [Y]) -> [(X | Y)].
merge(Fun, T1, [H2 | T2]) when is_function(Fun, 2) ->
lists:reverse(fmerge2_1(T1, H2, Fun, T2, []), []);
@@ -740,7 +736,7 @@ merge(Fun, T1, []) when is_function(Fun, 2) ->
%% reverse(rmerge(F,reverse(A),reverse(B))) is equal to merge(F,A,B).
--spec rmerge(fun((X, Y) -> boolean()), [X], [Y]) -> [_].
+-spec rmerge(fun((X, Y) -> boolean()), [X], [Y]) -> [(X | Y)].
rmerge(Fun, T1, [H2 | T2]) when is_function(Fun, 2) ->
lists:reverse(rfmerge2_1(T1, H2, Fun, T2, []), []);
@@ -774,7 +770,7 @@ usort_1(Fun, X, [Y | L]) ->
ufsplit_2(Y, L, Fun, [X])
end.
--spec umerge(fun((X, Y) -> boolean()), [X], [Y]) -> [_].
+-spec umerge(fun((X, Y) -> boolean()), [X], [Y]) -> [(X | Y)].
umerge(Fun, [], T2) when is_function(Fun, 2) ->
T2;
@@ -783,7 +779,7 @@ umerge(Fun, [H1 | T1], T2) when is_function(Fun, 2) ->
%% reverse(rumerge(F,reverse(A),reverse(B))) is equal to umerge(F,A,B).
--spec rumerge(fun((X, Y) -> boolean()), [X], [Y]) -> [_].
+-spec rumerge(fun((X, Y) -> boolean()), [X], [Y]) -> [(X | Y)].
rumerge(Fun, T1, []) when is_function(Fun, 2) ->
T1;
@@ -848,7 +844,7 @@ usort_1(X, []) ->
%% umerge(List) -> L
%% merges a list of sorted lists without duplicates, removes duplicates
--spec umerge([T]) -> [T].
+-spec umerge([[T]]) -> [T].
umerge(L) ->
umergel(L).
@@ -857,7 +853,7 @@ umerge(L) ->
%% merges three sorted lists X, Y and Z without duplicates,
%% removes duplicates
--spec umerge3([_], [_], [_]) -> [_].
+-spec umerge3([X], [Y], [Z]) -> [(X | Y | Z)].
umerge3(L1, [], L3) ->
umerge(L1, L3);
@@ -870,7 +866,7 @@ umerge3(L1, [H2 | T2], [H3 | T3]) ->
%% merges three reversed sorted lists X, Y and Z without duplicates,
%% removes duplicates
--spec rumerge3([_], [_], [_]) -> [_].
+-spec rumerge3([X], [Y], [Z]) -> [(X | Y | Z)].
rumerge3(L1, [], L3) ->
rumerge(L1, L3);
@@ -882,7 +878,7 @@ rumerge3(L1, [H2 | T2], [H3 | T3]) ->
%% umerge(X, Y) -> L
%% merges two sorted lists X and Y without duplicates, removes duplicates
--spec umerge([_], [_]) -> [_].
+-spec umerge([X], [Y]) -> [(X | Y)].
umerge([], T2) ->
T2;
@@ -895,7 +891,7 @@ umerge([H1 | T1], T2) ->
%% reverse(rumerge(reverse(A),reverse(B))) is equal to umerge(I,A,B).
--spec rumerge([_], [_]) -> [_].
+-spec rumerge([X], [Y]) -> [(X | Y)].
rumerge(T1, []) ->
T1;
@@ -958,13 +954,13 @@ flatmap(F, [Hd|Tail]) ->
F(Hd) ++ flatmap(F, Tail);
flatmap(F, []) when is_function(F, 1) -> [].
--spec foldl(fun((T, _) -> _), _, [T]) -> _.
+-spec foldl(fun((T, term()) -> term()), term(), [T]) -> term().
foldl(F, Accu, [Hd|Tail]) ->
foldl(F, F(Hd, Accu), Tail);
foldl(F, Accu, []) when is_function(F, 2) -> Accu.
--spec foldr(fun((T, _) -> _), _, [T]) -> _.
+-spec foldr(fun((T, term()) -> term()), term(), [T]) -> term().
foldr(F, Accu, [Hd|Tail]) ->
F(Hd, foldr(F, Accu, Tail));
@@ -1004,14 +1000,14 @@ zf(F, [Hd|Tail]) ->
end;
zf(F, []) when is_function(F, 1) -> [].
--spec foreach(F :: fun((T) -> _), List :: [T]) -> 'ok'.
+-spec foreach(F :: fun((T) -> term()), List :: [T]) -> 'ok'.
foreach(F, [Hd|Tail]) ->
F(Hd),
foreach(F, Tail);
foreach(F, []) when is_function(F, 1) -> ok.
--spec mapfoldl(fun((T, _) -> {_, _}), _, [T]) -> {[_], _}.
+-spec mapfoldl(fun((A, term()) -> {B, term()}), term(), [A]) -> {[B], term()}.
mapfoldl(F, Accu0, [Hd|Tail]) ->
{R,Accu1} = F(Hd, Accu0),
@@ -1019,7 +1015,7 @@ mapfoldl(F, Accu0, [Hd|Tail]) ->
{[R|Rs],Accu2};
mapfoldl(F, Accu, []) when is_function(F, 2) -> {[],Accu}.
--spec mapfoldr(fun((T, _) -> {_, _}), _, [T]) -> {[_], _}.
+-spec mapfoldr(fun((A, term()) -> {B, term()}), term(), [A]) -> {[B], term()}.
mapfoldr(F, Accu0, [Hd|Tail]) ->
{Rs,Accu1} = mapfoldr(F, Accu0, Tail),
diff --git a/lib/stdlib/src/ms_transform.erl b/lib/stdlib/src/ms_transform.erl
index 78b1de6e16..a249dea525 100644
--- a/lib/stdlib/src/ms_transform.erl
+++ b/lib/stdlib/src/ms_transform.erl
@@ -43,6 +43,7 @@
-define(ERR_GENREMOTECALL,22).
-define(ERR_GENBINCONSTRUCT,23).
-define(ERR_GENDISALLOWEDOP,24).
+-define(WARN_SHADOW_VAR,50).
-define(ERR_GUARDMATCH,?ERR_GENMATCH+?ERROR_BASE_GUARD).
-define(ERR_BODYMATCH,?ERR_GENMATCH+?ERROR_BASE_BODY).
-define(ERR_GUARDLOCALCALL,?ERR_GENLOCALCALL+?ERROR_BASE_GUARD).
@@ -63,8 +64,13 @@
-define(ERR_BODYDISALLOWEDOP,?ERR_GENDISALLOWEDOP+?ERROR_BASE_BODY).
%%
-%% Called by compiler or ets/dbg:fun2ms when errors occur
+%% Called by compiler or ets/dbg:fun2ms when errors/warnings occur
%%
+format_error({?WARN_SHADOW_VAR,Name}) ->
+ lists:flatten(
+ io_lib:format("variable ~p shadowed in ms_transform fun head",
+ [Name]));
+
format_error(?ERR_NOFUN) ->
"Parameter of ets/dbg:fun2ms/1 is not a literal fun";
format_error(?ERR_ETS_HEAD) ->
@@ -182,7 +188,7 @@ format_error(Else) ->
%%
transform_from_shell(Dialect, Clauses, BoundEnvironment) ->
SaveFilename = setup_filename(),
- case catch ms_clause_list(1,Clauses,Dialect) of
+ case catch ms_clause_list(1,Clauses,Dialect,gb_sets:new()) of
{'EXIT',Reason} ->
cleanup_filename(SaveFilename),
exit(Reason);
@@ -207,6 +213,7 @@ transform_from_shell(Dialect, Clauses, BoundEnvironment) ->
%%
parse_transform(Forms, _Options) ->
SaveFilename = setup_filename(),
+ %io:format("Forms: ~p~n",[Forms]),
case catch forms(Forms) of
{'EXIT',Reason} ->
cleanup_filename(SaveFilename),
@@ -215,12 +222,31 @@ parse_transform(Forms, _Options) ->
{error, [{cleanup_filename(SaveFilename),
[{Line, ?MODULE, R}]}], []};
Else ->
- cleanup_filename(SaveFilename),
+ %io:format("Transformed into: ~p~n",[Else]),
+ case get_warnings() of
+ [] ->
+ cleanup_filename(SaveFilename),
+ Else;
+ WL ->
+ FName = cleanup_filename(SaveFilename) ,
+ WList = [ {FName, [{L, ?MODULE, R}]} || {L,R} <- WL ],
+ {warning, Else, WList}
+ end
+ end.
+
+get_warnings() ->
+ case get(warnings) of
+ undefined ->
+ [];
+ Else ->
Else
end.
+add_warning(Line,R) ->
+ put(warnings,[{Line,R}| get_warnings()]).
+
setup_filename() ->
- {erase(filename),erase(records)}.
+ {erase(filename),erase(records),erase(warnings)}.
put_filename(Name) ->
put(filename,Name).
@@ -235,7 +261,7 @@ get_records() ->
Else ->
Else
end.
-cleanup_filename({Old,OldRec}) ->
+cleanup_filename({Old,OldRec,OldWarnings}) ->
Ret = case erase(filename) of
undefined ->
"TOP_LEVEL";
@@ -248,6 +274,12 @@ cleanup_filename({Old,OldRec}) ->
Rec ->
put(records,Rec)
end,
+ case OldWarnings of
+ undefined ->
+ erase(warnings);
+ Warn ->
+ put(warnings,Warn)
+ end,
case Old of
undefined ->
Ret;
@@ -285,42 +317,77 @@ form({function,Line,Name0,Arity0,Clauses0}) ->
form(AnyOther) ->
AnyOther.
function(Name, Arity, Clauses0) ->
- Clauses1 = clauses(Clauses0),
+ {Clauses1,_} = clauses(Clauses0,gb_sets:new()),
{Name,Arity,Clauses1}.
-clauses([C0|Cs]) ->
- C1 = clause(C0),
- [C1|clauses(Cs)];
-clauses([]) -> [].
-clause({clause,Line,H0,G0,B0}) ->
- B1 = copy(B0),
- {clause,Line,H0,G0,B1}.
+clauses([C0|Cs],Bound) ->
+ {C1,Bound1} = clause(C0,Bound),
+ {C2,Bound2} = clauses(Cs,Bound1),
+ {[C1|C2],Bound2};
+clauses([],Bound) -> {[],Bound}.
+clause({clause,Line,H0,G0,B0},Bound) ->
+ {H1,Bound1} = copy(H0,Bound),
+ {B1,Bound2} = copy(B0,Bound1),
+ {{clause,Line,H1,G0,B1},Bound2}.
copy({call,Line,{remote,_Line2,{atom,_Line3,ets},{atom,_Line4,fun2ms}},
- As0}) ->
- transform_call(ets,Line,As0);
+ As0},Bound) ->
+ {transform_call(ets,Line,As0,Bound),Bound};
copy({call,Line,{remote,_Line2,{record_field,_Line3,
{atom,_Line4,''},{atom,_Line5,ets}},
- {atom,_Line6,fun2ms}}, As0}) ->
+ {atom,_Line6,fun2ms}}, As0},Bound) ->
%% Packages...
- transform_call(ets,Line,As0);
+ {transform_call(ets,Line,As0,Bound),Bound};
copy({call,Line,{remote,_Line2,{atom,_Line3,dbg},{atom,_Line4,fun2ms}},
- As0}) ->
- transform_call(dbg,Line,As0);
-copy(T) when is_tuple(T) ->
- list_to_tuple(copy_list(tuple_to_list(T)));
-copy(L) when is_list(L) ->
- copy_list(L);
-copy(AnyOther) ->
- AnyOther.
+ As0},Bound) ->
+ {transform_call(dbg,Line,As0,Bound),Bound};
+copy({match,Line,A,B},Bound) ->
+ {B1,Bound1} = copy(B,Bound),
+ {A1,Bound2} = copy(A,Bound),
+ {{match,Line,A1,B1},gb_sets:union(Bound1,Bound2)};
+copy({var,_Line,'_'} = VarDef,Bound) ->
+ {VarDef,Bound};
+copy({var,_Line,Name} = VarDef,Bound) ->
+ Bound1 = gb_sets:add(Name,Bound),
+ {VarDef,Bound1};
+copy({'fun',Line,{clauses,Clauses}},Bound) -> % Dont export bindings from funs
+ {NewClauses,_IgnoredBindings} = copy_list(Clauses,Bound),
+ {{'fun',Line,{clauses,NewClauses}},Bound};
+copy({'case',Line,Of,ClausesList},Bound) -> % Dont export bindings from funs
+ {NewOf,NewBind0} = copy(Of,Bound),
+ {NewClausesList,NewBindings} = copy_case_clauses(ClausesList,NewBind0,[]),
+ {{'case',Line,NewOf,NewClausesList},NewBindings};
+copy(T,Bound) when is_tuple(T) ->
+ {L,Bound1} = copy_list(tuple_to_list(T),Bound),
+ {list_to_tuple(L),Bound1};
+copy(L,Bound) when is_list(L) ->
+ copy_list(L,Bound);
+copy(AnyOther,Bound) ->
+ {AnyOther,Bound}.
-copy_list([H|T]) ->
- [copy(H)|copy_list(T)];
-copy_list([]) ->
- [].
+copy_case_clauses([],Bound,AddSets) ->
+ ReallyAdded = gb_sets:intersection(AddSets),
+ {[],gb_sets:union(Bound,ReallyAdded)};
+copy_case_clauses([{clause,Line,Match,Guard,Clauses}|T],Bound,AddSets) ->
+ {NewMatch,MatchBinds} = copy(Match,Bound),
+ {NewGuard,GuardBinds} = copy(Guard,MatchBinds), %% Really no new binds
+ {NewClauses,AllBinds} = copy(Clauses,GuardBinds),
+ %% To limit the setsizes, I subtract what I had before the case clause
+ %% and add it in the end
+ AddedBinds = gb_sets:subtract(AllBinds,Bound),
+ {NewTail,ExportedBindings} =
+ copy_case_clauses(T,Bound,[AddedBinds | AddSets]),
+ {[{clause,Line,NewMatch,NewGuard,NewClauses}|NewTail],ExportedBindings}.
-transform_call(Type,_Line,[{'fun',Line2,{clauses, ClauseList}}]) ->
- ms_clause_list(Line2, ClauseList,Type);
-transform_call(_Type,Line,_NoAbstractFun) ->
+copy_list([H|T],Bound) ->
+ {C1,Bound1} = copy(H,Bound),
+ {C2,Bound2} = copy_list(T,Bound1),
+ {[C1|C2],Bound2};
+copy_list([],Bound) ->
+ {[],Bound}.
+
+transform_call(Type,_Line,[{'fun',Line2,{clauses, ClauseList}}],Bound) ->
+ ms_clause_list(Line2, ClauseList,Type,Bound);
+transform_call(_Type,Line,_NoAbstractFun,_) ->
throw({error,Line,?ERR_NOFUN}).
% Fixup semicolons in guards
@@ -329,18 +396,19 @@ ms_clause_expand({clause, Line, Parameters, Guard = [_,_|_], Body}) ->
ms_clause_expand(_Other) ->
false.
-ms_clause_list(Line,[H|T],Type) ->
+ms_clause_list(Line,[H|T],Type,Bound) ->
case ms_clause_expand(H) of
NewHead when is_list(NewHead) ->
- ms_clause_list(Line,NewHead ++ T, Type);
+ ms_clause_list(Line,NewHead ++ T, Type, Bound);
false ->
- {cons, Line, ms_clause(H,Type), ms_clause_list(Line, T,Type)}
+ {cons, Line, ms_clause(H, Type, Bound),
+ ms_clause_list(Line, T, Type, Bound)}
end;
-ms_clause_list(Line,[],_) ->
+ms_clause_list(Line,[],_,_) ->
{nil,Line}.
-ms_clause({clause, Line, Parameters, Guards, Body},Type) ->
+ms_clause({clause, Line, Parameters, Guards, Body},Type,Bound) ->
check_type(Line,Parameters,Type),
- {MSHead,Bindings} = transform_head(Parameters),
+ {MSHead,Bindings} = transform_head(Parameters,Bound),
MSGuards = transform_guards(Line, Guards, Bindings),
MSBody = transform_body(Line,Body,Bindings),
{tuple, Line, [MSHead,MSGuards,MSBody]}.
@@ -627,29 +695,31 @@ tg(Other,B) ->
Element = io_lib:format("unknown element ~w", [Other]),
throw({error,unknown,{?ERR_GENELEMENT+B#tgd.eb,Element}}).
-transform_head([V]) ->
+transform_head([V],OuterBound) ->
Bind = cre_bind(),
- {NewV,NewBind} = toplevel_head_match(V,Bind),
- th(NewV,NewBind).
+ {NewV,NewBind} = toplevel_head_match(V,Bind,OuterBound),
+ th(NewV,NewBind,OuterBound).
-toplevel_head_match({match,_,{var,_,VName},Expr},B) ->
+toplevel_head_match({match,Line,{var,_,VName},Expr},B,OB) ->
+ warn_var_clash(Line,VName,OB),
{Expr,new_bind({VName,'$_'},B)};
-toplevel_head_match({match,_,Expr,{var,_,VName}},B) ->
+toplevel_head_match({match,Line,Expr,{var,_,VName}},B,OB) ->
+ warn_var_clash(Line,VName,OB),
{Expr,new_bind({VName,'$_'},B)};
-toplevel_head_match(Other,B) ->
+toplevel_head_match(Other,B,_OB) ->
{Other,B}.
-th({record,Line,RName,RFields},B) ->
+th({record,Line,RName,RFields},B,OB) ->
% youch...
RDefs = get_records(),
{KeyList0,NewB} = lists:foldl(fun({record_field,_,{atom,_,Key},Value},
{L,B0}) ->
- {NV,B1} = th(Value,B0),
+ {NV,B1} = th(Value,B0,OB),
{[{Key,NV}|L],B1};
({record_field,_,{var,_,'_'},Value},
{L,B0}) ->
- {NV,B1} = th(Value,B0),
+ {NV,B1} = th(Value,B0,OB),
{[{{default},NV}|L],B1};
(_,_) ->
throw({error,Line,{?ERR_HEADBADREC,
@@ -692,9 +762,9 @@ th({record,Line,RName,RFields},B) ->
_ ->
throw({error,Line,{?ERR_HEADBADREC,RName}})
end;
-th({match,Line,_,_},_) ->
+th({match,Line,_,_},_,_) ->
throw({error,Line,?ERR_HEADMATCH});
-th({atom,Line,A},B) ->
+th({atom,Line,A},B,_OB) ->
case atom_to_list(A) of
[$$|NL] ->
case (catch list_to_integer(NL)) of
@@ -706,10 +776,11 @@ th({atom,Line,A},B) ->
_ ->
{{atom,Line,A},B}
end;
-th({bin_element,_Line0,{var, Line, A},_,_},_) ->
+th({bin_element,_Line0,{var, Line, A},_,_},_,_) ->
throw({error,Line,{?ERR_HEADBINMATCH,A}});
-th({var,Line,Name},B) ->
+th({var,Line,Name},B,OB) ->
+ warn_var_clash(Line,Name,OB),
case lkup_bind(Name,B) of
undefined ->
NewB = new_bind(Name,B),
@@ -717,16 +788,24 @@ th({var,Line,Name},B) ->
Trans ->
{{atom,Line,Trans},B}
end;
-th([H|T],B) ->
- {NH,NB} = th(H,B),
- {NT,NNB} = th(T,NB),
+th([H|T],B,OB) ->
+ {NH,NB} = th(H,B,OB),
+ {NT,NNB} = th(T,NB,OB),
{[NH|NT],NNB};
-th(T,B) when is_tuple(T) ->
- {L,NB} = th(tuple_to_list(T),B),
+th(T,B,OB) when is_tuple(T) ->
+ {L,NB} = th(tuple_to_list(T),B,OB),
{list_to_tuple(L),NB};
-th(Nonstruct,B) ->
+th(Nonstruct,B,_OB) ->
{Nonstruct,B}.
+warn_var_clash(Line,Name,OuterBound) ->
+ case gb_sets:is_member(Name,OuterBound) of
+ true ->
+ add_warning(Line,{?WARN_SHADOW_VAR,Name});
+ _ ->
+ ok
+ end.
+
%% Could be more efficient...
check_multi_field(_, _, [], _) ->
ok;
diff --git a/lib/stdlib/src/orddict.erl b/lib/stdlib/src/orddict.erl
index c7b52b933e..8a13992785 100644
--- a/lib/stdlib/src/orddict.erl
+++ b/lib/stdlib/src/orddict.erl
@@ -151,7 +151,7 @@ map(F, [{Key,Val}|D]) ->
[{Key,F(Key, Val)}|map(F, D)];
map(F, []) when is_function(F, 2) -> [].
--spec filter(fun((term(), term()) -> term()), orddict()) -> orddict().
+-spec filter(fun((term(), term()) -> boolean()), orddict()) -> orddict().
filter(F, [{Key,Val}=E|D]) ->
case F(Key, Val) of
diff --git a/lib/stdlib/src/ordsets.erl b/lib/stdlib/src/ordsets.erl
index 05041c15f1..4c72e351d0 100644
--- a/lib/stdlib/src/ordsets.erl
+++ b/lib/stdlib/src/ordsets.erl
@@ -26,12 +26,14 @@
-export([subtract/2,is_subset/2]).
-export([fold/3,filter/2]).
+-export_type([ordset/1]).
+
-type ordset(T) :: [T].
%% new() -> Set.
%% Return a new empty ordered set.
--spec new() -> ordset(term()).
+-spec new() -> [].
new() -> [].
@@ -84,7 +86,7 @@ is_element(_, []) -> false.
%% add_element(Element, OrdSet) -> OrdSet.
%% Return OrdSet with Element inserted in it.
--spec add_element(term(), ordset(_)) -> ordset(_).
+-spec add_element(E, ordset(T)) -> [T | E,...].
add_element(E, [H|Es]) when E > H -> [H|add_element(E, Es)];
add_element(E, [H|_]=Set) when E < H -> [E|Set];
@@ -94,7 +96,7 @@ add_element(E, []) -> [E].
%% del_element(Element, OrdSet) -> OrdSet.
%% Return OrdSet but with Element removed.
--spec del_element(term(), ordset(_)) -> ordset(_).
+-spec del_element(term(), ordset(T)) -> ordset(T).
del_element(E, [H|Es]) when E > H -> [H|del_element(E, Es)];
del_element(E, [H|_]=Set) when E < H -> Set;
@@ -104,7 +106,7 @@ del_element(_, []) -> [].
%% union(OrdSet1, OrdSet2) -> OrdSet
%% Return the union of OrdSet1 and OrdSet2.
--spec union(ordset(_), ordset(_)) -> ordset(_).
+-spec union(ordset(T1), ordset(T2)) -> ordset(T1 | T2).
union([E1|Es1], [E2|_]=Set2) when E1 < E2 ->
[E1|union(Es1, Set2)];
@@ -118,7 +120,7 @@ union(Es1, []) -> Es1.
%% union([OrdSet]) -> OrdSet
%% Return the union of the list of ordered sets.
--spec union([ordset(_)]) -> ordset(_).
+-spec union([ordset(T)]) -> ordset(T).
union([S1,S2|Ss]) ->
union1(union(S1, S2), Ss);
@@ -147,7 +149,7 @@ intersection(_, []) ->
%% intersection([OrdSet]) -> OrdSet.
%% Return the intersection of the list of ordered sets.
--spec intersection([ordset(_)]) -> ordset(_).
+-spec intersection([ordset(_),...]) -> ordset(_).
intersection([S1,S2|Ss]) ->
intersection1(intersection(S1, S2), Ss);
@@ -206,7 +208,7 @@ is_subset(_, []) -> false.
%% fold(Fun, Accumulator, OrdSet) -> Accumulator.
%% Fold function Fun over all elements in OrdSet and return Accumulator.
--spec fold(fun((_, _) -> _), _, ordset(_)) -> _.
+-spec fold(fun((T, term()) -> term()), term(), ordset(T)) -> term().
fold(F, Acc, Set) ->
lists:foldl(F, Acc, Set).
@@ -214,7 +216,7 @@ fold(F, Acc, Set) ->
%% filter(Fun, OrdSet) -> OrdSet.
%% Filter OrdSet with Fun.
--spec filter(fun((_) -> boolean()), ordset(_)) -> ordset(_).
+-spec filter(fun((T) -> boolean()), ordset(T)) -> ordset(T).
filter(F, Set) ->
lists:filter(F, Set).
diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl
index 7ea7de8d58..5c52dfcbf0 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,109 +236,137 @@ 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 ->
- {deprecated,"deprecated (will be removed in R14B); use public_key:pem_to_der/1 and public_key:pkix_decode_cert/2 instead"};
+ {removed,"removed in R14A; use public_key:pem_to_der/1 and public_key:pkix_decode_cert/2 instead"};
obsolete_1(ssl_pkix, decode_cert, A) when A =:= 1; A =:= 2 ->
- {deprecated,{public_key,pkix_decode_cert,2},"R14B"};
+ {removed,{public_key,pkix_decode_cert,2},"R14A"};
%% Added in R13B04.
obsolete_1(erlang, concat_binary, 1) ->
- {deprecated,{erlang,list_to_binary,1},"R14B"};
-
+ {deprecated,{erlang,list_to_binary,1},"R15B"};
+
+%% Added in R14A.
+obsolete_1(ssl, peercert, 2) ->
+ {deprecated,"deprecated (will be removed in R15A); use ssl:peercert/1 and public_key:pkix_decode_cert/2 instead"};
+
+%% Added in R14B.
+obsolete_1(public_key, pem_to_der, 1) ->
+ {deprecated,"deprecated (will be removed in R15A); use file:read_file/1 and public_key:pem_decode/1"};
+obsolete_1(public_key, decode_private_key, A) when A =:= 1; A =:= 2 ->
+ {deprecated,{public_key,pem_entry_decode,1},"R15A"};
+
obsolete_1(_, _, _) ->
no.
diff --git a/lib/stdlib/src/proc_lib.erl b/lib/stdlib/src/proc_lib.erl
index 9aa5e0a71e..4fb64a3353 100644
--- a/lib/stdlib/src/proc_lib.erl
+++ b/lib/stdlib/src/proc_lib.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(proc_lib).
@@ -34,6 +34,8 @@
%% Internal exports.
-export([wake_up/3]).
+-export_type([spawn_option/0]).
+
%%-----------------------------------------------------------------------------
-type priority_level() :: 'high' | 'low' | 'max' | 'normal'.
diff --git a/lib/stdlib/src/proplists.erl b/lib/stdlib/src/proplists.erl
index 35d14891f1..6a45e0f868 100644
--- a/lib/stdlib/src/proplists.erl
+++ b/lib/stdlib/src/proplists.erl
@@ -1,19 +1,19 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 2001-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%
%%
%% =====================================================================
@@ -49,6 +49,8 @@
%% ---------------------------------------------------------------------
+-export_type([property/0]).
+
-type property() :: atom() | tuple().
-type aliases() :: [{any(), any()}].
diff --git a/lib/stdlib/src/qlc.erl b/lib/stdlib/src/qlc.erl
index 6e48d95973..bc6944e520 100644
--- a/lib/stdlib/src/qlc.erl
+++ b/lib/stdlib/src/qlc.erl
@@ -24,6 +24,8 @@
%% External exports
+%% Avoid warning for local function error/1 clashing with autoimported BIF.
+-compile({no_auto_import,[error/1]}).
-export([parse_transform/2, transform_from_evaluator/2]).
-export([q/1, q/2]).
diff --git a/lib/stdlib/src/stdlib.app.src b/lib/stdlib/src/stdlib.app.src
index 3e52c48e42..9d15f01683 100644
--- a/lib/stdlib/src/stdlib.app.src
+++ b/lib/stdlib/src/stdlib.app.src
@@ -1,20 +1,20 @@
%% This is an -*- erlang -*- file.
%%
%% %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%
%%
{application, stdlib,
@@ -23,6 +23,7 @@
{modules, [array,
base64,
beam_lib,
+ binary,
c,
calendar,
dets,
diff --git a/lib/stdlib/src/string.erl b/lib/stdlib/src/string.erl
index 6636a03f06..c987c224db 100644
--- a/lib/stdlib/src/string.erl
+++ b/lib/stdlib/src/string.erl
@@ -201,7 +201,7 @@ chars(C, 0, Tail) when is_integer(C) ->
-spec copies(string(), non_neg_integer()) -> string().
-copies(CharList, Num) when is_list(CharList), Num >= 0 ->
+copies(CharList, Num) when is_list(CharList), is_integer(Num), Num >= 0 ->
copies(CharList, Num, []).
copies(_CharList, 0, R) ->
diff --git a/lib/stdlib/src/supervisor.erl b/lib/stdlib/src/supervisor.erl
index 22269a8d1b..7102fb9f6e 100644
--- a/lib/stdlib/src/supervisor.erl
+++ b/lib/stdlib/src/supervisor.erl
@@ -21,7 +21,7 @@
-behaviour(gen_server).
%% External exports
--export([start_link/2,start_link/3,
+-export([start_link/2, start_link/3,
start_child/2, restart_child/2,
delete_child/2, terminate_child/2,
which_children/1, count_children/1,
@@ -33,28 +33,56 @@
-export([init/1, handle_call/3, handle_info/2, terminate/2, code_change/3]).
-export([handle_cast/2]).
+%%--------------------------------------------------------------------------
+
+-export_type([child_spec/0, del_err/0, startchild_ret/0, strategy/0]).
+
+%%--------------------------------------------------------------------------
+
+-type child_id() :: pid() | 'undefined'.
+-type mfargs() :: {module(), atom(), [term()]}.
+-type modules() :: [module()] | 'dynamic'.
+-type restart() :: 'permanent' | 'transient' | 'temporary'.
+-type shutdown() :: 'brutal_kill' | timeout().
+-type worker() :: 'worker' | 'supervisor'.
+-type sup_name() :: {'local', atom()} | {'global', atom()}.
+-type sup_ref() :: atom() | {atom(), atom()} | {'global', atom()} | pid().
+-type child_spec() :: {term(),mfargs(),restart(),shutdown(),worker(),modules()}.
+
+-type strategy() :: 'one_for_all' | 'one_for_one'
+ | 'rest_for_one' | 'simple_one_for_one'.
+
+%%--------------------------------------------------------------------------
+
+-record(child, {% pid is undefined when child is not running
+ pid = undefined :: child_id(),
+ name,
+ mfargs :: mfargs(),
+ restart_type :: restart(),
+ shutdown :: shutdown(),
+ child_type :: worker(),
+ modules = [] :: modules()}).
+-type child() :: #child{}.
+
-define(DICT, dict).
-record(state, {name,
- strategy,
- children = [],
- dynamics = ?DICT:new(),
- intensity,
- period,
+ strategy :: strategy(),
+ children = [] :: [child()],
+ dynamics = ?DICT:new() :: ?DICT(),
+ intensity :: non_neg_integer(),
+ period :: pos_integer(),
restarts = [],
module,
args}).
-
--record(child, {pid = undefined, % pid is undefined when child is not running
- name,
- mfa,
- restart_type,
- shutdown,
- child_type,
- modules = []}).
+-type state() :: #state{}.
-define(is_simple(State), State#state.strategy =:= simple_one_for_one).
+%%--------------------------------------------------------------------------
+
+-spec behaviour_info(atom()) -> 'undefined' | [{atom(), arity()}].
+
behaviour_info(callbacks) ->
[{init,1}];
behaviour_info(_Other) ->
@@ -65,21 +93,40 @@ behaviour_info(_Other) ->
%%% Servers/processes should/could also be built using gen_server.erl.
%%% SupName = {local, atom()} | {global, atom()}.
%%% ---------------------------------------------------
+
+-type startlink_err() :: {'already_started', pid()} | 'shutdown' | term().
+-type startlink_ret() :: {'ok', pid()} | 'ignore' | {'error', startlink_err()}.
+
+-spec start_link(module(), term()) -> startlink_ret().
start_link(Mod, Args) ->
gen_server:start_link(supervisor, {self, Mod, Args}, []).
+-spec start_link(sup_name(), module(), term()) -> startlink_ret().
start_link(SupName, Mod, Args) ->
gen_server:start_link(SupName, supervisor, {SupName, Mod, Args}, []).
%%% ---------------------------------------------------
%%% Interface functions.
%%% ---------------------------------------------------
+
+-type info() :: term().
+-type startchild_err() :: 'already_present'
+ | {'already_started', child_id()} | term().
+-type startchild_ret() :: {'ok', child_id()} | {'ok', child_id(), info()}
+ | {'error', startchild_err()}.
+
+-spec start_child(sup_ref(), child_spec() | [term()]) -> startchild_ret().
start_child(Supervisor, ChildSpec) ->
call(Supervisor, {start_child, ChildSpec}).
+-type restart_err() :: 'running' | 'not_found' | 'simple_one_for_one' | term().
+-spec restart_child(sup_ref(), term()) ->
+ {'ok', child_id()} | {'ok', child_id(), info()} | {'error', restart_err()}.
restart_child(Supervisor, Name) ->
call(Supervisor, {restart_child, Name}).
+-type del_err() :: 'running' | 'not_found' | 'simple_one_for_one'.
+-spec delete_child(sup_ref(), term()) -> 'ok' | {'error', del_err()}.
delete_child(Supervisor, Name) ->
call(Supervisor, {delete_child, Name}).
@@ -89,9 +136,13 @@ delete_child(Supervisor, Name) ->
%% Note that the child is *always* terminated in some
%% way (maybe killed).
%%-----------------------------------------------------------------
+
+-type term_err() :: 'not_found' | 'simple_one_for_one'.
+-spec terminate_child(sup_ref(), term()) -> 'ok' | {'error', term_err()}.
terminate_child(Supervisor, Name) ->
call(Supervisor, {terminate_child, Name}).
+-spec which_children(sup_ref()) -> [{term(), child_id(), worker(), modules()}].
which_children(Supervisor) ->
call(Supervisor, which_children).
@@ -101,6 +152,7 @@ count_children(Supervisor) ->
call(Supervisor, Req) ->
gen_server:call(Supervisor, Req, infinity).
+-spec check_childspecs([child_spec()]) -> 'ok' | {'error', term()}.
check_childspecs(ChildSpecs) when is_list(ChildSpecs) ->
case check_startspec(ChildSpecs) of
{ok, _} -> ok;
@@ -113,6 +165,16 @@ check_childspecs(X) -> {error, {badarg, X}}.
%%% Initialize the supervisor.
%%%
%%% ---------------------------------------------------
+
+-type init_sup_name() :: sup_name() | 'self'.
+
+-type stop_rsn() :: 'shutdown' | {'bad_return', {module(),'init', term()}}
+ | {'bad_start_spec', term()} | {'start_spec', term()}
+ | {'supervisor_data', term()}.
+
+-spec init({init_sup_name(), module(), [term()]}) ->
+ {'ok', state()} | 'ignore' | {'stop', stop_rsn()}.
+
init({SupName, Mod, Args}) ->
process_flag(trap_exit, true),
case Mod:init(Args) of
@@ -130,7 +192,7 @@ init({SupName, Mod, Args}) ->
Error ->
{stop, {bad_return, {Mod, init, Error}}}
end.
-
+
init_children(State, StartSpec) ->
SupName = State#state.name,
case check_startspec(StartSpec) of
@@ -158,12 +220,12 @@ init_dynamic(_State, StartSpec) ->
%%-----------------------------------------------------------------
%% Func: start_children/2
-%% Args: Children = [#child] in start order
-%% SupName = {local, atom()} | {global, atom()} | {pid(),Mod}
+%% Args: Children = [child()] in start order
+%% SupName = {local, atom()} | {global, atom()} | {pid(), Mod}
%% Purpose: Start all children. The new list contains #child's
%% with pids.
%% Returns: {ok, NChildren} | {error, NChildren}
-%% NChildren = [#child] in termination order (reversed
+%% NChildren = [child()] in termination order (reversed
%% start order)
%%-----------------------------------------------------------------
start_children(Children, SupName) -> start_children(Children, [], SupName).
@@ -182,8 +244,8 @@ start_children([], NChildren, _SupName) ->
{ok, NChildren}.
do_start_child(SupName, Child) ->
- #child{mfa = {M, F, A}} = Child,
- case catch apply(M, F, A) of
+ #child{mfargs = {M, F, Args}} = Child,
+ case catch apply(M, F, Args) of
{ok, Pid} when is_pid(Pid) ->
NChild = Child#child{pid = Pid},
report_progress(NChild, SupName),
@@ -192,7 +254,7 @@ do_start_child(SupName, Child) ->
NChild = Child#child{pid = Pid},
report_progress(NChild, SupName),
{ok, Pid, Extra};
- ignore ->
+ ignore ->
{ok, undefined};
{error, What} -> {error, What};
What -> {error, What}
@@ -211,15 +273,17 @@ do_start_child_i(M, F, A) ->
What ->
{error, What}
end.
-
%%% ---------------------------------------------------
%%%
%%% Callback functions.
%%%
%%% ---------------------------------------------------
+-type call() :: 'which_children' | 'count_children' | {_, _}. % XXX: refine
+-spec handle_call(call(), term(), state()) -> {'reply', term(), state()}.
+
handle_call({start_child, EArgs}, _From, State) when ?is_simple(State) ->
- #child{mfa = {M, F, A}} = hd(State#state.children),
+ #child{mfargs = {M, F, A}} = hd(State#state.children),
Args = A ++ EArgs,
case do_start_child_i(M, F, Args) of
{ok, Pid} ->
@@ -235,7 +299,7 @@ handle_call({start_child, EArgs}, _From, State) when ?is_simple(State) ->
end;
%%% The requests terminate_child, delete_child and restart_child are
-%%% invalid for simple_one_for_one supervisors.
+%%% invalid for simple_one_for_one supervisors.
handle_call({_Req, _Data}, _From, State) when ?is_simple(State) ->
{reply, {error, simple_one_for_one}, State};
@@ -297,7 +361,7 @@ handle_call(which_children, _From, State) ->
Resp =
lists:map(fun(#child{pid = Pid, name = Name,
child_type = ChildType, modules = Mods}) ->
- {Name, Pid, ChildType, Mods}
+ {Name, Pid, ChildType, Mods}
end,
State#state.children),
{reply, Resp, State};
@@ -318,7 +382,6 @@ handle_call(count_children, _From, State) when ?is_simple(State) ->
{reply, Reply, State};
handle_call(count_children, _From, State) ->
-
%% Specs and children are together on the children list...
{Specs, Active, Supers, Workers} =
lists:foldl(fun(Child, Counts) ->
@@ -347,15 +410,19 @@ count_child(#child{pid = Pid, child_type = supervisor},
%%% Hopefully cause a function-clause as there is no API function
%%% that utilizes cast.
+-spec handle_cast('null', state()) -> {'noreply', state()}.
+
handle_cast(null, State) ->
error_logger:error_msg("ERROR: Supervisor received cast-message 'null'~n",
[]),
-
{noreply, State}.
%%
%% Take care of terminated children.
%%
+-spec handle_info(term(), state()) ->
+ {'noreply', state()} | {'stop', 'shutdown', state()}.
+
handle_info({'EXIT', Pid, Reason}, State) ->
case restart_child(Pid, Reason, State) of
{ok, State1} ->
@@ -368,9 +435,12 @@ handle_info(Msg, State) ->
error_logger:error_msg("Supervisor received unexpected message: ~p~n",
[Msg]),
{noreply, State}.
+
%%
%% Terminate this server.
%%
+-spec terminate(term(), state()) -> 'ok'.
+
terminate(_Reason, State) ->
terminate_children(State#state.children, State#state.name),
ok.
@@ -384,6 +454,9 @@ terminate(_Reason, State) ->
%% NOTE: This requires that the init function of the call-back module
%% does not have any side effects.
%%
+-spec code_change(term(), state(), term()) ->
+ {'ok', state()} | {'error', term()}.
+
code_change(_, State, _) ->
case (State#state.module):init(State#state.args) of
{ok, {SupFlags, StartSpec}} ->
@@ -411,7 +484,7 @@ check_flags({Strategy, MaxIntensity, Period}) ->
check_flags(What) ->
{bad_flags, What}.
-update_childspec(State, StartSpec) when ?is_simple(State) ->
+update_childspec(State, StartSpec) when ?is_simple(State) ->
case check_startspec(StartSpec) of
{ok, [Child]} ->
{ok, State#state{children = [Child]}};
@@ -437,7 +510,7 @@ update_childspec1([Child|OldC], Children, KeepOld) ->
update_childspec1(OldC, Children, [Child|KeepOld])
end;
update_childspec1([], Children, KeepOld) ->
- % Return them in (keeped) reverse start order.
+ %% Return them in (kept) reverse start order.
lists:reverse(Children ++ KeepOld).
update_chsp(OldCh, Children) ->
@@ -482,7 +555,7 @@ handle_start_child(Child, State) ->
%%% ---------------------------------------------------
%%% Restart. A process has terminated.
-%%% Returns: {ok, #state} | {shutdown, #state}
+%%% Returns: {ok, state()} | {shutdown, state()}
%%% ---------------------------------------------------
restart_child(Pid, Reason, State) when ?is_simple(State) ->
@@ -490,19 +563,19 @@ restart_child(Pid, Reason, State) when ?is_simple(State) ->
{ok, Args} ->
[Child] = State#state.children,
RestartType = Child#child.restart_type,
- {M, F, _} = Child#child.mfa,
- NChild = Child#child{pid = Pid, mfa = {M, F, Args}},
+ {M, F, _} = Child#child.mfargs,
+ NChild = Child#child{pid = Pid, mfargs = {M, F, Args}},
do_restart(RestartType, Reason, NChild, State);
error ->
{ok, State}
end;
restart_child(Pid, Reason, State) ->
Children = State#state.children,
- case lists:keysearch(Pid, #child.pid, Children) of
- {value, Child} ->
+ case lists:keyfind(Pid, #child.pid, Children) of
+ #child{} = Child ->
RestartType = Child#child.restart_type,
do_restart(RestartType, Reason, Child, State);
- _ ->
+ false ->
{ok, State}
end.
@@ -534,7 +607,7 @@ restart(Child, State) ->
end.
restart(simple_one_for_one, Child, State) ->
- #child{mfa = {M, F, A}} = Child,
+ #child{mfargs = {M, F, A}} = Child,
Dynamics = ?DICT:erase(Child#child.pid, State#state.dynamics),
case do_start_child_i(M, F, A) of
{ok, Pid} ->
@@ -580,9 +653,9 @@ restart(one_for_all, Child, State) ->
%%-----------------------------------------------------------------
%% Func: terminate_children/2
-%% Args: Children = [#child] in termination order
+%% Args: Children = [child()] in termination order
%% SupName = {local, atom()} | {global, atom()} | {pid(),Mod}
-%% Returns: NChildren = [#child] in
+%% Returns: NChildren = [child()] in
%% startup order (reversed termination order)
%%-----------------------------------------------------------------
terminate_children(Children, SupName) ->
@@ -595,14 +668,15 @@ terminate_children([], _SupName, Res) ->
Res.
do_terminate(Child, SupName) when Child#child.pid =/= undefined ->
- case shutdown(Child#child.pid,
- Child#child.shutdown) of
- ok ->
- Child#child{pid = undefined};
- {error, OtherReason} ->
- report_error(shutdown_error, OtherReason, Child, SupName),
- Child#child{pid = undefined}
- end;
+ case shutdown(Child#child.pid, Child#child.shutdown) of
+ ok ->
+ ok;
+ {error, normal} when Child#child.restart_type =/= permanent ->
+ ok;
+ {error, OtherReason} ->
+ report_error(shutdown_error, OtherReason, Child, SupName)
+ end,
+ Child#child{pid = undefined};
do_terminate(Child, _SupName) ->
Child.
@@ -617,7 +691,6 @@ do_terminate(Child, _SupName) ->
%% Returns: ok | {error, OtherReason} (this should be reported)
%%-----------------------------------------------------------------
shutdown(Pid, brutal_kill) ->
-
case monitor_child(Pid) of
ok ->
exit(Pid, kill),
@@ -630,9 +703,7 @@ shutdown(Pid, brutal_kill) ->
{error, Reason} ->
{error, Reason}
end;
-
shutdown(Pid, Time) ->
-
case monitor_child(Pid) of
ok ->
exit(Pid, shutdown), %% Try to shutdown gracefully
@@ -738,9 +809,9 @@ remove_child(Child, State) ->
%% MaxIntensity = integer()
%% Period = integer()
%% Mod :== atom()
-%% Arsg :== term()
+%% Args :== term()
%% Purpose: Check that Type is of correct type (!)
-%% Returns: {ok, #state} | Error
+%% Returns: {ok, state()} | Error
%%-----------------------------------------------------------------
init_state(SupName, Type, Mod, Args) ->
case catch init_state1(SupName, Type, Mod, Args) of
@@ -755,11 +826,11 @@ init_state1(SupName, {Strategy, MaxIntensity, Period}, Mod, Args) ->
validIntensity(MaxIntensity),
validPeriod(Period),
{ok, #state{name = supname(SupName,Mod),
- strategy = Strategy,
- intensity = MaxIntensity,
- period = Period,
- module = Mod,
- args = Args}};
+ strategy = Strategy,
+ intensity = MaxIntensity,
+ period = Period,
+ module = Mod,
+ args = Args}};
init_state1(_SupName, Type, _, _) ->
{invalid_type, Type}.
@@ -771,26 +842,26 @@ validStrategy(What) -> throw({invalid_strategy, What}).
validIntensity(Max) when is_integer(Max),
Max >= 0 -> true;
-validIntensity(What) -> throw({invalid_intensity, What}).
+validIntensity(What) -> throw({invalid_intensity, What}).
validPeriod(Period) when is_integer(Period),
Period > 0 -> true;
validPeriod(What) -> throw({invalid_period, What}).
-supname(self,Mod) -> {self(),Mod};
-supname(N,_) -> N.
+supname(self, Mod) -> {self(), Mod};
+supname(N, _) -> N.
%%% ------------------------------------------------------
%%% Check that the children start specification is valid.
%%% Shall be a six (6) tuple
%%% {Name, Func, RestartType, Shutdown, ChildType, Modules}
%%% where Name is an atom
-%%% Func is {Mod, Fun, Args} == {atom, atom, list}
+%%% Func is {Mod, Fun, Args} == {atom(), atom(), list()}
%%% RestartType is permanent | temporary | transient
%%% Shutdown = integer() | infinity | brutal_kill
%%% ChildType = supervisor | worker
%%% Modules = [atom()] | dynamic
-%%% Returns: {ok, [#child]} | Error
+%%% Returns: {ok, [child()]} | Error
%%% ------------------------------------------------------
check_startspec(Children) -> check_startspec(Children, []).
@@ -818,14 +889,14 @@ check_childspec(Name, Func, RestartType, Shutdown, ChildType, Mods) ->
validChildType(ChildType),
validShutdown(Shutdown, ChildType),
validMods(Mods),
- {ok, #child{name = Name, mfa = Func, restart_type = RestartType,
+ {ok, #child{name = Name, mfargs = Func, restart_type = RestartType,
shutdown = Shutdown, child_type = ChildType, modules = Mods}}.
validChildType(supervisor) -> true;
validChildType(worker) -> true;
validChildType(What) -> throw({invalid_child_type, What}).
-validName(_Name) -> true.
+validName(_Name) -> true.
validFunc({M, F, A}) when is_atom(M),
is_atom(F),
@@ -923,7 +994,7 @@ report_error(Error, Reason, Child, SupName) ->
extract_child(Child) ->
[{pid, Child#child.pid},
{name, Child#child.name},
- {mfa, Child#child.mfa},
+ {mfargs, Child#child.mfargs},
{restart_type, Child#child.restart_type},
{shutdown, Child#child.shutdown},
{child_type, Child#child.child_type}].
diff --git a/lib/stdlib/src/timer.erl b/lib/stdlib/src/timer.erl
index 36fdb48c75..b456c5d6c1 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).
@@ -22,7 +22,7 @@
send_after/3, send_after/2,
exit_after/3, exit_after/2, kill_after/2, kill_after/1,
apply_interval/4, send_interval/3, send_interval/2,
- cancel/1, sleep/1, tc/3, now_diff/2,
+ cancel/1, sleep/1, tc/2, tc/3, now_diff/2,
seconds/1, minutes/1, hours/1, hms/3]).
-export([start_link/0, start/0,
@@ -33,6 +33,9 @@
%% internal exports for test purposes only
-export([get_status/0]).
+%% types which can be used by other modules
+-export_type([tref/0]).
+
%% Max
-define(MAX_TIMEOUT, 16#0800000).
-define(TIMER_TAB, timer_tab).
@@ -41,54 +44,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).
@@ -98,10 +101,21 @@ sleep(T) ->
after T -> ok
end.
+
+%%
+%% Measure the execution time (in microseconds) for Fun(Args).
+%%
+-spec tc(function(), [_]) -> {time(), term()}.
+tc(F, A) ->
+ Before = erlang:now(),
+ Val = (catch apply(F, A)),
+ After = erlang:now(),
+ {now_diff(After, Before), Val}.
+
%%
%% 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 +155,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 +166,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 +190,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 +213,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 +221,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 +233,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 +243,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 +301,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 +315,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 +382,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/unicode.erl b/lib/stdlib/src/unicode.erl
index 09b1deff9c..869505ba83 100644
--- a/lib/stdlib/src/unicode.erl
+++ b/lib/stdlib/src/unicode.erl
@@ -25,8 +25,17 @@
%% InEncoding is not {latin1 | unicode | utf8})
%%
--export([characters_to_list/1, characters_to_list_int/2, characters_to_binary/1,characters_to_binary_int/2, characters_to_binary/3,bom_to_encoding/1, encoding_to_bom/1]).
+-export([characters_to_list/1, characters_to_list_int/2,
+ characters_to_binary/1, characters_to_binary_int/2,
+ characters_to_binary/3,
+ bom_to_encoding/1, encoding_to_bom/1]).
+-export_type([encoding/0]).
+
+-type encoding() :: 'latin1' | 'unicode' | 'utf8'
+ | 'utf16' | {'utf16', endian()}
+ | 'utf32' | {'utf32', endian()}.
+-type endian() :: 'big' | 'little'.
characters_to_list(ML) ->
unicode:characters_to_list(ML,unicode).
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};