diff options
Diffstat (limited to 'lib/stdlib/src')
50 files changed, 2440 insertions, 1107 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/base64.erl b/lib/stdlib/src/base64.erl index ebef998ee1..a14a72ac6d 100644 --- a/lib/stdlib/src/base64.erl +++ b/lib/stdlib/src/base64.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2009. All Rights Reserved. +%% Copyright Ericsson AB 2007-2011. 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 @@ -114,7 +114,7 @@ decode(List) when is_list(List) -> mime_decode(Bin) when is_binary(Bin) -> mime_decode_binary(<<>>, Bin); mime_decode(List) when is_list(List) -> - list_to_binary(mime_decode_l(List)). + mime_decode(list_to_binary(List)). -spec decode_l(string()) -> string(). @@ -125,7 +125,7 @@ decode_l(List) -> -spec mime_decode_l(string()) -> string(). mime_decode_l(List) -> - L = strip_illegal(List, []), + L = strip_illegal(List, [], 0), decode(L, []). %%------------------------------------------------------------------------- @@ -198,6 +198,9 @@ decode_binary(Result, <<>>) -> true = is_binary(Result), Result. +%% Skipping pad character if not at end of string. Also liberal about +%% excess padding and skipping of other illegal (non-base64 alphabet) +%% characters. See section 3.3 of RFC4648 mime_decode_binary(Result, <<0:8,T/bits>>) -> mime_decode_binary(Result, T); mime_decode_binary(Result0, <<C:8,T/bits>>) -> @@ -205,15 +208,27 @@ mime_decode_binary(Result0, <<C:8,T/bits>>) -> Bits when is_integer(Bits) -> mime_decode_binary(<<Result0/bits,Bits:6>>, T); eq -> - case tail_contains_equal(T) of - true -> - Split = byte_size(Result0) - 1, - <<Result:Split/bytes,_:4>> = Result0, - Result; - false -> - Split = byte_size(Result0) - 1, - <<Result:Split/bytes,_:2>> = Result0, - Result + case tail_contains_more(T, false) of + {<<>>, Eq} -> + %% No more valid data. + case bit_size(Result0) rem 8 of + 0 -> + %% '====' is not uncommon. + Result0; + 4 when Eq -> + %% enforce at least one more '=' only ignoring illegals and spacing + Split = byte_size(Result0) - 1, + <<Result:Split/bytes,_:4>> = Result0, + Result; + 2 -> + %% remove 2 bits + Split = byte_size(Result0) - 1, + <<Result:Split/bytes,_:2>> = Result0, + Result + end; + {More, _} -> + %% More valid data, skip the eq as invalid + mime_decode_binary(Result0, More) end; _ -> mime_decode_binary(Result0, T) @@ -262,31 +277,63 @@ strip_ws(<<$\s,T/binary>>) -> strip_ws(T); strip_ws(T) -> T. -strip_illegal([0|Cs], A) -> - strip_illegal(Cs, A); -strip_illegal([C|Cs], A) -> +%% Skipping pad character if not at end of string. Also liberal about +%% excess padding and skipping of other illegal (non-base64 alphabet) +%% characters. See section 3.3 of RFC4648 +strip_illegal([], A, _Cnt) -> + A; +strip_illegal([0|Cs], A, Cnt) -> + strip_illegal(Cs, A, Cnt); +strip_illegal([C|Cs], A, Cnt) -> case element(C, ?DECODE_MAP) of - bad -> strip_illegal(Cs, A); - ws -> strip_illegal(Cs, A); - eq -> strip_illegal_end(Cs, [$=|A]); - _ -> strip_illegal(Cs, [C|A]) - end; -strip_illegal([], A) -> A. + bad -> + strip_illegal(Cs, A, Cnt); + ws -> + strip_illegal(Cs, A, Cnt); + eq -> + case {tail_contains_more(Cs, false), Cnt rem 4} of + {{[], _}, 0} -> + A; %% Ignore extra = + {{[], true}, 2} -> + [$=|[$=|A]]; %% 'XX==' + {{[], _}, 3} -> + [$=|A]; %% 'XXX=' + {{[H|T], _}, _} -> + %% more data, skip equals + strip_illegal(T, [H|A], Cnt+1) + end; + _ -> + strip_illegal(Cs, [C|A], Cnt+1) + end. -strip_illegal_end([0|Cs], A) -> - strip_illegal_end(Cs, A); -strip_illegal_end([C|Cs], A) -> +%% Search the tail for more valid data and remember if we saw +%% another equals along the way. +tail_contains_more([], Eq) -> + {[], Eq}; +tail_contains_more(<<>>, Eq) -> + {<<>>, Eq}; +tail_contains_more([C|T]=More, Eq) -> case element(C, ?DECODE_MAP) of - bad -> strip_illegal(Cs, A); - ws -> strip_illegal(Cs, A); - eq -> [C|A]; - _ -> strip_illegal(Cs, [C|A]) + bad -> + tail_contains_more(T, Eq); + ws -> + tail_contains_more(T, Eq); + eq -> + tail_contains_more(T, true); + _ -> + {More, Eq} end; -strip_illegal_end([], A) -> A. - -tail_contains_equal(<<$=,_/binary>>) -> true; -tail_contains_equal(<<_,T/binary>>) -> tail_contains_equal(T); -tail_contains_equal(<<>>) -> false. +tail_contains_more(<<C:8,T/bits>> =More, Eq) -> + case element(C, ?DECODE_MAP) of + bad -> + tail_contains_more(T, Eq); + ws -> + tail_contains_more(T, Eq); + eq -> + tail_contains_more(T, true); + _ -> + {More, Eq} + end. %% accessors b64e(X) -> diff --git a/lib/stdlib/src/beam_lib.erl b/lib/stdlib/src/beam_lib.erl index c71dad6163..74d4ad3da7 100644 --- a/lib/stdlib/src/beam_lib.erl +++ b/lib/stdlib/src/beam_lib.erl @@ -19,6 +19,10 @@ -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,6 +45,8 @@ 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]). @@ -103,6 +109,7 @@ | info_rsn(). -type cmp_rsn() :: {'modules_different', module(), module()} | {'chunks_different', chunkid()} + | 'different_chunks' | info_rsn(). %%------------------------------------------------------------------------- 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 e05a1c787f..235ea939a8 100644 --- a/lib/stdlib/src/c.erl +++ b/lib/stdlib/src/c.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% Copyright Ericsson AB 1996-2011. 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 @@ -20,6 +20,8 @@ %% 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, @@ -40,31 +42,31 @@ -spec help() -> 'ok'. help() -> - format("bt(Pid) -- stack backtrace for a process\n" - "c(File) -- compile and load code in <File>\n" - "cd(Dir) -- change working directory\n" - "flush() -- flush any messages sent to the shell\n" - "help() -- help info\n" - "i() -- information about the system\n" - "ni() -- information about the networked system\n" - "i(X,Y,Z) -- information about pid <X,Y,Z>\n" - "l(Module) -- load or reload module\n" - "lc([File]) -- compile a list of Erlang modules\n" - "ls() -- list files in the current directory\n" - "ls(Dir) -- list files in directory <Dir>\n" - "m() -- which modules are loaded\n" - "m(Mod) -- information about module <Mod>\n" - "memory() -- memory allocation information\n" - "memory(T) -- memory allocation information of type <T>\n" - "nc(File) -- compile and load code in <File> on all nodes\n" - "nl(Module) -- load module on all nodes\n" - "pid(X,Y,Z) -- convert X,Y,Z to a Pid\n" - "pwd() -- print working directory\n" - "q() -- quit - shorthand for init:stop()\n" - "regs() -- information about registered processes\n" - "nregs() -- information about all registered processes\n" - "xm(M) -- cross reference check a module\n" - "y(File) -- generate a Yecc parser\n"). + io:put_chars(<<"bt(Pid) -- stack backtrace for a process\n" + "c(File) -- compile and load code in <File>\n" + "cd(Dir) -- change working directory\n" + "flush() -- flush any messages sent to the shell\n" + "help() -- help info\n" + "i() -- information about the system\n" + "ni() -- information about the networked system\n" + "i(X,Y,Z) -- information about pid <X,Y,Z>\n" + "l(Module) -- load or reload module\n" + "lc([File]) -- compile a list of Erlang modules\n" + "ls() -- list files in the current directory\n" + "ls(Dir) -- list files in directory <Dir>\n" + "m() -- which modules are loaded\n" + "m(Mod) -- information about module <Mod>\n" + "memory() -- memory allocation information\n" + "memory(T) -- memory allocation information of type <T>\n" + "nc(File) -- compile and load code in <File> on all nodes\n" + "nl(Module) -- load module on all nodes\n" + "pid(X,Y,Z) -- convert X,Y,Z to a Pid\n" + "pwd() -- print working directory\n" + "q() -- quit - shorthand for init:stop()\n" + "regs() -- information about registered processes\n" + "nregs() -- information about all registered processes\n" + "xm(M) -- cross reference check a module\n" + "y(File) -- generate a Yecc parser\n">>). %% c(FileName) %% Compile a file/module. @@ -657,7 +659,7 @@ portformat(Name, Id, Cmd) -> 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. @@ -682,11 +684,27 @@ ls() -> 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, @@ -696,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(). diff --git a/lib/stdlib/src/calendar.erl b/lib/stdlib/src/calendar.erl index ddc0666f77..33725d999c 100644 --- a/lib/stdlib/src/calendar.erl +++ b/lib/stdlib/src/calendar.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. +%% Copyright Ericsson AB 1996-2011. 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 @@ -28,6 +28,8 @@ gregorian_days_to_date/1, gregorian_seconds_to_datetime/1, is_leap_year/1, + iso_week_number/0, + iso_week_number/1, last_day_of_the_month/2, local_time/0, local_time_to_universal_time/1, @@ -70,6 +72,7 @@ -type second() :: 0..59. -type daynum() :: 1..7. -type ldom() :: 28 | 29 | 30 | 31. % last day of month +-type weeknum() :: 1..53. -type t_now() :: {non_neg_integer(),non_neg_integer(),non_neg_integer()}. @@ -77,6 +80,7 @@ -type t_time() :: {hour(),minute(),second()}. -type t_datetime() :: {t_date(),t_time()}. -type t_datetime1970() :: {{year1970(),month(),day()},t_time()}. +-type t_yearweeknum() :: {year(),weeknum()}. %%---------------------------------------------------------------------- @@ -172,6 +176,42 @@ is_leap_year1(Year) when Year rem 400 =:= 0 -> is_leap_year1(_) -> false. +%% +%% Calculates the iso week number for the current date. +%% +-spec iso_week_number() -> t_yearweeknum(). +iso_week_number() -> + {Date, _} = local_time(), + iso_week_number(Date). + + +%% +%% Calculates the iso week number for the given date. +%% +-spec iso_week_number(t_date()) -> t_yearweeknum(). +iso_week_number({Year, Month, Day}) -> + D = date_to_gregorian_days({Year, Month, Day}), + W01_1_Year = gregorian_days_of_iso_w01_1(Year), + W01_1_NextYear = gregorian_days_of_iso_w01_1(Year + 1), + if W01_1_Year =< D andalso D < W01_1_NextYear -> + % Current Year Week 01..52(,53) + {Year, (D - W01_1_Year) div 7 + 1}; + D < W01_1_Year -> + % Previous Year 52 or 53 + PWN = case day_of_the_week(Year - 1, 1, 1) of + 4 -> 53; + _ -> case day_of_the_week(Year - 1, 12, 31) of + 4 -> 53; + _ -> 52 + end + end, + {Year - 1, PWN}; + W01_1_NextYear =< D -> + % Next Year, Week 01 + {Year + 1, 1} + end. + + %% last_day_of_the_month(Year, Month) %% %% Returns the number of days in a month. @@ -377,6 +417,19 @@ dty(Y, D1, D2) when D1 < D2 -> dty(Y, _D1, D2) -> {Y, D2}. +%% +%% The Gregorian days of the iso week 01 day 1 for a given year. +%% +-spec gregorian_days_of_iso_w01_1(year()) -> non_neg_integer(). +gregorian_days_of_iso_w01_1(Year) -> + D0101 = date_to_gregorian_days(Year, 1, 1), + DOW = day_of_the_week(Year, 1, 1), + if DOW =< 4 -> + D0101 - DOW + 1; + true -> + D0101 + 7 - DOW + 1 + end. + %% year_day_to_date(Year, DayOfYear) = {Month, DayOfMonth} %% %% Note: 1 is the first day of the month. 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_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 f144cbb938..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 @@ -111,6 +113,8 @@ 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}) -> @@ -163,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 -> @@ -188,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) -> @@ -232,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); @@ -324,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 @@ -356,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), @@ -380,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) @@ -491,9 +504,9 @@ 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 catch macro_expansion(Toks) of + 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) -> @@ -608,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); @@ -644,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, @@ -766,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), - wait_req_scan(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) @@ -814,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}]) -> throw({error,Ld,missing_parenthesis}); -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) @@ -1084,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 @@ -1129,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}) -> @@ -1145,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 @@ -1165,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 @@ -1177,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 @@ -1188,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 a38b7639d8..61ce41f714 100644 --- a/lib/stdlib/src/erl_expand_records.erl +++ b/lib/stdlib/src/erl_expand_records.erl @@ -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}; @@ -800,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 94ad560549..cfb9f0ca98 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% Copyright Ericsson AB 1996-2011. 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 @@ -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; @@ -60,6 +60,10 @@ value_option(Flag, Default, On, OnVal, Off, OffVal, Opts) -> (_Opt, Def) -> Def end, Default, Opts). +%% The maximum number of arguments allowed for a function. + +-define(MAX_ARGUMENTS, 255). + %% The error and warning info structures, {Line,Module,Descriptor}, %% are kept in their seperate fields in the lint state record together %% with the name of the file (when a new file is entered, marked by @@ -72,6 +76,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 +102,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 +120,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 +172,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 +200,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", @@ -208,11 +230,17 @@ format_error({obsolete_guard, {F, A}}) -> io_lib:format("~p/~p obsolete", [F, A]); format_error({reserved_for_future,K}) -> io_lib:format("atom ~w: future reserved keyword - rename or quote", [K]); +format_error({too_many_arguments,Arity}) -> + io_lib:format("too many arguments (~w) - " + "maximum allowed is ~w", [Arity,?MAX_ARGUMENTS]); %% --- patterns and guards --- 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 +270,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 +318,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 +386,7 @@ pseudolocals() -> %% %% Used by erl_eval.erl to check commands. -%% +%% exprs(Exprs, BindingsList) -> exprs_opt(Exprs, BindingsList, []). @@ -362,7 +394,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 +423,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 +538,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 +548,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 +570,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 +597,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 +703,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 +762,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 +911,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 +961,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 +981,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 +1052,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])]). @@ -1048,10 +1098,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) -> @@ -1061,18 +1111,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, @@ -1081,8 +1132,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), @@ -1094,11 +1168,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) @@ -1141,13 +1245,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) @@ -1179,7 +1285,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) -> @@ -1191,12 +1297,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 =/= [] -> @@ -1205,7 +1305,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), @@ -1214,18 +1314,18 @@ define_function(Line, Name, Arity, St0) -> true -> 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 + St2 = function_check_max_args(Line, Arity, St1), + St3 = St2#lint{defined=gb_sets:add_element(NA, St2#lint.defined)}, + case imported(Name, Arity, St3) of + {yes,_M} -> add_error(Line, {define_import,NA}, St3); + no -> St3 end end. +function_check_max_args(Line, Arity, St) when Arity > ?MAX_ARGUMENTS -> + add_error(Line, {too_many_arguments,Arity}, St); +function_check_max_args(_, _, St) -> St. + %% clauses([Clause], VarTable, State) -> {VarTable, State}. clauses(Cs, Vt, St) -> @@ -1258,7 +1358,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 @@ -1276,7 +1376,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}; @@ -1294,7 +1394,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) @@ -1309,7 +1409,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)} @@ -1369,7 +1469,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}}} -> @@ -1451,7 +1551,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. @@ -1498,7 +1598,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! @@ -1513,7 +1613,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! @@ -1596,7 +1696,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) -> @@ -1678,8 +1778,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 ); @@ -1710,7 +1808,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,_,_}]}, @@ -1725,14 +1823,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), @@ -1777,7 +1883,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), @@ -1798,7 +1904,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; @@ -1820,7 +1926,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) -> @@ -1895,15 +2001,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 @@ -1958,8 +2062,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; @@ -1969,7 +2076,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) -> @@ -1992,29 +2099,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; @@ -2155,7 +2287,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 @@ -2306,7 +2438,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), @@ -2316,7 +2448,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)} || @@ -2394,7 +2526,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()) @@ -2432,7 +2564,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, @@ -2441,8 +2573,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, @@ -2467,7 +2599,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 @@ -2475,12 +2613,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. @@ -2563,7 +2701,6 @@ default_types() -> {set, 0}, {string, 0}, {term, 0}, - {tid, 0}, {timeout, 0}, {var, 1}], dict:from_list([{T, -1} || T <- DefTypes]). @@ -2585,7 +2722,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. @@ -2606,7 +2742,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, []} @@ -2666,10 +2802,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 @@ -2677,19 +2815,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. @@ -2834,7 +2971,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 @@ -2864,9 +3001,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}}],[], @@ -2919,7 +3056,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}}], @@ -2957,7 +3094,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 @@ -2973,7 +3110,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) @@ -3073,7 +3210,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). @@ -3103,7 +3240,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)}}; @@ -3118,7 +3255,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) -> @@ -3154,7 +3291,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. @@ -3170,7 +3307,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); _ -> @@ -3355,11 +3492,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); @@ -3437,3 +3574,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 5287f55e59..15b45d72f4 100644 --- a/lib/stdlib/src/erl_parse.yrl +++ b/lib/stdlib/src/erl_parse.yrl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% Copyright Ericsson AB 1996-2011. 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 @@ -47,7 +47,7 @@ opt_bit_size_expr bit_size_expr opt_bit_type_list bit_type_list bit_type top_type top_type_100 top_types type typed_expr typed_attr_val type_sig type_sigs type_guard type_guards fun_type fun_type_100 binary_type type_spec spec_fun typed_exprs typed_record_fields field_types field_type -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 @@ -61,7 +61,7 @@ char integer float atom string var '++' '--' '==' '/=' '=<' '<' '>=' '>' '=:=' '=/=' '<=' '<<' '>>' -'!' '=' '::' +'!' '=' '::' '..' '...' 'spec' % helper dot. @@ -120,8 +120,24 @@ 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'. @@ -135,7 +151,7 @@ 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'}. @@ -143,19 +159,13 @@ 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', @@ -180,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']. @@ -607,6 +617,11 @@ lift_unions(T1, {type, _La, union, 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}) -> @@ -615,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"). @@ -742,7 +757,8 @@ record_fields([{typed,Expr,TypeInfo}|Fields]) -> {atom, La, _} -> case has_undefined(TypeInfo) of false -> - lift_unions(abstract(undefined, La), TypeInfo); + TypeInfo2 = maybe_add_paren(TypeInfo), + lift_unions(abstract(undefined, La), TypeInfo2); true -> TypeInfo end @@ -763,6 +779,11 @@ has_undefined({type,_,union,Ts}) -> has_undefined(_) -> false. +maybe_add_paren({ann_type,L,T}) -> + {paren_type,L,[{ann_type,L,T}]}; +maybe_add_paren(T) -> + T. + term(Expr) -> try normalise(Expr) catch _:_R -> ret_err(?line(Expr), "bad attribute") diff --git a/lib/stdlib/src/erl_posix_msg.erl b/lib/stdlib/src/erl_posix_msg.erl index fe981b23a7..909cc1d102 100644 --- a/lib/stdlib/src/erl_posix_msg.erl +++ b/lib/stdlib/src/erl_posix_msg.erl @@ -1,7 +1,7 @@ %% %% %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 @@ -24,143 +24,146 @@ -spec message(atom()) -> string(). -message(e2big) -> "argument list too long"; -message(eacces) -> "permission denied"; -message(eaddrinuse) -> "address already in use"; -message(eaddrnotavail) -> "can't assign requested address"; -message(eadv) -> "advertise error"; -message(eafnosupport) -> "address family not supported by protocol family"; -message(eagain) -> "resource temporarily unavailable"; -message(ealign) -> "EALIGN"; -message(ealready) -> "operation already in progress"; -message(ebade) -> "bad exchange descriptor"; -message(ebadf) -> "bad file number"; -message(ebadfd) -> "file descriptor in bad state"; -message(ebadmsg) -> "not a data message"; -message(ebadr) -> "bad request descriptor"; -message(ebadrpc) -> "RPC structure is bad"; -message(ebadrqc) -> "bad request code"; -message(ebadslt) -> "invalid slot"; -message(ebfont) -> "bad font file format"; -message(ebusy) -> "file busy"; -message(echild) -> "no children"; -message(echrng) -> "channel number out of range"; -message(ecomm) -> "communication error on send"; -message(econnaborted) -> "software caused connection abort"; -message(econnrefused) -> "connection refused"; -message(econnreset) -> "connection reset by peer"; -message(edeadlk) -> "resource deadlock avoided"; -message(edeadlock) -> "resource deadlock avoided"; -message(edestaddrreq) -> "destination address required"; -message(edirty) -> "mounting a dirty fs w/o force"; -message(edom) -> "math argument out of range"; -message(edotdot) -> "cross mount point"; -message(edquot) -> "disk quota exceeded"; -message(eduppkg) -> "duplicate package name"; -message(eexist) -> "file already exists"; -message(efault) -> "bad address in system call argument"; -message(efbig) -> "file too large"; -message(ehostdown) -> "host is down"; -message(ehostunreach) -> "host is unreachable"; -message(eidrm) -> "identifier removed"; -message(einit) -> "initialization error"; -message(einprogress) -> "operation now in progress"; -message(eintr) -> "interrupted system call"; -message(einval) -> "invalid argument"; -message(eio) -> "I/O error"; -message(eisconn) -> "socket is already connected"; -message(eisdir) -> "illegal operation on a directory"; -message(eisnam) -> "is a name file"; -message(elbin) -> "ELBIN"; -message(el2hlt) -> "level 2 halted"; -message(el2nsync) -> "level 2 not synchronized"; -message(el3hlt) -> "level 3 halted"; -message(el3rst) -> "level 3 reset"; -message(elibacc) -> "can not access a needed shared library"; -message(elibbad) -> "accessing a corrupted shared library"; -message(elibexec) -> "can not exec a shared library directly"; -message(elibmax) -> - "attempting to link in more shared libraries than system limit"; -message(elibscn) -> ".lib section in a.out corrupted"; -message(elnrng) -> "link number out of range"; -message(eloop) -> "too many levels of symbolic links"; -message(emfile) -> "too many open files"; -message(emlink) -> "too many links"; -message(emsgsize) -> "message too long"; -message(emultihop) -> "multihop attempted"; -message(enametoolong) -> "file name too long"; -message(enavail) -> "not available"; -message(enet) -> "ENET"; -message(enetdown) -> "network is down"; -message(enetreset) -> "network dropped connection on reset"; -message(enetunreach) -> "network is unreachable"; -message(enfile) -> "file table overflow"; -message(enoano) -> "anode table overflow"; -message(enobufs) -> "no buffer space available"; -message(enocsi) -> "no CSI structure available"; -message(enodata) -> "no data available"; -message(enodev) -> "no such device"; -message(enoent) -> "no such file or directory"; -message(enoexec) -> "exec format error"; -message(enolck) -> "no locks available"; -message(enolink) -> "link has be severed"; -message(enomem) -> "not enough memory"; -message(enomsg) -> "no message of desired type"; -message(enonet) -> "machine is not on the network"; -message(enopkg) -> "package not installed"; -message(enoprotoopt) -> "bad proocol option"; -message(enospc) -> "no space left on device"; -message(enosr) -> "out of stream resources or not a stream device"; -message(enosym) -> "unresolved symbol name"; -message(enosys) -> "function not implemented"; -message(enotblk) -> "block device required"; -message(enotconn) -> "socket is not connected"; -message(enotdir) -> "not a directory"; -message(enotempty) -> "directory not empty"; -message(enotnam) -> "not a name file"; -message(enotsock) -> "socket operation on non-socket"; -message(enotsup) -> "operation not supported"; -message(enotty) -> "inappropriate device for ioctl"; -message(enotuniq) -> "name not unique on network"; -message(enxio) -> "no such device or address"; -message(eopnotsupp) -> "operation not supported on socket"; -message(eperm) -> "not owner"; -message(epfnosupport) -> "protocol family not supported"; -message(epipe) -> "broken pipe"; -message(eproclim) -> "too many processes"; -message(eprocunavail) -> "bad procedure for program"; -message(eprogmismatch) -> "program version wrong"; -message(eprogunavail) -> "RPC program not available"; -message(eproto) -> "protocol error"; -message(eprotonosupport) -> "protocol not suppored"; -message(eprototype) -> "protocol wrong type for socket"; -message(erange) -> "math result unrepresentable"; -message(erefused) -> "EREFUSED"; -message(eremchg) -> "remote address changed"; -message(eremdev) -> "remote device"; -message(eremote) -> "pathname hit remote file system"; -message(eremoteio) -> "remote i/o error"; -message(eremoterelease) -> "EREMOTERELEASE"; -message(erofs) -> "read-only file system"; -message(erpcmismatch) -> "RPC version is wrong"; -message(erremote) -> "object is remote"; -message(eshutdown) -> "can't send after socket shutdown"; -message(esocktnosupport) -> "socket type not supported"; -message(espipe) -> "invalid seek"; -message(esrch) -> "no such process"; -message(esrmnt) -> "srmount error"; -message(estale) -> "stale remote file handle"; -message(esuccess) -> "Error 0"; -message(etime) -> "timer expired"; -message(etimedout) -> "connection timed out"; -message(etoomanyrefs) -> "too many references: can't splice"; -message(etxtbsy) -> "text file or pseudo-device busy"; -message(euclean) -> "structure needs cleaning"; -message(eunatch) -> "protocol driver not attached"; -message(eusers) -> "too many users"; -message(eversion) -> "version mismatch"; -message(ewouldblock) -> "operation would block"; -message(exdev) -> "cross-domain link"; -message(exfull) -> "message tables full"; -message(nxdomain) -> "non-existing domain"; -message(_) -> "unknown POSIX error". +message(T) -> + binary_to_list(message_1(T)). + +message_1(e2big) -> <<"argument list too long">>; +message_1(eacces) -> <<"permission denied">>; +message_1(eaddrinuse) -> <<"address already in use">>; +message_1(eaddrnotavail) -> <<"can't assign requested address">>; +message_1(eadv) -> <<"advertise error">>; +message_1(eafnosupport) -> <<"address family not supported by protocol family">>; +message_1(eagain) -> <<"resource temporarily unavailable">>; +message_1(ealign) -> <<"EALIGN">>; +message_1(ealready) -> <<"operation already in progress">>; +message_1(ebade) -> <<"bad exchange descriptor">>; +message_1(ebadf) -> <<"bad file number">>; +message_1(ebadfd) -> <<"file descriptor in bad state">>; +message_1(ebadmsg) -> <<"not a data message">>; +message_1(ebadr) -> <<"bad request descriptor">>; +message_1(ebadrpc) -> <<"RPC structure is bad">>; +message_1(ebadrqc) -> <<"bad request code">>; +message_1(ebadslt) -> <<"invalid slot">>; +message_1(ebfont) -> <<"bad font file format">>; +message_1(ebusy) -> <<"file busy">>; +message_1(echild) -> <<"no children">>; +message_1(echrng) -> <<"channel number out of range">>; +message_1(ecomm) -> <<"communication error on send">>; +message_1(econnaborted) -> <<"software caused connection abort">>; +message_1(econnrefused) -> <<"connection refused">>; +message_1(econnreset) -> <<"connection reset by peer">>; +message_1(edeadlk) -> <<"resource deadlock avoided">>; +message_1(edeadlock) -> <<"resource deadlock avoided">>; +message_1(edestaddrreq) -> <<"destination address required">>; +message_1(edirty) -> <<"mounting a dirty fs w/o force">>; +message_1(edom) -> <<"math argument out of range">>; +message_1(edotdot) -> <<"cross mount point">>; +message_1(edquot) -> <<"disk quota exceeded">>; +message_1(eduppkg) -> <<"duplicate package name">>; +message_1(eexist) -> <<"file already exists">>; +message_1(efault) -> <<"bad address in system call argument">>; +message_1(efbig) -> <<"file too large">>; +message_1(ehostdown) -> <<"host is down">>; +message_1(ehostunreach) -> <<"host is unreachable">>; +message_1(eidrm) -> <<"identifier removed">>; +message_1(einit) -> <<"initialization error">>; +message_1(einprogress) -> <<"operation now in progress">>; +message_1(eintr) -> <<"interrupted system call">>; +message_1(einval) -> <<"invalid argument">>; +message_1(eio) -> <<"I/O error">>; +message_1(eisconn) -> <<"socket is already connected">>; +message_1(eisdir) -> <<"illegal operation on a directory">>; +message_1(eisnam) -> <<"is a name file">>; +message_1(elbin) -> <<"ELBIN">>; +message_1(el2hlt) -> <<"level 2 halted">>; +message_1(el2nsync) -> <<"level 2 not synchronized">>; +message_1(el3hlt) -> <<"level 3 halted">>; +message_1(el3rst) -> <<"level 3 reset">>; +message_1(elibacc) -> <<"can not access a needed shared library">>; +message_1(elibbad) -> <<"accessing a corrupted shared library">>; +message_1(elibexec) -> <<"can not exec a shared library directly">>; +message_1(elibmax) -> + <<"attempting to link in more shared libraries than system limit">>; +message_1(elibscn) -> <<".lib section in a.out corrupted">>; +message_1(elnrng) -> <<"link number out of range">>; +message_1(eloop) -> <<"too many levels of symbolic links">>; +message_1(emfile) -> <<"too many open files">>; +message_1(emlink) -> <<"too many links">>; +message_1(emsgsize) -> <<"message too long">>; +message_1(emultihop) -> <<"multihop attempted">>; +message_1(enametoolong) -> <<"file name too long">>; +message_1(enavail) -> <<"not available">>; +message_1(enet) -> <<"ENET">>; +message_1(enetdown) -> <<"network is down">>; +message_1(enetreset) -> <<"network dropped connection on reset">>; +message_1(enetunreach) -> <<"network is unreachable">>; +message_1(enfile) -> <<"file table overflow">>; +message_1(enoano) -> <<"anode table overflow">>; +message_1(enobufs) -> <<"no buffer space available">>; +message_1(enocsi) -> <<"no CSI structure available">>; +message_1(enodata) -> <<"no data available">>; +message_1(enodev) -> <<"no such device">>; +message_1(enoent) -> <<"no such file or directory">>; +message_1(enoexec) -> <<"exec format error">>; +message_1(enolck) -> <<"no locks available">>; +message_1(enolink) -> <<"link has be severed">>; +message_1(enomem) -> <<"not enough memory">>; +message_1(enomsg) -> <<"no message of desired type">>; +message_1(enonet) -> <<"machine is not on the network">>; +message_1(enopkg) -> <<"package not installed">>; +message_1(enoprotoopt) -> <<"bad proocol option">>; +message_1(enospc) -> <<"no space left on device">>; +message_1(enosr) -> <<"out of stream resources or not a stream device">>; +message_1(enosym) -> <<"unresolved symbol name">>; +message_1(enosys) -> <<"function not implemented">>; +message_1(enotblk) -> <<"block device required">>; +message_1(enotconn) -> <<"socket is not connected">>; +message_1(enotdir) -> <<"not a directory">>; +message_1(enotempty) -> <<"directory not empty">>; +message_1(enotnam) -> <<"not a name file">>; +message_1(enotsock) -> <<"socket operation on non-socket">>; +message_1(enotsup) -> <<"operation not supported">>; +message_1(enotty) -> <<"inappropriate device for ioctl">>; +message_1(enotuniq) -> <<"name not unique on network">>; +message_1(enxio) -> <<"no such device or address">>; +message_1(eopnotsupp) -> <<"operation not supported on socket">>; +message_1(eperm) -> <<"not owner">>; +message_1(epfnosupport) -> <<"protocol family not supported">>; +message_1(epipe) -> <<"broken pipe">>; +message_1(eproclim) -> <<"too many processes">>; +message_1(eprocunavail) -> <<"bad procedure for program">>; +message_1(eprogmismatch) -> <<"program version wrong">>; +message_1(eprogunavail) -> <<"RPC program not available">>; +message_1(eproto) -> <<"protocol error">>; +message_1(eprotonosupport) -> <<"protocol not suppored">>; +message_1(eprototype) -> <<"protocol wrong type for socket">>; +message_1(erange) -> <<"math result unrepresentable">>; +message_1(erefused) -> <<"EREFUSED">>; +message_1(eremchg) -> <<"remote address changed">>; +message_1(eremdev) -> <<"remote device">>; +message_1(eremote) -> <<"pathname hit remote file system">>; +message_1(eremoteio) -> <<"remote i/o error">>; +message_1(eremoterelease) -> <<"EREMOTERELEASE">>; +message_1(erofs) -> <<"read-only file system">>; +message_1(erpcmismatch) -> <<"RPC version is wrong">>; +message_1(erremote) -> <<"object is remote">>; +message_1(eshutdown) -> <<"can't send after socket shutdown">>; +message_1(esocktnosupport) -> <<"socket type not supported">>; +message_1(espipe) -> <<"invalid seek">>; +message_1(esrch) -> <<"no such process">>; +message_1(esrmnt) -> <<"srmount error">>; +message_1(estale) -> <<"stale remote file handle">>; +message_1(esuccess) -> <<"Error 0">>; +message_1(etime) -> <<"timer expired">>; +message_1(etimedout) -> <<"connection timed out">>; +message_1(etoomanyrefs) -> <<"too many references: can't splice">>; +message_1(etxtbsy) -> <<"text file or pseudo-device busy">>; +message_1(euclean) -> <<"structure needs cleaning">>; +message_1(eunatch) -> <<"protocol driver not attached">>; +message_1(eusers) -> <<"too many users">>; +message_1(eversion) -> <<"version mismatch">>; +message_1(ewouldblock) -> <<"operation would block">>; +message_1(exdev) -> <<"cross-domain link">>; +message_1(exfull) -> <<"message tables full">>; +message_1(nxdomain) -> <<"non-existing domain">>; +message_1(_) -> <<"unknown POSIX error">>. diff --git a/lib/stdlib/src/erl_pp.erl b/lib/stdlib/src/erl_pp.erl index 0859bf0466..66c80a45cb 100644 --- a/lib/stdlib/src/erl_pp.erl +++ b/lib/stdlib/src/erl_pp.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% Copyright Ericsson AB 1996-2011. 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 @@ -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); @@ -174,12 +174,15 @@ ltype({atom,_,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) -> @@ -443,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), @@ -555,17 +558,11 @@ record_field({typed_record_field,{record_field,_,F,Val},Type}, Hook) -> Fl = lexpr(F, L, Hook), Vl = typed(lexpr(Val, R, Hook), Type), {list,[{cstep,[Fl,' ='],Vl}]}; -record_field({typed_record_field,Field,Type0}, Hook) -> - Type = remove_undefined(Type0), +record_field({typed_record_field,Field,Type}, Hook) -> typed(record_field(Field, Hook), Type); record_field({record_field,_,F}, Hook) -> lexpr(F, 0, Hook). -remove_undefined({type,L,union,[{atom,_,undefined}|T]}) -> - {type,L,union,T}; -remove_undefined(T) -> % cannot happen - T. - list({cons,_,H,T}, Es, Hook) -> list(T, [H|Es], Hook); list({nil,_}, Es, Hook) -> @@ -727,15 +724,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. @@ -761,7 +758,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 -> @@ -876,7 +873,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} @@ -956,9 +953,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); @@ -966,7 +963,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 1013d54bdc..18f64c46d0 100644 --- a/lib/stdlib/src/erl_scan.erl +++ b/lib/stdlib/src/erl_scan.erl @@ -55,18 +55,13 @@ 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,6 +90,15 @@ -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) ++ @@ -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}; + try lists:keyfind(Item, 1, Attrs) of + {_Item, _Value} = T -> + T; false -> - undefined; - _ -> + 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 @@ -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)}; diff --git a/lib/stdlib/src/escript.erl b/lib/stdlib/src/escript.erl index d26443f277..d67617260e 100644 --- a/lib/stdlib/src/escript.erl +++ b/lib/stdlib/src/escript.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2010. All Rights Reserved. +%% Copyright Ericsson AB 2007-2011. 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 @@ -24,35 +24,41 @@ %% Internal API. -export([start/0, start/1]). --include_lib("kernel/include/file.hrl"). +%%----------------------------------------------------------------------- -define(SHEBANG, "/usr/bin/env escript"). -define(COMMENT, "This is an -*- erlang -*- file"). --record(state, {file, - module, +%%----------------------------------------------------------------------- + +-type mode() :: 'native' | '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}). --record(sections, {type, - shebang, - comment, - emu_args, - body}). --record(extract_options, {compile_source}). + 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(). --type escript_filename() :: string(). --type filename() :: string(). + +-record(sections, {type, + shebang :: shebang(), + comment :: comment(), + emu_args :: emu_args(), + body}). + +-record(extract_options, {compile_source}). + -type zip_file() :: - filename() - | {filename(), binary()} - | {filename(), binary(), #file_info{}}. + file:filename() + | {file:filename(), binary()} + | {file:filename(), binary(), file:file_info()}. -type zip_create_option() :: term(). -type section() :: shebang @@ -60,13 +66,15 @@ | comment | {comment, comment()} | {emu_args, emu_args()} - | {source, filename() | binary()} - | {beam, filename() | binary()} - | {archive, filename() | binary()} + | {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(escript_filename() | binary, [section()]) -> +-spec create(file:filename() | binary, [section()]) -> ok | {ok, binary()} | {error, term()}. create(File, Options) when is_list(Options) -> @@ -149,7 +157,9 @@ prepare(BadOptions, _) -> -type section_name() :: shebang | comment | emu_args | body . -type extract_option() :: compile_source | {section, [section_name()]}. --spec extract(filename(), [extract_option()]) -> {ok, [section()]} | {error, term()}. +-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, @@ -239,6 +249,7 @@ normalize_section(Name, Chars) -> {Name, Chars}. -spec script_name() -> string(). + script_name() -> [ScriptName|_] = init:get_plain_arguments(), ScriptName. @@ -248,10 +259,12 @@ script_name() -> %% -spec start() -> no_return(). + start() -> start([]). -spec start([string()]) -> no_return(). + start(EscriptOptions) -> try %% Commands run using -run or -s are run in a process @@ -291,7 +304,11 @@ parse_and_run(File, Args, Options) -> false -> case lists:member("i", Options) of true -> interpret; - false -> Mode + false -> + case lists:member("n", Options) of + true -> native; + false -> Mode + end end end end, @@ -308,6 +325,14 @@ parse_and_run(File, Args, Options) -> _Other -> fatal("There were compilation errors.") end; + native -> + case compile:forms(FormsOrBin, [report,native]) of + {ok, Module, BeamBin} -> + {module, Module} = code:load_binary(Module, File, BeamBin), + run(Module, Args); + _Other -> + fatal("There were compilation errors.") + end; debug -> case compile:forms(FormsOrBin, [report, debug_info]) of {ok,Module,BeamBin} -> @@ -484,18 +509,12 @@ find_first_body_line(Fd, HeaderSz0, LineNo, KeepFirst, Sections) -> classify_line(Line) -> case Line of - [$\#, $\! | _] -> - shebang; - [$P, $K | _] -> - archive; - [$F, $O, $R, $1 | _] -> - beam; - [$%, $%, $\! | _] -> - emu_args; - [$% | _] -> - comment; - _ -> - undefined + "#!" ++ _ -> shebang; + "PK" ++ _ -> archive; + "FOR1" ++ _ -> beam; + "%%!" ++ _ -> emu_args; + "%" ++ _ -> comment; + _ -> undefined end. guess_type(Line) -> @@ -531,7 +550,6 @@ parse_archive(S, File, HeaderSz) -> end, list_to_atom(lists:reverse(RevBase2)) end, - S#state{source = archive, mode = run, module = Mod, @@ -564,9 +582,7 @@ parse_beam(S, File, HeaderSz, CheckOnly) -> forms_or_bin = Bin} end; {error, beam_lib, Reason} when is_tuple(Reason) -> - fatal(element(1, Reason)); - {error, beam_lib, Reason} -> - fatal(Reason) + fatal(element(1, Reason)) end. parse_source(S, File, Fd, StartLine, HeaderSz, CheckOnly) -> @@ -587,8 +603,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), @@ -660,7 +676,7 @@ epp_parse_file2(Epp, S, Forms, Parsed) -> {attribute,Ln,mode,NewMode} -> S2 = S#state{mode = NewMode}, if - NewMode =:= compile; NewMode =:= interpret; NewMode =:= debug -> + NewMode =:= compile; NewMode =:= interpret; NewMode =:= debug; NewMode =:= native -> epp_parse_file(Epp, S2, [Form | Forms]); true -> Args = lists:flatten(io_lib:format("illegal mode attribute: ~p", [NewMode])), @@ -683,8 +699,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. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/lib/stdlib/src/ets.erl b/lib/stdlib/src/ets.erl index d7b5dbc636..6e6e949e2c 100644 --- a/lib/stdlib/src/ets.erl +++ b/lib/stdlib/src/ets.erl @@ -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). @@ -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 -> @@ -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([]) -> @@ -855,19 +862,28 @@ load_table(ReadFun, State, Tab) -> load_table(ReadFun, NewState, Tab) end. -create_tab(I) -> +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), - try - Tab = ets:new(Name, [Type, P, Keypos | named_table(Val)]), - {ok, Tab, Sz} - catch - _:_ -> - throw(cannot_create_table) + 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]; 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 5c5e084e17..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]). @@ -45,14 +47,14 @@ wildcard(Pattern) when is_list(Pattern) -> ?HANDLE_ERROR(do_wildcard(Pattern, file)). -spec wildcard(file:name(), file:name() | atom()) -> [file:filename()]. -wildcard(Pattern, Cwd) when is_list(Pattern), is_list(Cwd) -> +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(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(file:name()) -> boolean(). @@ -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. @@ -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 01c06e4596..24abf1e977 100644 --- a/lib/stdlib/src/filename.erl +++ b/lib/stdlib/src/filename.erl @@ -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(file:name()) -> string(). + +-spec absname(file:name()) -> file:filename(). absname(Name) -> {ok, Cwd} = file:get_cwd(), absname(Name, Cwd). --spec absname(file: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(), file: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,18 +131,40 @@ absname_pretty(Abspath, [First|Rest], AbsBase) -> %% basename("/usr/foo/") -> "foo" (trailing slashes ignored) %% basename("/") -> [] --spec basename(file: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) -> basename1(Rest, [], DirSep2); -basename1([[_|_]=List|Rest], Tail, DirSep2) -> - basename1(List++Rest, Tail, DirSep2); basename1([DirSep2|Rest], Tail, DirSep2) when is_integer(DirSep2) -> basename1([$/|Rest], Tail, DirSep2); basename1([Char|Rest], Tail, DirSep2) when is_integer(Char) -> @@ -155,26 +172,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_prefix1([L], _) when is_integer(L) -> - [L]; -skip_prefix1(Name, _) -> +skip_prefix([L, DrvSep|Name], DrvSep) when ?IS_DRIVELETTER(L) -> + Name; +skip_prefix(Name, _) -> Name. %% Returns the last component of the filename, with the given @@ -190,7 +192,29 @@ skip_prefix1(Name, _) -> %% rootname(basename("xxx.jam")) -> "xxx" %% rootname(basename("xxx.erl")) -> "xxx" --spec basename(file:name(), file: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 +228,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,24 +240,44 @@ basename([], _Ext, Tail, _DrvSep2) -> %% Example: dirname("/usr/src/kalle.erl") -> "/usr/src", %% dirname("kalle.erl") -> "." --spec dirname(file: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); dirname([$/|Rest], Dir, File, Seps) -> dirname(Rest, File++Dir, [$/], Seps); dirname([DirSep|Rest], Dir, File, {DirSep,_}=Seps) when is_integer(DirSep) -> @@ -258,6 +302,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 +332,29 @@ dirname([], Dir, _, _) -> %% %% On Windows: fn:dirname("\\usr\\src/kalle.erl") -> "/usr/src" --spec extension(file: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 + [] -> + <<>>; + 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 +367,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 +374,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 +418,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 +439,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 +472,13 @@ 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(), file:name()) -> string(). +-spec append(file:filename(), file:name()) -> file:filename(). +append(Dir, Name) when is_binary(Dir), is_binary(Name) -> + <<Dir/binary,$/:8,Name/binary>>; +append(Dir, Name) when is_binary(Dir) -> + append(Dir,filename_string_to_binary(Name)); +append(Dir, Name) when is_binary(Name) -> + append(filename_string_to_binary(Dir),Name); append(Dir, Name) -> Dir ++ [$/|Name]. @@ -376,19 +497,14 @@ append(Dir, Name) -> -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(file: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(file:name(), file: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(file: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]) -> @@ -528,8 +685,6 @@ split([$/|Rest], Comp, Components, OsType) -> split(Rest, [], [lists:reverse(Comp)|Components], OsType); split([Char|Rest], Comp, Components, OsType) when is_integer(Char) -> split(Rest, [Char|Comp], Components, OsType); -split([List|Rest], Comp, Components, OsType) when is_list(List) -> - split(List++Rest, Comp, Components, OsType); split([], [], Components, _OsType) -> lists:reverse(Components); split([], Comp, Components, OsType) -> @@ -540,7 +695,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 +712,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 +887,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(file:name()) -> string(). +-spec flatten(file:name()) -> file:filename(). +flatten(Bin) when is_binary(Bin) -> + Bin; flatten(List) -> do_flatten(List, []). @@ -785,3 +906,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..fc5beb28b0 100644 --- a/lib/stdlib/src/gb_sets.erl +++ b/lib/stdlib/src/gb_sets.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%% Copyright Ericsson AB 2001-2011. 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 @@ -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_event.erl b/lib/stdlib/src/gen_event.erl index 27ff9441e6..b1e9e3a02f 100644 --- a/lib/stdlib/src/gen_event.erl +++ b/lib/stdlib/src/gen_event.erl @@ -677,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; @@ -711,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 9961646418..7d9960b912 100644 --- a/lib/stdlib/src/gen_fsm.erl +++ b/lib/stdlib/src/gen_fsm.erl @@ -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 1c9e5270b6..ac81df9cab 100644 --- a/lib/stdlib/src/gen_server.erl +++ b/lib/stdlib/src/gen_server.erl @@ -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..6aeb076a0b 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-2011. 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,12 +32,15 @@ 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]). %%------------------------------------------------------------------------- -type device() :: atom() | pid(). -type prompt() :: atom() | string(). +-type error_description() :: term(). % Whatever the io-server sends. +-type request_error() :: {'error',error_description()}. %% XXX: Some uses of line() in this file may need to read erl_scan:location() -type line() :: pos_integer(). @@ -52,26 +55,12 @@ to_tuple(T) when is_tuple(T) -> T; to_tuple(T) -> {T}. -%% Problem: the variables Other, Name and Args may collide with surrounding -%% ones. -%% Give extra args to macro, being the variables to use. --define(O_REQUEST(Io, Request), - case request(Io, Request) of - {error, Reason} -> - [Name | Args] = tuple_to_list(to_tuple(Request)), - erlang:error(conv_reason(Name, Reason), [Name, Io | Args]); - Other -> - Other - end). - o_request(Io, Request, Func) -> case request(Io, Request) of {error, Reason} -> [_Name | Args] = tuple_to_list(to_tuple(Request)), - {'EXIT',{undef,[_Current|Mfas]}} = (catch erlang:error(undef)), - MFA = {io, Func, [Io | Args]}, - exit({conv_reason(Func, Reason),[MFA|Mfas]}); -% erlang:error(conv_reason(Name, Reason), [Name, Io | Args]); + {'EXIT',{get_stacktrace,[_Current|Mfas]}} = (catch erlang:error(get_stacktrace)), + erlang:raise(error, conv_reason(Func, Reason), [{io, Func, [Io | Args]}|Mfas]); Other -> Other end. @@ -298,32 +287,32 @@ format(Io, Format, Args) -> %% Scanning Erlang code. --spec scan_erl_exprs(prompt()) -> erl_scan:tokens_result(). +-spec scan_erl_exprs(prompt()) -> erl_scan:tokens_result() | request_error(). scan_erl_exprs(Prompt) -> scan_erl_exprs(default_input(), Prompt, 1). --spec scan_erl_exprs(device(), prompt()) -> erl_scan:tokens_result(). +-spec scan_erl_exprs(device(), prompt()) -> erl_scan:tokens_result() | request_error(). scan_erl_exprs(Io, Prompt) -> scan_erl_exprs(Io, Prompt, 1). --spec scan_erl_exprs(device(), prompt(), line()) -> erl_scan:tokens_result(). +-spec scan_erl_exprs(device(), prompt(), line()) -> erl_scan:tokens_result() | request_error(). scan_erl_exprs(Io, Prompt, Pos0) -> request(Io, {get_until,unicode,Prompt,erl_scan,tokens,[Pos0]}). --spec scan_erl_form(prompt()) -> erl_scan:tokens_result(). +-spec scan_erl_form(prompt()) -> erl_scan:tokens_result() | request_error(). scan_erl_form(Prompt) -> scan_erl_form(default_input(), Prompt, 1). --spec scan_erl_form(device(), prompt()) -> erl_scan:tokens_result(). +-spec scan_erl_form(device(), prompt()) -> erl_scan:tokens_result() | request_error(). scan_erl_form(Io, Prompt) -> scan_erl_form(Io, Prompt, 1). --spec scan_erl_form(device(), prompt(), line()) -> erl_scan:tokens_result(). +-spec scan_erl_form(device(), prompt(), line()) -> erl_scan:tokens_result() | request_error(). scan_erl_form(Io, Prompt, Pos0) -> request(Io, {get_until,unicode,Prompt,erl_scan,tokens,[Pos0]}). @@ -334,7 +323,8 @@ scan_erl_form(Io, Prompt, Pos0) -> -type parse_ret() :: {'ok', erl_parse_expr_list(), line()} | {'eof', line()} - | {'error', erl_scan:error_info(), line()}. + | {'error', erl_scan:error_info(), line()} + | request_error(). -spec parse_erl_exprs(prompt()) -> parse_ret(). @@ -363,7 +353,8 @@ parse_erl_exprs(Io, Prompt, Pos0) -> -type parse_form_ret() :: {'ok', erl_parse_absform(), line()} | {'eof', line()} - | {'error', erl_scan:error_info(), line()}. + | {'error', erl_scan:error_info(), line()} + | request_error(). -spec parse_erl_form(prompt()) -> parse_form_ret(). 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_format.erl b/lib/stdlib/src/io_lib_format.erl index eb1885021d..49a00a4ec7 100644 --- a/lib/stdlib/src/io_lib_format.erl +++ b/lib/stdlib/src/io_lib_format.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. +%% Copyright Ericsson AB 1996-2011. 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 @@ -558,28 +558,30 @@ iolist_to_chars(B) when is_binary(B) -> string(S, none, _Adj, none, _Pad) -> S; string(S, F, Adj, none, Pad) -> - N = lists:flatlength(S), - if N > F -> flat_trunc(S, F); - N =:= F -> S; - true -> adjust(S, chars(Pad, F-N), Adj) - end; + string_field(S, F, Adj, lists:flatlength(S), Pad); string(S, none, _Adj, P, Pad) -> + string_field(S, P, left, lists:flatlength(S), Pad); +string(S, F, Adj, P, Pad) when F >= P -> N = lists:flatlength(S), - if N > P -> flat_trunc(S, P); - N =:= P -> S; - true -> [S|chars(Pad, P-N)] - end; -string(S, F, Adj, F, Pad) -> - string(S, none, Adj, F, Pad); -string(S, F, Adj, P, Pad) when F > P -> - N = lists:flatlength(S), - if N > F -> flat_trunc(S, F); - N =:= F -> S; - N > P -> adjust(flat_trunc(S, P), chars(Pad, F-P), Adj); - N =:= P -> adjust(S, chars(Pad, F-P), Adj); - true -> adjust([S|chars(Pad, P-N)], chars(Pad, F-P), Adj) + if F > P -> + if N > P -> + adjust(flat_trunc(S, P), chars(Pad, F-P), Adj); + N < P -> + adjust([S|chars(Pad, P-N)], chars(Pad, F-P), Adj); + true -> % N == P + adjust(S, chars(Pad, F-P), Adj) + end; + true -> % F == P + string_field(S, F, Adj, N, Pad) end. +string_field(S, F, _Adj, N, _Pad) when N > F -> + flat_trunc(S, F); +string_field(S, F, Adj, N, Pad) when N < F -> + adjust(S, chars(Pad, F-N), Adj); +string_field(S, _, _, _, _) -> % N == F + S. + %% unprefixed_integer(Int, Field, Adjust, Base, PadChar, Lowercase) %% -> [Char]. @@ -624,8 +626,8 @@ newline(F, right, _P, _Pad) -> chars($\n, F). %% adjust(Data, [], _) -> Data; -adjust(Data, Pad, left) -> [Data,Pad]; -adjust(Data, Pad, right) -> [Pad,Data]. +adjust(Data, Pad, left) -> [Data|Pad]; +adjust(Data, Pad, right) -> [Pad|Data]. %% Flatten and truncate a deep list to at most N elements. 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 857eda8161..c669c1f7c1 100644 --- a/lib/stdlib/src/lists.erl +++ b/lib/stdlib/src/lists.erl @@ -18,6 +18,9 @@ %% -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, @@ -347,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, []). @@ -355,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); @@ -367,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); @@ -379,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; @@ -391,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; @@ -417,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). @@ -437,7 +440,7 @@ do_flatten([], Tail) -> %% 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). @@ -478,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). @@ -488,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). @@ -499,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, []). @@ -510,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). @@ -521,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 @@ -579,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 @@ -594,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 @@ -606,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 @@ -672,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 @@ -687,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 @@ -699,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)]; @@ -722,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, []), []); @@ -731,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, []), []); @@ -765,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; @@ -774,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; @@ -839,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). @@ -848,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); @@ -861,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); @@ -873,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; @@ -886,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; @@ -949,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)); @@ -995,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), @@ -1010,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/log_mf_h.erl b/lib/stdlib/src/log_mf_h.erl index 2729f27e51..5fa5360fa1 100644 --- a/lib/stdlib/src/log_mf_h.erl +++ b/lib/stdlib/src/log_mf_h.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. +%% Copyright Ericsson AB 1996-2011. 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 @@ -185,13 +185,19 @@ read_index_file(Dir) -> %%----------------------------------------------------------------- %% Write the index file. This file contains one binary with %% the last used filename (an integer). +%% Write a temporary file and rename it in order to make the update +%% atomic. %%----------------------------------------------------------------- write_index_file(Dir, Index) -> - case file:open(Dir ++ "/index", [raw, write]) of + File = Dir ++ "/index", + TmpFile = File ++ ".tmp", + case file:open(TmpFile, [raw, write]) of {ok, Fd} -> - file:write(Fd, [Index]), - ok = file:close(Fd); + ok = file:write(Fd, [Index]), + ok = file:close(Fd), + ok = file:rename(TmpFile,File), + ok; _ -> exit(open_index_file) end. diff --git a/lib/stdlib/src/ms_transform.erl b/lib/stdlib/src/ms_transform.erl index 78b1de6e16..b565eb20f4 100644 --- a/lib/stdlib/src/ms_transform.erl +++ b/lib/stdlib/src/ms_transform.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2009. All Rights Reserved. +%% Copyright Ericsson AB 2002-2011. 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 @@ -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..4e30c9eefd 100644 --- a/lib/stdlib/src/orddict.erl +++ b/lib/stdlib/src/orddict.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. +%% Copyright Ericsson AB 1996-2011. 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 @@ -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..5a1c260703 100644 --- a/lib/stdlib/src/ordsets.erl +++ b/lib/stdlib/src/ordsets.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. +%% Copyright Ericsson AB 1996-2011. 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 @@ -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 f3cfd78d54..5c52dfcbf0 100644 --- a/lib/stdlib/src/otp_internal.erl +++ b/lib/stdlib/src/otp_internal.erl @@ -349,14 +349,24 @@ obsolete_1(ssh_sftp, stop, 1) -> %% 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},"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/re.erl b/lib/stdlib/src/re.erl index 296a6b3d23..e2cc9f57ce 100644 --- a/lib/stdlib/src/re.erl +++ b/lib/stdlib/src/re.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2010. All Rights Reserved. +%% Copyright Ericsson AB 2008-2011. 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 @@ -37,16 +37,16 @@ split(Subject,RE,Options) -> {error,_Err} -> throw(badre); {PreCompiled, NumSub, RunOpt} -> - % OK, lets run + %% OK, lets run case re:run(FlatSubject,PreCompiled,RunOpt ++ [global]) of nomatch -> case Group of true -> convert_any_split_result([[FlatSubject]], - Convert, Unicode,true); + Convert, Unicode, true); false -> convert_any_split_result([FlatSubject], - Convert, Unicode,false) + Convert, Unicode, false) end; {match, Matches} -> Res = do_split(FlatSubject, 0, Matches, NumSub, @@ -69,7 +69,7 @@ split(Subject,RE,Options) -> erlang:error(badarg,[Subject,RE,Options]) end. -backstrip_empty(List,false) -> +backstrip_empty(List, false) -> do_backstrip_empty(List); backstrip_empty(List, true) -> do_backstrip_empty_g(List). @@ -196,41 +196,36 @@ compile_split(Pat,Options0) when not is_tuple(Pat) -> end; compile_split(_,_) -> throw(badre). - - replace(Subject,RE,Replacement) -> replace(Subject,RE,Replacement,[]). + replace(Subject,RE,Replacement,Options) -> try {NewOpt,Convert,Unicode} = process_repl_params(Options,iodata,false), FlatSubject = to_binary(Subject, Unicode), FlatReplacement = to_binary(Replacement, Unicode), - case do_replace(FlatSubject,Subject,RE,FlatReplacement,NewOpt) of - {error,_Err} -> - throw(badre); - IoList -> - case Convert of - iodata -> - IoList; - binary -> - case Unicode of - false -> - iolist_to_binary(IoList); - true -> - unicode:characters_to_binary(IoList,unicode) - end; - list -> - case Unicode of - false -> - binary_to_list(iolist_to_binary(IoList)); - true -> - unicode:characters_to_list(IoList,unicode) - end - end - end + IoList = do_replace(FlatSubject,Subject,RE,FlatReplacement,NewOpt), + case Convert of + iodata -> + IoList; + binary -> + case Unicode of + false -> + iolist_to_binary(IoList); + true -> + unicode:characters_to_binary(IoList,unicode) + end; + list -> + case Unicode of + false -> + binary_to_list(iolist_to_binary(IoList)); + true -> + unicode:characters_to_list(IoList,unicode) + end + end catch throw:badopt -> erlang:error(badarg,[Subject,RE,Replacement,Options]); @@ -239,7 +234,7 @@ replace(Subject,RE,Replacement,Options) -> error:badarg -> erlang:error(badarg,[Subject,RE,Replacement,Options]) end. - + do_replace(FlatSubject,Subject,RE,Replacement,Options) -> case re:run(FlatSubject,RE,Options) of @@ -314,7 +309,7 @@ apply_mlist(Subject,Replacement,Mlist) -> precomp_repl(<<>>) -> []; precomp_repl(<<$\\,X,Rest/binary>>) when X < $1 ; X > $9 -> - % Escaped character + %% Escaped character case precomp_repl(Rest) of [BHead | T0] when is_binary(BHead) -> [<<X,BHead/binary>> | T0]; @@ -524,7 +519,7 @@ process_uparams([H|T],Type) -> {[H|NL],NType}; process_uparams([],Type) -> {[],Type}. - + ucompile(RE,Options) -> try @@ -548,6 +543,7 @@ urun(Subject,RE,Options) -> [Subject,RE,Options])), erlang:raise(error,AnyError,[{Mod,run,L}|Rest]) end. + urun2(Subject0,RE0,Options0) -> {Options,RetType} = case (catch process_uparams(Options0,index)) of {A,B} -> @@ -573,7 +569,6 @@ urun2(Subject0,RE0,Options0) -> _ -> Ret end. - %% Might be called either with two-tuple (if regexp was already compiled) 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..264348180f 100644 --- a/lib/stdlib/src/string.erl +++ b/lib/stdlib/src/string.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. +%% Copyright Ericsson AB 1996-2011. 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 @@ -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..3c5800effa 100644 --- a/lib/stdlib/src/supervisor.erl +++ b/lib/stdlib/src/supervisor.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% Copyright Ericsson AB 1996-2011. 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 @@ -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()] | undefined}. +-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() | list(), + 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,31 +273,32 @@ 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 = hd(State#state.children), + #child{mfargs = {M, F, A}} = Child, Args = A ++ EArgs, case do_start_child_i(M, F, Args) of {ok, Pid} -> - NState = State#state{dynamics = - ?DICT:store(Pid, Args, State#state.dynamics)}, + NState = save_dynamic_child(Child#child.restart_type, Pid, Args, State), {reply, {ok, Pid}, NState}; {ok, Pid, Extra} -> - NState = State#state{dynamics = - ?DICT:store(Pid, Args, State#state.dynamics)}, + NState = save_dynamic_child(Child#child.restart_type, Pid, Args, State), {reply, {ok, Pid, Extra}, NState}; What -> {reply, What, 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}; @@ -287,28 +350,56 @@ handle_call({terminate_child, Name}, _From, State) -> {reply, {error, not_found}, State} end; -handle_call(which_children, _From, State) when ?is_simple(State) -> - [#child{child_type = CT, modules = Mods}] = State#state.children, +handle_call(which_children, _From, #state{children = [#child{restart_type = temporary, + child_type = CT, + modules = Mods}]} = + State) when ?is_simple(State) -> + Reply = lists:map(fun(Pid) -> {undefined, Pid, CT, Mods} end, dynamics_db(temporary, + State#state.dynamics)), + {reply, Reply, State}; + +handle_call(which_children, _From, #state{children = [#child{restart_type = RType, + child_type = CT, + modules = Mods}]} = + State) when ?is_simple(State) -> Reply = lists:map(fun({Pid, _}) -> {undefined, Pid, CT, Mods} end, - ?DICT:to_list(State#state.dynamics)), + ?DICT:to_list(dynamics_db(RType, State#state.dynamics))), {reply, Reply, State}; 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}; -handle_call(count_children, _From, State) when ?is_simple(State) -> - [#child{child_type = CT}] = State#state.children, + +handle_call(count_children, _From, #state{children = [#child{restart_type = temporary, + child_type = CT}]} = State) + when ?is_simple(State) -> + {Active, Count} = + lists:foldl(fun(Pid, {Alive, Tot}) -> + if is_pid(Pid) -> {Alive+1, Tot +1}; + true -> {Alive, Tot + 1} end + end, {0, 0}, dynamics_db(temporary, State#state.dynamics)), + Reply = case CT of + supervisor -> [{specs, 1}, {active, Active}, + {supervisors, Count}, {workers, 0}]; + worker -> [{specs, 1}, {active, Active}, + {supervisors, 0}, {workers, Count}] + end, + {reply, Reply, State}; + +handle_call(count_children, _From, #state{children = [#child{restart_type = RType, + child_type = CT}]} = State) + when ?is_simple(State) -> {Active, Count} = ?DICT:fold(fun(Pid, _Val, {Alive, Tot}) -> if is_pid(Pid) -> {Alive+1, Tot +1}; true -> {Alive, Tot + 1} end - end, {0, 0}, State#state.dynamics), + end, {0, 0}, dynamics_db(RType, State#state.dynamics)), Reply = case CT of supervisor -> [{specs, 1}, {active, Active}, {supervisors, Count}, {workers, 0}]; @@ -318,7 +409,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 +437,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 +462,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 +481,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 +511,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 +537,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) -> @@ -462,15 +562,11 @@ handle_start_child(Child, State) -> false -> case do_start_child(State#state.name, Child) of {ok, Pid} -> - Children = State#state.children, {{ok, Pid}, - State#state{children = - [Child#child{pid = Pid}|Children]}}; + save_child(Child#child{pid = Pid}, State)}; {ok, Pid, Extra} -> - Children = State#state.children, {{ok, Pid, Extra}, - State#state{children = - [Child#child{pid = Pid}|Children]}}; + save_child(Child#child{pid = Pid}, State)}; {error, What} -> {{error, {What, Child}}, State} end; @@ -482,27 +578,26 @@ 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) -> - case ?DICT:find(Pid, State#state.dynamics) of +restart_child(Pid, Reason, #state{children = [Child]} = State) when ?is_simple(State) -> + RestartType = Child#child.restart_type, + case dynamic_child_args(Pid, dynamics_db(RestartType, State#state.dynamics)) of {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} + {ok, State} end; + restart_child(Pid, Reason, State) -> Children = State#state.children, - case lists:keysearch(Pid, #child.pid, Children) of - {value, Child} -> - RestartType = Child#child.restart_type, + case lists:keyfind(Pid, #child.pid, Children) of + #child{restart_type = RestartType} = Child -> do_restart(RestartType, Reason, Child, State); - _ -> + false -> {ok, State} end. @@ -534,8 +629,9 @@ restart(Child, State) -> end. restart(simple_one_for_one, Child, State) -> - #child{mfa = {M, F, A}} = Child, - Dynamics = ?DICT:erase(Child#child.pid, State#state.dynamics), + #child{mfargs = {M, F, A}} = Child, + Dynamics = ?DICT:erase(Child#child.pid, dynamics_db(Child#child.restart_type, + State#state.dynamics)), case do_start_child_i(M, F, A) of {ok, Pid} -> NState = State#state{dynamics = ?DICT:store(Pid, A, Dynamics)}, @@ -580,9 +676,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 +691,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 +714,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 +726,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 @@ -684,8 +778,40 @@ monitor_child(Pid) -> %%----------------------------------------------------------------- %% Child/State manipulating functions. %%----------------------------------------------------------------- -state_del_child(#child{pid = Pid}, State) when ?is_simple(State) -> - NDynamics = ?DICT:erase(Pid, State#state.dynamics), + +%% Note we do not want to save the parameter list for temporary processes as +%% they will not be restarted, and hence we do not need this information. +%% Especially for dynamic children to simple_one_for_one supervisors +%% it could become very costly as it is not uncommon to spawn +%% very many such processes. +save_child(#child{restart_type = temporary, + mfargs = {M, F, _}} = Child, #state{children = Children} = State) -> + State#state{children = [Child#child{mfargs = {M, F, undefined}} |Children]}; +save_child(Child, #state{children = Children} = State) -> + State#state{children = [Child |Children]}. + +save_dynamic_child(temporary, Pid, _, #state{dynamics = Dynamics} = State) -> + State#state{dynamics = [Pid | dynamics_db(temporary, Dynamics)]}; +save_dynamic_child(RestartType, Pid, Args, #state{dynamics = Dynamics} = State) -> + State#state{dynamics = ?DICT:store(Pid, Args, dynamics_db(RestartType, Dynamics))}. + +dynamics_db(temporary, undefined) -> + []; +dynamics_db(_, undefined) -> + ?DICT:new(); +dynamics_db(_,Dynamics) -> + Dynamics. + +dynamic_child_args(_, Dynamics) when is_list(Dynamics)-> + {ok, undefined}; +dynamic_child_args(Pid, Dynamics) -> + ?DICT:find(Pid, Dynamics). + +state_del_child(#child{pid = Pid, restart_type = temporary}, State) when ?is_simple(State) -> + NDynamics = lists:delete(Pid, dynamics_db(temporary, State#state.dynamics)), + State#state{dynamics = NDynamics}; +state_del_child(#child{pid = Pid, restart_type = RType}, State) when ?is_simple(State) -> + NDynamics = ?DICT:erase(Pid, dynamics_db(RType, State#state.dynamics)), State#state{dynamics = NDynamics}; state_del_child(Child, State) -> NChildren = del_child(Child#child.name, State#state.children), @@ -738,9 +864,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 +881,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 +897,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 +944,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 +1049,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 6ee837c3e6..b456c5d6c1 100644 --- a/lib/stdlib/src/timer.erl +++ b/lib/stdlib/src/timer.erl @@ -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). @@ -98,6 +101,17 @@ 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. %% diff --git a/lib/stdlib/src/unicode.erl b/lib/stdlib/src/unicode.erl index 09b1deff9c..12bc60623d 100644 --- a/lib/stdlib/src/unicode.erl +++ b/lib/stdlib/src/unicode.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2009. All Rights Reserved. +%% Copyright Ericsson AB 2008-2011. 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 @@ -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). |