diff options
Diffstat (limited to 'lib/stdlib/src')
82 files changed, 3973 insertions, 1936 deletions
diff --git a/lib/stdlib/src/Makefile b/lib/stdlib/src/Makefile index 9f4a446ea0..302834f9d0 100644 --- a/lib/stdlib/src/Makefile +++ b/lib/stdlib/src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1996-2015. All Rights Reserved. +# Copyright Ericsson AB 1996-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -85,6 +85,7 @@ MODULES= \ gen_event \ gen_fsm \ gen_server \ + gen_statem \ io \ io_lib \ io_lib_format \ diff --git a/lib/stdlib/src/array.erl b/lib/stdlib/src/array.erl index c749dd008b..d5757dda5b 100644 --- a/lib/stdlib/src/array.erl +++ b/lib/stdlib/src/array.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2014. All Rights Reserved. +%% Copyright Ericsson AB 2007-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/lib/stdlib/src/base64.erl b/lib/stdlib/src/base64.erl index ac532f7ee0..bf259e6691 100644 --- a/lib/stdlib/src/base64.erl +++ b/lib/stdlib/src/base64.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2013. All Rights Reserved. +%% Copyright Ericsson AB 2007-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/lib/stdlib/src/beam_lib.erl b/lib/stdlib/src/beam_lib.erl index b93ce97cd3..d7ee5c1f5d 100644 --- a/lib/stdlib/src/beam_lib.erl +++ b/lib/stdlib/src/beam_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2015. All Rights Reserved. +%% Copyright Ericsson AB 2000-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -46,7 +46,7 @@ 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]). +-export_type([attrib_entry/0, compinfo_entry/0, labeled_entry/0, label/0]). -import(lists, [append/1, delete/2, foreach/2, keysort/2, member/2, reverse/1, sort/1, splitwith/2]). @@ -55,7 +55,7 @@ -type beam() :: module() | file:filename() | binary(). --type forms() :: [erl_parse:abstract_form()]. +-type forms() :: [erl_parse:abstract_form() | erl_parse:form_info()]. -type abst_code() :: {AbstVersion :: atom(), forms()} | 'no_abstract_code'. -type dataB() :: binary(). @@ -308,6 +308,17 @@ make_crypto_key(des3_cbc=Type, String) -> <<K3:8/binary,IVec:8/binary>> = erlang:md5([First|reverse(String)]), {Type,[K1,K2,K3],IVec,8}. +-spec build_module(Chunks) -> {'ok', Binary} when + Chunks :: [{chunkid(), dataB()}], + Binary :: binary(). + +build_module(Chunks0) -> + Chunks = list_to_binary(build_chunks(Chunks0)), + Size = byte_size(Chunks), + 0 = Size rem 4, % Assertion: correct padding? + {ok, <<"FOR1", (Size+4):32, "BEAM", Chunks/binary>>}. + + %% %% Local functions %% @@ -419,12 +430,6 @@ strip_file(File) -> end end. -build_module(Chunks0) -> - Chunks = list_to_binary(build_chunks(Chunks0)), - Size = byte_size(Chunks), - 0 = Size rem 4, % Assertion: correct padding? - {ok, <<"FOR1", (Size+4):32, "BEAM", Chunks/binary>>}. - build_chunks([{Id, Data} | Chunks]) -> BId = list_to_binary(Id), Size = byte_size(Data), @@ -867,7 +872,7 @@ mandatory_chunks() -> %%% can use it. %%% ==================================================================== --record(state, {crypto_key_f :: crypto_fun()}). +-record(state, {crypto_key_f :: crypto_fun() | 'undefined'}). -define(CRYPTO_KEY_SERVER, beam_lib__crypto_key_server). @@ -899,7 +904,11 @@ anno_from_term({Tag, Forms}) when Tag =:= abstract_v1; Tag =:= abstract_v2 -> anno_from_term(T) -> T. -anno_from_forms(Forms) -> +anno_from_forms(Forms0) -> + %% Forms with record field types created before OTP 19.0 are + %% replaced by well-formed record forms holding the type + %% information. + Forms = epp:restore_typed_record_fields(Forms0), [erl_parse:anno_from_term(Form) || Form <- Forms]. start_crypto() -> @@ -926,7 +935,10 @@ call_crypto_server(Req) -> end. call_crypto_server_1(Req) -> - {ok, _} = gen_server:start({local,?CRYPTO_KEY_SERVER}, ?MODULE, [], []), + case gen_server:start({local,?CRYPTO_KEY_SERVER}, ?MODULE, [], []) of + {ok, _} -> ok; + {error, {already_started, _}} -> ok + end, erlang:yield(), call_crypto_server(Req). @@ -967,9 +979,7 @@ handle_call({get_crypto_key, What}, From, #state{crypto_key_f=F}=S) -> handle_call({crypto_key_fun, F}, {_,_} = From, S) -> case S#state.crypto_key_f of undefined -> - %% Don't allow tuple funs here. (They weren't allowed before, - %% so there is no reason to allow them now.) - if is_function(F), is_function(F, 1) -> + if is_function(F, 1) -> {Result, Fun, Reply} = case catch F(init) of ok -> diff --git a/lib/stdlib/src/binary.erl b/lib/stdlib/src/binary.erl index af00410572..ccc827ca2d 100644 --- a/lib/stdlib/src/binary.erl +++ b/lib/stdlib/src/binary.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2013. All Rights Reserved. +%% Copyright Ericsson AB 2010-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -20,7 +20,7 @@ -module(binary). %% %% Implemented in this module: --export([split/2,split/3,replace/3,replace/4]). +-export([replace/3,replace/4]). -export_type([cp/0]). @@ -34,7 +34,8 @@ decode_unsigned/2, encode_unsigned/1, encode_unsigned/2, first/1, last/1, list_to_bin/1, longest_common_prefix/1, longest_common_suffix/1, match/2, match/3, matches/2, - matches/3, part/2, part/3, referenced_byte_size/1]). + matches/3, part/2, part/3, referenced_byte_size/1, + split/2, split/3]). -spec at(Subject, Pos) -> byte() when Subject :: binary(), @@ -198,19 +199,13 @@ part(_, _, _) -> referenced_byte_size(_) -> erlang:nif_error(undef). -%%% End of BIFs. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% split -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -spec split(Subject, Pattern) -> Parts when Subject :: binary(), Pattern :: binary() | [binary()] | cp(), Parts :: [binary()]. -split(H,N) -> - split(H,N,[]). +split(_, _) -> + erlang:nif_error(undef). -spec split(Subject, Pattern, Options) -> Parts when Subject :: binary(), @@ -219,53 +214,10 @@ split(H,N) -> Option :: {scope, part()} | trim | global | trim_all, Parts :: [binary()]. -split(Haystack,Needles,Options) -> - try - {Part,Global,Trim,TrimAll} = - get_opts_split(Options,{no,false,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,TrimAll) - catch - _:_ -> - erlang:error(badarg) - end. - -do_split(H,[],N,true,_) when N >= byte_size(H) -> - []; -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,TrimAll) -> - case binary:part(H,{N,A-N}) of - <<>> when TrimAll == true -> - do_split(H,T,A+B,Trim,TrimAll); - <<>> -> - Rest = do_split(H,T,A+B,Trim,TrimAll), - case {Trim, Rest} of - {true,[]} -> - []; - _ -> - [<<>> | Rest] - end; - Oth -> - [Oth | do_split(H,T,A+B,Trim,TrimAll)] - end. +split(_, _, _) -> + erlang:nif_error(undef). +%%% End of BIFs. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% replace @@ -352,19 +304,6 @@ splitat(H,N,[I|T]) -> %% Simple helper functions %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -get_opts_split([],{Part,Global,Trim,TrimAll}) -> - {Part,Global,Trim,TrimAll}; -get_opts_split([{scope,{A,B}} | T],{_Part,Global,Trim,TrimAll}) -> - get_opts_split(T,{{A,B},Global,Trim,TrimAll}); -get_opts_split([global | T],{Part,_Global,Trim,TrimAll}) -> - get_opts_split(T,{Part,true,Trim,TrimAll}); -get_opts_split([trim | T],{Part,Global,_Trim,TrimAll}) -> - get_opts_split(T,{Part,Global,true,TrimAll}); -get_opts_split([trim_all | T],{Part,Global,Trim,_TrimAll}) -> - get_opts_split(T,{Part,Global,Trim,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}) -> diff --git a/lib/stdlib/src/c.erl b/lib/stdlib/src/c.erl index a8844d757d..ad4915eabe 100644 --- a/lib/stdlib/src/c.erl +++ b/lib/stdlib/src/c.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/lib/stdlib/src/calendar.erl b/lib/stdlib/src/calendar.erl index 074c504e00..55a0cfc9a1 100644 --- a/lib/stdlib/src/calendar.erl +++ b/lib/stdlib/src/calendar.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/lib/stdlib/src/dets.erl b/lib/stdlib/src/dets.erl index 6d07f4018a..bf22949870 100644 --- a/lib/stdlib/src/dets.erl +++ b/lib/stdlib/src/dets.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -372,7 +372,7 @@ info(Tab) -> Item :: 'access' | 'auto_save' | 'bchunk_format' | 'hash' | 'file_size' | 'filename' | 'keypos' | 'memory' | 'no_keys' | 'no_objects' | 'no_slots' | 'owner' | 'ram_file' - | 'safe_fixed' | 'size' | 'type' | 'version', + | 'safe_fixed' | 'safe_fixed_monotonic_time' | 'size' | 'type' | 'version', Value :: term(). info(Tab, owner) -> @@ -1124,7 +1124,9 @@ repl({delayed_write, {Delay,Size} = C}, Defs) Defs#open_args{delayed_write = C}; repl({estimated_no_objects, I}, Defs) -> repl({min_no_slots, I}, Defs); -repl({file, File}, Defs) -> +repl({file, File}, Defs) when is_list(File) -> + Defs#open_args{file = File}; +repl({file, File}, Defs) when is_atom(File) -> Defs#open_args{file = to_list(File)}; repl({keypos, P}, Defs) when is_integer(P), P > 0 -> Defs#open_args{keypos =P}; @@ -1289,7 +1291,15 @@ init(Parent, Server) -> open_file_loop(#head{parent = Parent, server = Server}). open_file_loop(Head) -> - open_file_loop(Head, 0). + %% The Dets server pretends the file is open before + %% internal_open() has been called, which means that unless the + %% internal_open message is applied first, other processes can + %% find the pid by calling dets_server:get_pid() and do things + %% before Head has been initialized properly. + receive + ?DETS_CALL(From, {internal_open, _Ref, _Args}=Op) -> + do_apply_op(Op, From, Head, 0) + end. open_file_loop(Head, N) when element(1, Head#head.update_mode) =:= error -> open_file_loop2(Head, N); @@ -1964,7 +1974,9 @@ do_safe_fixtable(Head, Pid, true) -> case Head#head.fixed of false -> link(Pid), - Fixed = {utime_now(), [{Pid, 1}]}, + MonTime = erlang:monotonic_time(), + TimeOffset = erlang:time_offset(), + Fixed = {{MonTime, TimeOffset}, [{Pid, 1}]}, Ftab = dets_utils:get_freelists(Head), Head#head{fixed = Fixed, freelists = {Ftab, Ftab}}; {TimeStamp, Counters} -> @@ -2091,7 +2103,22 @@ finfo(H, no_keys) -> finfo(H, no_slots) -> {H, (H#head.mod):no_slots(H)}; finfo(H, pid) -> {H, self()}; finfo(H, ram_file) -> {H, H#head.ram_file}; -finfo(H, safe_fixed) -> {H, H#head.fixed}; +finfo(H, safe_fixed) -> + {H, + case H#head.fixed of + false -> + false; + {{FixMonTime, TimeOffset}, RefList} -> + {make_timestamp(FixMonTime, TimeOffset), RefList} + end}; +finfo(H, safe_fixed_monotonic_time) -> + {H, + case H#head.fixed of + false -> + false; + {{FixMonTime, _TimeOffset}, RefList} -> + {FixMonTime, RefList} + end}; finfo(H, size) -> case catch write_cache(H) of {H2, []} -> @@ -3275,11 +3302,14 @@ err(Error) -> time_now() -> erlang:monotonic_time(1000000). --compile({inline, [utime_now/0]}). -utime_now() -> - Time = time_now(), - UniqueCounter = erlang:unique_integer([monotonic]), - {Time, UniqueCounter}. +make_timestamp(MonTime, TimeOffset) -> + ErlangSystemTime = erlang:convert_time_unit(MonTime+TimeOffset, + native, + micro_seconds), + MegaSecs = ErlangSystemTime div 1000000000000, + Secs = ErlangSystemTime div 1000000 - MegaSecs*1000000, + MicroSecs = ErlangSystemTime rem 1000000, + {MegaSecs, Secs, MicroSecs}. %%%%%%%%%%%%%%%%% DEBUG functions %%%%%%%%%%%%%%%% diff --git a/lib/stdlib/src/dets.hrl b/lib/stdlib/src/dets.hrl index be51e1a89c..6ebeb96156 100644 --- a/lib/stdlib/src/dets.hrl +++ b/lib/stdlib/src/dets.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2011. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/lib/stdlib/src/dets_server.erl b/lib/stdlib/src/dets_server.erl index e3c9447c6f..b02d6ae159 100644 --- a/lib/stdlib/src/dets_server.erl +++ b/lib/stdlib/src/dets_server.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2014. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/lib/stdlib/src/dets_sup.erl b/lib/stdlib/src/dets_sup.erl index e0087c58b4..43609cb8a1 100644 --- a/lib/stdlib/src/dets_sup.erl +++ b/lib/stdlib/src/dets_sup.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2010. All Rights Reserved. +%% Copyright Ericsson AB 2002-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/lib/stdlib/src/dets_utils.erl b/lib/stdlib/src/dets_utils.erl index 196158cd48..34a8ddddaa 100644 --- a/lib/stdlib/src/dets_utils.erl +++ b/lib/stdlib/src/dets_utils.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2013. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -747,6 +747,8 @@ all_allocated([{X,Y} | L], _X0, Y0, A) when Y0 < X -> all_allocated_as_list(Head) -> all_allocated_as_list(all(get_freelists(Head)), 0, Head#head.base, []). +-dialyzer({no_improper_lists, all_allocated_as_list/4}). + all_allocated_as_list([], _X0, _Y0, []) -> []; all_allocated_as_list([], _X0, _Y0, A) -> diff --git a/lib/stdlib/src/dets_v8.erl b/lib/stdlib/src/dets_v8.erl index 49126193b8..1bf53d91b1 100644 --- a/lib/stdlib/src/dets_v8.erl +++ b/lib/stdlib/src/dets_v8.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2013. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -36,6 +36,8 @@ %% For backward compatibility. -export([sz2pos/1]). +-dialyzer(no_improper_lists). + -compile({inline, [{sz2pos,1},{scan_skip,7}]}). -compile({inline, [{skip_bytes,5}, {get_segp,1}]}). -compile({inline, [{wl_lookup,5}]}). diff --git a/lib/stdlib/src/dets_v9.erl b/lib/stdlib/src/dets_v9.erl index 361780c776..6c406fc03a 100644 --- a/lib/stdlib/src/dets_v9.erl +++ b/lib/stdlib/src/dets_v9.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2013. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -34,6 +34,8 @@ -export([cache_segps/3]). +-dialyzer(no_improper_lists). + -compile({inline, [{max_objsize,1},{maxobjsize,1}]}). -compile({inline, [{write_segment_file,6}]}). -compile({inline, [{sz2pos,1},{adjsz,1}]}). diff --git a/lib/stdlib/src/dict.erl b/lib/stdlib/src/dict.erl index 6ce3710f87..f921e28ef6 100644 --- a/lib/stdlib/src/dict.erl +++ b/lib/stdlib/src/dict.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2014. All Rights Reserved. +%% Copyright Ericsson AB 2000-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -333,6 +333,8 @@ update_counter(Key, Incr, D0) when is_number(Incr) -> D0, Slot), maybe_expand(D1, Ic). +-dialyzer({no_improper_lists, counter_bkt/3}). + counter_bkt(Key, I, [?kv(Key,Val)|Bkt]) -> {[?kv(Key,Val+I)|Bkt],0}; counter_bkt(Key, I, [Other|Bkt0]) -> diff --git a/lib/stdlib/src/digraph.erl b/lib/stdlib/src/digraph.erl index e51e560542..8a4df95027 100644 --- a/lib/stdlib/src/digraph.erl +++ b/lib/stdlib/src/digraph.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -338,6 +338,8 @@ edge(G, E) -> %% -spec new_edge_id(graph()) -> edge(). +-dialyzer({no_improper_lists, new_edge_id/1}). + new_edge_id(G) -> NT = G#digraph.ntab, [{'$eid', K}] = ets:lookup(NT, '$eid'), @@ -350,6 +352,8 @@ new_edge_id(G) -> %% -spec new_vertex_id(graph()) -> vertex(). +-dialyzer({no_improper_lists, new_vertex_id/1}). + new_vertex_id(G) -> NT = G#digraph.ntab, [{'$vid', K}] = ets:lookup(NT, '$vid'), diff --git a/lib/stdlib/src/digraph_utils.erl b/lib/stdlib/src/digraph_utils.erl index ef4c2e94fe..4aa9ae810d 100644 --- a/lib/stdlib/src/digraph_utils.erl +++ b/lib/stdlib/src/digraph_utils.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2014. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/lib/stdlib/src/edlin.erl b/lib/stdlib/src/edlin.erl index 8c7a984f1c..71e8471c45 100644 --- a/lib/stdlib/src/edlin.erl +++ b/lib/stdlib/src/edlin.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -227,6 +227,8 @@ key_map($F, meta_o) -> end_of_line; key_map($\177, none) -> backward_delete_char; key_map($\177, meta) -> backward_kill_word; key_map($[, meta) -> meta_left_sq_bracket; +key_map($H, meta_left_sq_bracket) -> beginning_of_line; +key_map($F, meta_left_sq_bracket) -> end_of_line; key_map($D, meta_left_sq_bracket) -> backward_char; key_map($C, meta_left_sq_bracket) -> forward_char; % support a few <CTRL>+<CURSOR LEFT|RIGHT> combinations... @@ -237,8 +239,10 @@ key_map($[, meta_meta) -> meta_csi; key_map($C, meta_csi) -> forward_word; key_map($D, meta_csi) -> backward_word; key_map($1, meta_left_sq_bracket) -> {csi, "1"}; +key_map($3, meta_left_sq_bracket) -> {csi, "3"}; key_map($5, meta_left_sq_bracket) -> {csi, "5"}; key_map($5, {csi, "1;"}) -> {csi, "1;5"}; +key_map($~, {csi, "3"}) -> forward_delete_char; key_map($C, {csi, "5"}) -> forward_word; key_map($C, {csi, "1;5"}) -> forward_word; key_map($D, {csi, "5"}) -> backward_word; @@ -461,7 +465,6 @@ word_char(C) when C >= $a, C =< $z -> true; word_char(C) when C >= $ß, C =< $ÿ, C =/= $÷ -> true; word_char(C) when C >= $0, C =< $9 -> true; word_char(C) when C =:= $_ -> true; -word_char(C) when C =:= $. -> true; % accept dot-separated names word_char(_) -> false. %% over_white(Chars, InitialStack, InitialCount) -> diff --git a/lib/stdlib/src/edlin_expand.erl b/lib/stdlib/src/edlin_expand.erl index 6dd736da4c..5f821caef0 100644 --- a/lib/stdlib/src/edlin_expand.erl +++ b/lib/stdlib/src/edlin_expand.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2010. All Rights Reserved. +%% Copyright Ericsson AB 2005-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -118,7 +118,7 @@ format_col([A|T], Width, Len, Acc0) -> {H1, _} -> H1; H2 -> H2 end, - Acc = [io_lib:format("~-*s", [Width,H]) | Acc0], + Acc = [io_lib:format("~-*ts", [Width,H]) | Acc0], format_col(T, Width, Len+Width, Acc); format_col([], _, _, Acc) -> lists:reverse(Acc, "\n"). diff --git a/lib/stdlib/src/epp.erl b/lib/stdlib/src/epp.erl index d3124ac593..40eba4ad67 100644 --- a/lib/stdlib/src/epp.erl +++ b/lib/stdlib/src/epp.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2015. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -40,16 +40,26 @@ -type ifdef() :: 'ifdef' | 'ifndef' | 'else'. --type name() :: {'atom', atom()}. +-type name() :: atom(). -type argspec() :: 'none' %No arguments | non_neg_integer(). %Number of arguments +-type argnames() :: [atom()]. -type tokens() :: [erl_scan:token()]. +-type predef() :: 'undefined' | {'none', tokens()}. +-type userdef() :: {argspec(), {argnames(), tokens()}}. -type used() :: {name(), argspec()}. +-type function_name_type() :: 'undefined' + | {atom(),non_neg_integer()} + | tokens(). + +-type warning_info() :: {erl_anno:location(), module(), term()}. + -define(DEFAULT_ENCODING, utf8). %% Epp state record. --record(epp, {file :: file:io_device(), %Current file +-record(epp, {file :: file:io_device() + | 'undefined', %Current file location=1, %Current location delta=0 :: non_neg_integer(), %Offset from Location (-file) name="" :: file:name(), %Current file name @@ -57,21 +67,15 @@ istk=[] :: [ifdef()], %Ifdef stack sstk=[] :: [#epp{}], %State stack path=[] :: [file:name()], %Include-path - macs = dict:new() %Macros (don't care locations) - :: dict:dict(name(), {argspec(), tokens()}), - uses = dict:new() %Macro use structure - :: dict:dict(name(), [{argspec(), [used()]}]), + macs = #{} %Macros (don't care locations) + :: #{name() => predef() | [userdef()]}, + uses = #{} %Macro use structure + :: #{name() => [{argspec(), [used()]}]}, default_encoding = ?DEFAULT_ENCODING :: source_encoding(), - pre_opened = false :: boolean() + pre_opened = false :: boolean(), + fname = [] :: function_name_type() }). -%%% Note on representation: as tokens, both {var, Location, Name} and -%%% {atom, Location, Name} can occur as macro identifiers. However, keeping -%%% this distinction here is done for historical reasons only: previously, -%%% ?FOO and ?'FOO' were not the same, but now they are. Removing the -%%% distinction in the internal representation would simplify the code -%%% a little. - %% open(Options) %% open(FileName, IncludePath) %% open(FileName, IncludePath, PreDefMacros) @@ -156,11 +160,13 @@ scan_erl_form(Epp) -> epp_request(Epp, scan_erl_form). -spec parse_erl_form(Epp) -> - {'ok', AbsForm} | {'eof', Line} | {error, ErrorInfo} when + {'ok', AbsForm} | {error, ErrorInfo} | + {'warning',WarningInfo} | {'eof',Line} when Epp :: epp_handle(), AbsForm :: erl_parse:abstract_form(), Line :: erl_anno:line(), - ErrorInfo :: erl_scan:error_info() | erl_parse:error_info(). + ErrorInfo :: erl_scan:error_info() | erl_parse:error_info(), + WarningInfo :: warning_info(). parse_erl_form(Epp) -> case epp_request(Epp, scan_erl_form) of @@ -211,8 +217,16 @@ format_error({include,W,F}) -> io_lib:format("can't find include ~s \"~s\"", [W,F]); format_error({illegal,How,What}) -> io_lib:format("~s '-~s'", [How,What]); +format_error({illegal_function,Macro}) -> + io_lib:format("?~s can only be used within a function", [Macro]); +format_error({illegal_function_usage,Macro}) -> + io_lib:format("?~s must not begin a form", [Macro]); format_error({'NYI',What}) -> io_lib:format("not yet implemented '~s'", [What]); +format_error({error,Term}) -> + io_lib:format("-error(~p).", [Term]); +format_error({warning,Term}) -> + io_lib:format("-warning(~p).", [Term]); format_error(E) -> file:format_error(E). -spec parse_file(FileName, IncludePath, PredefMacros) -> @@ -257,29 +271,20 @@ parse_file(Ifile, Options) -> -spec parse_file(Epp) -> [Form] when Epp :: epp_handle(), - Form :: erl_parse:abstract_form() | {'error', ErrorInfo} | {'eof',Line}, + Form :: erl_parse:abstract_form() | {'error', ErrorInfo} | + {'warning',WarningInfo} | {'eof',Line}, Line :: erl_anno:line(), - ErrorInfo :: erl_scan:error_info() | erl_parse:error_info(). + ErrorInfo :: erl_scan:error_info() | erl_parse:error_info(), + WarningInfo :: warning_info(). parse_file(Epp) -> case parse_erl_form(Epp) of {ok,Form} -> - case Form of - {attribute,La,record,{Record, Fields}} -> - case normalize_typed_record_fields(Fields) of - {typed, NewFields} -> - [{attribute, La, record, {Record, NewFields}}, - {attribute, La, type, - {{record, Record}, Fields, []}} - |parse_file(Epp)]; - not_typed -> - [Form|parse_file(Epp)] - end; - _ -> - [Form|parse_file(Epp)] - end; + [Form|parse_file(Epp)]; {error,E} -> [{error,E}|parse_file(Epp)]; + {warning,W} -> + [{warning,W}|parse_file(Epp)]; {eof,Location} -> [{eof,erl_anno:new(Location)}] end. @@ -549,7 +554,8 @@ init_server(Pid, Name, Options, St0) -> default_encoding=DefEncoding}, From = wait_request(St), Anno = erl_anno:new(AtLocation), - enter_file_reply(From, Name, Anno, AtLocation, code), + enter_file_reply(From, file_name(Name), Anno, + AtLocation, code), wait_req_scan(St); {error,E} -> epp_reply(Pid, {error,E}) @@ -560,18 +566,20 @@ init_server(Pid, Name, Options, St0) -> %% FILE, LINE, MODULE as undefined, MACHINE and MACHINE value. predef_macros(File) -> - Machine = list_to_atom(erlang:system_info(machine)), - Anno = line1(), - dict:from_list([ - {{atom,'FILE'}, {none,[{string,Anno,File}]}}, - {{atom,'LINE'}, {none,[{integer,Anno,1}]}}, - {{atom,'MODULE'}, undefined}, - {{atom,'MODULE_STRING'}, undefined}, - {{atom,'BASE_MODULE'}, undefined}, - {{atom,'BASE_MODULE_STRING'}, undefined}, - {{atom,'MACHINE'}, {none,[{atom,Anno,Machine}]}}, - {{atom,Machine}, {none,[{atom,Anno,true}]}} - ]). + Machine = list_to_atom(erlang:system_info(machine)), + Anno = line1(), + Defs = [{'FILE', {none,[{string,Anno,File}]}}, + {'FUNCTION_NAME', undefined}, + {'FUNCTION_ARITY', undefined}, + {'LINE', {none,[{integer,Anno,1}]}}, + {'MODULE', undefined}, + {'MODULE_STRING', undefined}, + {'BASE_MODULE', undefined}, + {'BASE_MODULE_STRING', undefined}, + {'MACHINE', {none,[{atom,Anno,Machine}]}}, + {Machine, {none,[{atom,Anno,true}]}} + ], + maps:from_list(Defs). %% user_predef(PreDefMacros, Macros) -> %% {ok,MacroDict} | {error,E} @@ -580,28 +588,21 @@ predef_macros(File) -> user_predef([{M,Val,redefine}|Pdm], Ms) when is_atom(M) -> Exp = erl_parse:tokens(erl_parse:abstract(Val)), - user_predef(Pdm, dict:store({atom,M}, {none,Exp}, Ms)); + user_predef(Pdm, Ms#{M=>{none,Exp}}); user_predef([{M,Val}|Pdm], Ms) when is_atom(M) -> - case dict:find({atom,M}, Ms) of - {ok,_Defs} when is_list(_Defs) -> %% User defined macros + case Ms of + #{M:=Defs} when is_list(Defs) -> + %% User defined macros. {error,{redefine,M}}; - {ok,_Def} -> %% Predefined macros + #{M:=_Defs} -> + %% Predefined macros. {error,{redefine_predef,M}}; - error -> + _ -> Exp = erl_parse:tokens(erl_parse:abstract(Val)), - user_predef(Pdm, dict:store({atom,M}, [{none, {none,Exp}}], Ms)) + user_predef(Pdm, Ms#{M=>[{none,{none,Exp}}]}) end; user_predef([M|Pdm], Ms) when is_atom(M) -> - case dict:find({atom,M}, Ms) of - {ok,_Defs} when is_list(_Defs) -> %% User defined macros - {error,{redefine,M}}; - {ok,_Def} -> %% Predefined macros - {error,{redefine_predef,M}}; - error -> - A = line1(), - user_predef(Pdm, - dict:store({atom,M}, [{none, {none,[{atom,A,true}]}}], Ms)) - end; + user_predef([{M,true}|Pdm], Ms); user_predef([Md|_Pdm], _Ms) -> {error,{bad,Md}}; user_predef([], Ms) -> {ok,Ms}. @@ -615,7 +616,9 @@ wait_request(St) -> receive {epp_request,From,scan_erl_form} -> From; {epp_request,From,macro_defs} -> - epp_reply(From, dict:to_list(St#epp.macs)), + %% Return the old format to avoid any incompability issues. + Defs = [{{atom,K},V} || {K,V} <- maps:to_list(St#epp.macs)], + epp_reply(From, Defs), wait_request(St); {epp_request,From,close} -> close_file(St), @@ -667,7 +670,8 @@ enter_file(NewName, Inc, From, St) -> enter_file2(NewF, Pname, From, St0, AtLocation) -> Anno = erl_anno:new(AtLocation), enter_file_reply(From, Pname, Anno, AtLocation, code), - Ms = dict:store({atom,'FILE'}, {none,[{string,Anno,Pname}]}, St0#epp.macs), + Ms0 = St0#epp.macs, + Ms = Ms0#{'FILE':={none,[{string,Anno,Pname}]}}, %% update the head of the include path to be the directory of the new %% source file, so that an included file can always include other files %% relative to its current location (this is also how C does it); note @@ -688,7 +692,7 @@ enter_file_reply(From, Name, LocationAnno, AtLocation, Where) -> generated -> erl_anno:set_generated(true, Anno0) end, Rep = {ok, [{'-',Anno},{atom,Anno,file},{'(',Anno}, - {string,Anno,file_name(Name)},{',',Anno}, + {string,Anno,Name},{',',Anno}, {integer,Anno,get_line(LocationAnno)},{')',LocationAnno}, {dot,Anno}]}, epp_reply(From, Rep). @@ -719,9 +723,8 @@ leave_file(From, St) -> name2=OldName2} = OldSt, CurrLoc = add_line(OldLoc, Delta), Anno = erl_anno:new(CurrLoc), - Ms = dict:store({atom,'FILE'}, - {none,[{string,Anno,OldName2}]}, - St#epp.macs), + Ms0 = St#epp.macs, + Ms = Ms0#{'FILE':={none,[{string,Anno,OldName2}]}}, NextSt = OldSt#epp{sstk=Sts,macs=Ms,uses=St#epp.uses}, enter_file_reply(From, OldName, Anno, CurrLoc, code), case OldName2 =:= OldName of @@ -761,6 +764,10 @@ scan_toks([{'-',_Lh},{atom,_Ld,define}=Define|Toks], From, St) -> scan_define(Toks, Define, From, St); scan_toks([{'-',_Lh},{atom,_Ld,undef}=Undef|Toks], From, St) -> scan_undef(Toks, Undef, From, St); +scan_toks([{'-',_Lh},{atom,_Ld,error}=Error|Toks], From, St) -> + scan_err_warn(Toks, Error, From, St); +scan_toks([{'-',_Lh},{atom,_Ld,warning}=Warn|Toks], From, St) -> + scan_err_warn(Toks, Warn, From, St); scan_toks([{'-',_Lh},{atom,_Li,include}=Inc|Toks], From, St) -> scan_include(Toks, Inc, From, St); scan_toks([{'-',_Lh},{atom,_Li,include_lib}=IncLib|Toks], From, St) -> @@ -778,7 +785,7 @@ scan_toks([{'-',_Lh},{atom,_Le,elif}=Elif|Toks], From, St) -> scan_toks([{'-',_Lh},{atom,_Le,endif}=Endif|Toks], From, St) -> scan_endif(Toks, Endif, From, St); scan_toks([{'-',_Lh},{atom,_Lf,file}=FileToken|Toks0], From, St) -> - case catch expand_macros(Toks0, {St#epp.macs, St#epp.uses}) of + case catch expand_macros(Toks0, St) of Toks1 when is_list(Toks1) -> scan_file(Toks1, FileToken, From, St); {error,ErrL,What} -> @@ -786,7 +793,7 @@ scan_toks([{'-',_Lh},{atom,_Lf,file}=FileToken|Toks0], From, St) -> wait_req_scan(St) end; scan_toks(Toks0, From, St) -> - case catch expand_macros(Toks0, {St#epp.macs, St#epp.uses}) of + case catch expand_macros(Toks0, St#epp{fname=Toks0}) of Toks1 when is_list(Toks1) -> epp_reply(From, {ok,Toks1}), wait_req_scan(St#epp{macs=scan_module(Toks1, St#epp.macs)}); @@ -796,91 +803,66 @@ scan_toks(Toks0, From, St) -> end. scan_module([{'-',_Lh},{atom,_Lm,module},{'(',_Ll}|Ts], Ms) -> - scan_module_1(Ts, [], Ms); + scan_module_1(Ts, Ms); scan_module([{'-',_Lh},{atom,_Lm,extends},{'(',_Ll}|Ts], Ms) -> - scan_extends(Ts, [], Ms); + scan_extends(Ts, Ms); scan_module(_Ts, Ms) -> Ms. -scan_module_1([{atom,_,_}=A,{',',L}|Ts], As, Ms) -> +scan_module_1([{atom,_,_}=A,{',',L}|Ts], Ms) -> %% Parameterized modules. - scan_module_1([A,{')',L}|Ts], As, Ms); -scan_module_1([{atom,Ln,A},{')',_Lr}|_Ts], As, Ms0) -> - Mod = lists:concat(lists:reverse([A|As])), - Ms = dict:store({atom,'MODULE'}, - {none,[{atom,Ln,list_to_atom(Mod)}]}, Ms0), - dict:store({atom,'MODULE_STRING'}, {none,[{string,Ln,Mod}]}, Ms); -scan_module_1([{atom,_Ln,A},{'.',_Lr}|Ts], As, Ms) -> - scan_module_1(Ts, [".",A|As], Ms); -scan_module_1([{'.',_Lr}|Ts], As, Ms) -> - scan_module_1(Ts, As, Ms); -scan_module_1(_Ts, _As, Ms) -> Ms. - -scan_extends([{atom,Ln,A},{')',_Lr}|_Ts], As, Ms0) -> - Mod = lists:concat(lists:reverse([A|As])), - Ms = dict:store({atom,'BASE_MODULE'}, - {none,[{atom,Ln,list_to_atom(Mod)}]}, Ms0), - dict:store({atom,'BASE_MODULE_STRING'}, {none,[{string,Ln,Mod}]}, Ms); -scan_extends([{atom,_Ln,A},{'.',_Lr}|Ts], As, Ms) -> - scan_extends(Ts, [".",A|As], Ms); -scan_extends([{'.',_Lr}|Ts], As, Ms) -> - scan_extends(Ts, As, Ms); -scan_extends(_Ts, _As, Ms) -> Ms. + scan_module_1([A,{')',L}|Ts], Ms); +scan_module_1([{atom,Ln,A}=ModAtom,{')',_Lr}|_Ts], Ms0) -> + ModString = atom_to_list(A), + Ms = Ms0#{'MODULE':={none,[ModAtom]}}, + Ms#{'MODULE_STRING':={none,[{string,Ln,ModString}]}}; +scan_module_1(_Ts, Ms) -> Ms. + +scan_extends([{atom,Ln,A}=ModAtom,{')',_Lr}|_Ts], Ms0) -> + ModString = atom_to_list(A), + Ms = Ms0#{'BASE_MODULE':={none,[ModAtom]}}, + Ms#{'BASE_MODULE_STRING':={none,[{string,Ln,ModString}]}}; +scan_extends(_Ts, Ms) -> Ms. + +scan_err_warn([{'(',_}|_]=Toks0, {atom,_,Tag}=Token, From, St) -> + try expand_macros(Toks0, St) of + Toks when is_list(Toks) -> + case erl_parse:parse_term(Toks) of + {ok,Term} -> + epp_reply(From, {Tag,{loc(Token),epp,{Tag,Term}}}); + {error,_} -> + epp_reply(From, {error,{loc(Token),epp,{bad,Tag}}}) + end + catch + _:_ -> + epp_reply(From, {error,{loc(Token),epp,{bad,Tag}}}) + end, + wait_req_scan(St); +scan_err_warn(_Toks, {atom,_,Tag}=Token, From, St) -> + epp_reply(From, {error,{loc(Token),epp,{bad,Tag}}}), + wait_req_scan(St). %% scan_define(Tokens, DefineToken, From, EppState) -scan_define([{'(',_Lp},{Type,_Lm,M}=Mac,{',',_}=Comma|Toks], _Def, From, St) +scan_define([{'(',_Lp},{Type,_Lm,_}=Mac|Toks], Def, From, St) when Type =:= atom; Type =:= var -> + scan_define_1(Toks, Mac, Def, From, St); +scan_define(_Toks, Def, From, St) -> + epp_reply(From, {error,{loc(Def),epp,{bad,define}}}), + wait_req_scan(St). + +scan_define_1([{',',_}=Comma|Toks], Mac,_Def, From, St) -> case catch macro_expansion(Toks, Comma) of Expansion when is_list(Expansion) -> - case dict:find({atom,M}, St#epp.macs) of - {ok, Defs} when is_list(Defs) -> - %% User defined macros: can be overloaded - case proplists:is_defined(none, Defs) of - true -> - epp_reply(From, {error,{loc(Mac),epp,{redefine,M}}}), - wait_req_scan(St); - false -> - scan_define_cont(From, St, - {atom, M}, - {none, {none,Expansion}}) - end; - {ok, _PreDef} -> - %% Predefined macros: cannot be overloaded - epp_reply(From, {error,{loc(Mac),epp,{redefine_predef,M}}}), - wait_req_scan(St); - error -> - scan_define_cont(From, St, - {atom, M}, - {none, {none,Expansion}}) - end; + scan_define_2(none, {none,Expansion}, Mac, From, St); {error,ErrL,What} -> epp_reply(From, {error,{ErrL,epp,What}}), wait_req_scan(St) end; -scan_define([{'(',_Lp},{Type,_Lm,M}=Mac,{'(',_Lc}|Toks], Def, From, St) - when Type =:= atom; Type =:= var -> +scan_define_1([{'(',_Lc}|Toks], Mac, Def, From, St) -> case catch macro_pars(Toks, []) of - {ok, {As,Me}} -> + {ok,{As,_}=MacroDef} -> Len = length(As), - case dict:find({atom,M}, St#epp.macs) of - {ok, Defs} when is_list(Defs) -> - %% User defined macros: can be overloaded - case proplists:is_defined(Len, Defs) of - true -> - epp_reply(From,{error,{loc(Mac),epp,{redefine,M}}}), - wait_req_scan(St); - false -> - scan_define_cont(From, St, {atom, M}, - {Len, {As, Me}}) - end; - {ok, _PreDef} -> - %% Predefined macros: cannot be overloaded - %% (There are currently no predefined F(...) macros.) - epp_reply(From, {error,{loc(Mac),epp,{redefine_predef,M}}}), - wait_req_scan(St); - error -> - scan_define_cont(From, St, {atom, M}, {Len, {As, Me}}) - end; + scan_define_2(Len, MacroDef, Mac, From, St); {error,ErrL,What} -> epp_reply(From, {error,{ErrL,epp,What}}), wait_req_scan(St); @@ -888,10 +870,29 @@ scan_define([{'(',_Lp},{Type,_Lm,M}=Mac,{'(',_Lc}|Toks], Def, From, St) epp_reply(From, {error,{loc(Def),epp,{bad,define}}}), wait_req_scan(St) end; -scan_define(_Toks, Def, From, St) -> +scan_define_1(_Toks, _Mac, Def, From, St) -> epp_reply(From, {error,{loc(Def),epp,{bad,define}}}), wait_req_scan(St). +scan_define_2(Arity, Def, {_,_,Key}=Mac, From, #epp{macs=Ms}=St) -> + case Ms of + #{Key:=Defs} when is_list(Defs) -> + %% User defined macros: can be overloaded + case proplists:is_defined(Arity, Defs) of + true -> + epp_reply(From, {error,{loc(Mac),epp,{redefine,Key}}}), + wait_req_scan(St); + false -> + scan_define_cont(From, St, Key, Defs, Arity, Def) + end; + #{Key:=_} -> + %% Predefined macros: cannot be overloaded + epp_reply(From, {error,{loc(Mac),epp,{redefine_predef,Key}}}), + wait_req_scan(St); + _ -> + scan_define_cont(From, St, Key, [], Arity, Def) + end. + %%% Detection of circular macro expansions (which would either keep %%% the compiler looping forever, or run out of memory): %%% When a macro is defined, we store the names of other macros it @@ -901,11 +902,17 @@ scan_define(_Toks, Def, From, St) -> %%% the information from St#epp.uses is traversed, and if a circularity %%% is detected, an error message is thrown. -scan_define_cont(F, St, M, {Arity, Def}) -> - Ms = dict:append_list(M, [{Arity, Def}], St#epp.macs), - try dict:append_list(M, [{Arity, macro_uses(Def)}], St#epp.uses) of +scan_define_cont(F, #epp{macs=Ms0}=St, M, Defs, Arity, Def) -> + Ms = Ms0#{M=>[{Arity,Def}|Defs]}, + try macro_uses(Def) of U -> - scan_toks(F, St#epp{uses=U, macs=Ms}) + Uses0 = St#epp.uses, + Val = [{Arity,U}|case Uses0 of + #{M:=UseList} -> UseList; + _ -> [] + end], + Uses = Uses0#{M=>Val}, + scan_toks(F, St#epp{uses=Uses,macs=Ms}) catch {error, Line, Reason} -> epp_reply(F, {error,{Line,epp,Reason}}), @@ -923,23 +930,23 @@ macro_ref([{'?', _}, {'?', _} | Rest]) -> macro_ref([{'?', _}, {atom, _, A}=Atom | Rest]) -> Lm = loc(Atom), Arity = count_args(Rest, Lm, A), - [{{atom, A}, Arity} | macro_ref(Rest)]; + [{A,Arity} | macro_ref(Rest)]; macro_ref([{'?', _}, {var, _, A}=Var | Rest]) -> Lm = loc(Var), Arity = count_args(Rest, Lm, A), - [{{atom, A}, Arity} | macro_ref(Rest)]; + [{A,Arity} | macro_ref(Rest)]; macro_ref([_Token | Rest]) -> macro_ref(Rest). %% scan_undef(Tokens, UndefToken, From, EppState) scan_undef([{'(',_Llp},{atom,_Lm,M},{')',_Lrp},{dot,_Ld}], _Undef, From, St) -> - Macs = dict:erase({atom,M}, St#epp.macs), - Uses = dict:erase({atom,M}, St#epp.uses), + Macs = maps:remove(M, St#epp.macs), + Uses = maps:remove(M, St#epp.uses), scan_toks(From, St#epp{macs=Macs, uses=Uses}); scan_undef([{'(',_Llp},{var,_Lm,M},{')',_Lrp},{dot,_Ld}], _Undef, From,St) -> - Macs = dict:erase({atom,M}, St#epp.macs), - Uses = dict:erase({atom,M}, St#epp.uses), + Macs = maps:remove(M, St#epp.macs), + Uses = maps:remove(M, St#epp.uses), scan_toks(From, St#epp{macs=Macs, uses=Uses}); scan_undef(_Toks, Undef, From, St) -> epp_reply(From, {error,{loc(Undef),epp,{bad,undef}}}), @@ -947,11 +954,15 @@ scan_undef(_Toks, Undef, From, St) -> %% scan_include(Tokens, IncludeToken, From, St) -scan_include([{'(',_Llp},{string,_Lf,NewName0},{')',_Lrp},{dot,_Ld}], Inc, - From, St) -> +scan_include(Tokens0, Inc, From, St) -> + Tokens = coalesce_strings(Tokens0), + scan_include1(Tokens, Inc, From, St). + +scan_include1([{'(',_Llp},{string,_Lf,NewName0},{')',_Lrp},{dot,_Ld}], Inc, + From, St) -> NewName = expand_var(NewName0), enter_file(NewName, Inc, From, St); -scan_include(_Toks, Inc, From, St) -> +scan_include1(_Toks, Inc, From, St) -> epp_reply(From, {error,{loc(Inc),epp,{bad,include}}}), wait_req_scan(St). @@ -960,29 +971,38 @@ scan_include(_Toks, Inc, From, St) -> %% normal search path, if not we assume that the first directory name %% is a library name, find its true directory and try with that. -find_lib_dir(NewName) -> - [Lib | Rest] = filename:split(NewName), - {code:lib_dir(list_to_atom(Lib)), Rest}. +expand_lib_dir(Name) -> + try + [App|Path] = filename:split(Name), + LibDir = code:lib_dir(list_to_atom(App)), + {ok,fname_join([LibDir|Path])} + catch + _:_ -> + error + end. + +scan_include_lib(Tokens0, Inc, From, St) -> + Tokens = coalesce_strings(Tokens0), + scan_include_lib1(Tokens, Inc, From, St). -scan_include_lib([{'(',_Llp},{string,_Lf,_NewName0},{')',_Lrp},{dot,_Ld}], - Inc, From, St) +scan_include_lib1([{'(',_Llp},{string,_Lf,_NewName0},{')',_Lrp},{dot,_Ld}], + Inc, From, St) when length(St#epp.sstk) >= 8 -> epp_reply(From, {error,{loc(Inc),epp,{depth,"include_lib"}}}), wait_req_scan(St); -scan_include_lib([{'(',_Llp},{string,_Lf,NewName0},{')',_Lrp},{dot,_Ld}], - Inc, From, St) -> +scan_include_lib1([{'(',_Llp},{string,_Lf,NewName0},{')',_Lrp},{dot,_Ld}], + Inc, From, St) -> NewName = expand_var(NewName0), Loc = start_loc(St#epp.location), case file:path_open(St#epp.path, NewName, [read]) of {ok,NewF,Pname} -> wait_req_scan(enter_file2(NewF, Pname, From, St, Loc)); {error,_E1} -> - case catch find_lib_dir(NewName) of - {LibDir, Rest} when is_list(LibDir) -> - LibName = fname_join([LibDir | Rest]), - case file:open(LibName, [read]) of + case expand_lib_dir(NewName) of + {ok,Header} -> + case file:open(Header, [read]) of {ok,NewF} -> - wait_req_scan(enter_file2(NewF, LibName, From, + wait_req_scan(enter_file2(NewF, Header, From, St, Loc)); {error,_E2} -> epp_reply(From, @@ -990,13 +1010,13 @@ scan_include_lib([{'(',_Llp},{string,_Lf,NewName0},{')',_Lrp},{dot,_Ld}], {include,lib,NewName}}}), wait_req_scan(St) end; - _Error -> + error -> epp_reply(From, {error,{loc(Inc),epp, {include,lib,NewName}}}), wait_req_scan(St) end end; -scan_include_lib(_Toks, Inc, From, St) -> +scan_include_lib1(_Toks, Inc, From, St) -> epp_reply(From, {error,{loc(Inc),epp,{bad,include_lib}}}), wait_req_scan(St). @@ -1006,17 +1026,17 @@ scan_include_lib(_Toks, Inc, From, St) -> %% Report a badly formed if[n]def test and then treat as undefined macro. scan_ifdef([{'(',_Llp},{atom,_Lm,M},{')',_Lrp},{dot,_Ld}], _IfD, From, St) -> - case dict:find({atom,M}, St#epp.macs) of - {ok,_Def} -> + case St#epp.macs of + #{M:=_Def} -> scan_toks(From, St#epp{istk=[ifdef|St#epp.istk]}); - error -> + _ -> skip_toks(From, St, [ifdef]) end; scan_ifdef([{'(',_Llp},{var,_Lm,M},{')',_Lrp},{dot,_Ld}], _IfD, From, St) -> - case dict:find({atom,M}, St#epp.macs) of - {ok,_Def} -> + case St#epp.macs of + #{M:=_Def} -> scan_toks(From, St#epp{istk=[ifdef|St#epp.istk]}); - error -> + _ -> skip_toks(From, St, [ifdef]) end; scan_ifdef(_Toks, IfDef, From, St) -> @@ -1024,17 +1044,17 @@ scan_ifdef(_Toks, IfDef, From, St) -> wait_req_skip(St, [ifdef]). scan_ifndef([{'(',_Llp},{atom,_Lm,M},{')',_Lrp},{dot,_Ld}], _IfnD, From, St) -> - case dict:find({atom,M}, St#epp.macs) of - {ok,_Def} -> + case St#epp.macs of + #{M:=_Def} -> skip_toks(From, St, [ifndef]); - error -> + _ -> scan_toks(From, St#epp{istk=[ifndef|St#epp.istk]}) end; scan_ifndef([{'(',_Llp},{var,_Lm,M},{')',_Lrp},{dot,_Ld}], _IfnD, From, St) -> - case dict:find({atom,M}, St#epp.macs) of - {ok,_Def} -> + case St#epp.macs of + #{M:=_Def} -> skip_toks(From, St, [ifndef]); - error -> + _ -> scan_toks(From, St#epp{istk=[ifndef|St#epp.istk]}) end; scan_ifndef(_Toks, IfnDef, From, St) -> @@ -1098,16 +1118,21 @@ scan_endif(_Toks, Endif, From, St) -> %% Set the current file and line to the given file and line. %% Note that the line of the attribute itself is kept. -scan_file([{'(',_Llp},{string,_Ls,Name},{',',_Lc},{integer,_Li,Ln},{')',_Lrp}, - {dot,_Ld}], Tf, From, St) -> +scan_file(Tokens0, Tf, From, St) -> + Tokens = coalesce_strings(Tokens0), + scan_file1(Tokens, Tf, From, St). + +scan_file1([{'(',_Llp},{string,_Ls,Name},{',',_Lc},{integer,_Li,Ln},{')',_Lrp}, + {dot,_Ld}], Tf, From, St) -> Anno = erl_anno:new(Ln), enter_file_reply(From, Name, Anno, loc(Tf), generated), - Ms = dict:store({atom,'FILE'}, {none,[{string,line1(),Name}]}, St#epp.macs), + Ms0 = St#epp.macs, + Ms = Ms0#{'FILE':={none,[{string,line1(),Name}]}}, Locf = loc(Tf), NewLoc = new_location(Ln, St#epp.location, Locf), Delta = 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) -> +scan_file1(_Toks, Tf, From, St) -> epp_reply(From, {error,{loc(Tf),epp,{bad,file}}}), wait_req_scan(St). @@ -1185,45 +1210,47 @@ macro_expansion([T|Ts], _Anno0) -> [T|macro_expansion(Ts, T)]; macro_expansion([], Anno0) -> throw({error,loc(Anno0),premature_end}). -%% expand_macros(Tokens, Macros) +%% expand_macros(Tokens, St) %% expand_macro(Tokens, MacroToken, RestTokens) %% Expand the macros in a list of tokens, making sure that an expansion %% gets the same location as the macro call. -expand_macros(Type, MacT, M, Toks, Ms0) -> - %% (Type will always be 'atom') - {Ms, U} = Ms0, +expand_macros(MacT, M, Toks, St) -> + #epp{macs=Ms,uses=U} = St, Lm = loc(MacT), Tinfo = element(2, MacT), - case expand_macro1(Type, Lm, M, Toks, Ms) of + case expand_macro1(Lm, M, Toks, Ms) of {ok,{none,Exp}} -> - check_uses([{{Type,M}, none}], [], U, Lm), - Toks1 = expand_macros(expand_macro(Exp, Tinfo, [], dict:new()), Ms0), - expand_macros(Toks1++Toks, Ms0); + check_uses([{M,none}], [], U, Lm), + Toks1 = expand_macros(expand_macro(Exp, Tinfo, [], #{}), St), + expand_macros(Toks1++Toks, St); {ok,{As,Exp}} -> - check_uses([{{Type,M}, length(As)}], [], U, Lm), - {Bs,Toks1} = bind_args(Toks, Lm, M, As, dict:new()), - expand_macros(expand_macro(Exp, Tinfo, Toks1, Bs), Ms0) + check_uses([{M,length(As)}], [], U, Lm), + {Bs,Toks1} = bind_args(Toks, Lm, M, As, #{}), + expand_macros(expand_macro(Exp, Tinfo, Toks1, Bs), St) end. -expand_macro1(Type, Lm, M, Toks, Ms) -> +expand_macro1(Lm, M, Toks, Ms) -> Arity = count_args(Toks, Lm, M), - case dict:find({Type,M}, Ms) of - error -> %% macro not found + case Ms of + #{M:=undefined} -> + %% Predefined macro without definition. throw({error,Lm,{undefined,M,Arity}}); - {ok, undefined} -> %% Predefined macro without definition - throw({error,Lm,{undefined,M,Arity}}); - {ok, [{none, Def}]} -> - {ok, Def}; - {ok, Defs} when is_list(Defs) -> - case proplists:get_value(Arity, Defs) of + #{M:=[{none,Def}]} -> + {ok,Def}; + #{M:=Defs} when is_list(Defs) -> + case proplists:get_value(Arity, Defs) of undefined -> throw({error,Lm,{mismatch,M}}); Def -> - {ok, Def} + {ok,Def} end; - {ok, PreDef} -> %% Predefined macro - {ok, PreDef} + #{M:=PreDef} -> + %% Predefined macro. + {ok,PreDef}; + _ -> + %% Macro not found. + throw({error,Lm,{undefined,M,Arity}}) end. check_uses([], _Anc, _U, _Lm) -> @@ -1231,7 +1258,7 @@ check_uses([], _Anc, _U, _Lm) -> check_uses([M|Rest], Anc, U, Lm) -> case lists:member(M, Anc) of true -> - {{_, Name},Arity} = M, + {Name,Arity} = M, throw({error,Lm,{circular,Name,Arity}}); false -> L = get_macro_uses(M, U), @@ -1240,25 +1267,41 @@ check_uses([M|Rest], Anc, U, Lm) -> end. get_macro_uses({M,Arity}, U) -> - case dict:find(M, U) of - error -> - []; - {ok, L} -> - proplists:get_value(Arity, L, proplists:get_value(none, L, [])) + case U of + #{M:=L} -> + proplists:get_value(Arity, L, proplists:get_value(none, L, [])); + _ -> + [] end. %% Macro expansion %% Note: io:scan_erl_form() does not return comments or white spaces. -expand_macros([{'?',_Lq},{atom,_Lm,M}=MacT|Toks], Ms) -> - expand_macros(atom, MacT, M, Toks, Ms); +expand_macros([{'?',_Lq},{atom,_Lm,M}=MacT|Toks], St) -> + expand_macros(MacT, M, Toks, St); %% Special macros -expand_macros([{'?',_Lq},{var,Lm,'LINE'}=Tok|Toks], Ms) -> +expand_macros([{'?',_Lq},{var,Lm,'FUNCTION_NAME'}=Token|Toks], St0) -> + St = update_fun_name(Token, St0), + case St#epp.fname of + undefined -> + [{'?',_Lq},Token]; + {Name,_} -> + [{atom,Lm,Name}] + end ++ expand_macros(Toks, St); +expand_macros([{'?',_Lq},{var,Lm,'FUNCTION_ARITY'}=Token|Toks], St0) -> + St = update_fun_name(Token, St0), + case St#epp.fname of + undefined -> + [{'?',_Lq},Token]; + {_,Arity} -> + [{integer,Lm,Arity}] + end ++ expand_macros(Toks, St); +expand_macros([{'?',_Lq},{var,Lm,'LINE'}=Tok|Toks], St) -> Line = erl_scan:line(Tok), - [{integer,Lm,Line}|expand_macros(Toks, Ms)]; -expand_macros([{'?',_Lq},{var,_Lm,M}=MacT|Toks], Ms) -> - expand_macros(atom, MacT, M, Toks, Ms); + [{integer,Lm,Line}|expand_macros(Toks, St)]; +expand_macros([{'?',_Lq},{var,_Lm,M}=MacT|Toks], St) -> + expand_macros(MacT, M, Toks, St); %% Illegal macros -expand_macros([{'?',_Lq},Token|_Toks], _Ms) -> +expand_macros([{'?',_Lq},Token|_Toks], _St) -> T = case erl_scan:text(Token) of Text when is_list(Text) -> Text; @@ -1267,9 +1310,9 @@ expand_macros([{'?',_Lq},Token|_Toks], _Ms) -> io_lib:write(Symbol) end, throw({error,loc(Token),{call,[$?|T]}}); -expand_macros([T|Ts], Ms) -> - [T|expand_macros(Ts, Ms)]; -expand_macros([], _Ms) -> []. +expand_macros([T|Ts], St) -> + [T|expand_macros(Ts, St)]; +expand_macros([], _St) -> []. %% bind_args(Tokens, MacroLocation, MacroName, ArgumentVars, Bindings) %% Collect the arguments to a macro call. @@ -1295,7 +1338,7 @@ macro_args(_Toks, Lm, M, _As, _Bs) -> store_arg(L, M, _A, [], _Bs) -> throw({error,L,{mismatch,M}}); store_arg(_L, _M, A, Arg, Bs) -> - dict:store(A, Arg, Bs). + Bs#{A=>Arg}. %% count_args(Tokens, MacroLine, MacroName) %% Count the number of arguments in a macro call. @@ -1368,19 +1411,17 @@ macro_arg([], _E, Arg) -> %% and then the macro arguments, i.e. simulate textual expansion. expand_macro([{var,_Lv,V}|Ts], L, Rest, Bs) -> - case dict:find(V, Bs) of - {ok,Val} -> - %% lists:append(Val, expand_macro(Ts, L, Rest, Bs)); + case Bs of + #{V:=Val} -> expand_arg(Val, Ts, L, Rest, Bs); - error -> + _ -> [{var,L,V}|expand_macro(Ts, L, Rest, Bs)] end; expand_macro([{'?', _}, {'?', _}, {var,_Lv,V}|Ts], L, Rest, Bs) -> - case dict:find(V, Bs) of - {ok,Val} -> - %% lists:append(Val, expand_macro(Ts, L, Rest, Bs)); + case Bs of + #{V:=Val} -> expand_arg(stringify(Val, L), Ts, L, Rest, Bs); - error -> + _ -> [{var,L,V}|expand_macro(Ts, L, Rest, Bs)] end; expand_macro([T|Ts], L, Rest, Bs) -> @@ -1394,6 +1435,93 @@ expand_arg([A|As], Ts, _L, Rest, Bs) -> expand_arg([], Ts, L, Rest, Bs) -> expand_macro(Ts, L, Rest, Bs). +%%% +%%% Here follows support for the ?FUNCTION_NAME and ?FUNCTION_ARITY +%%% macros. Since the parser has not been run yet, we don't know the +%%% name and arity of the current function. Therefore, we will need to +%%% scan the beginning of the current form to extract the name and +%%% arity of the function. +%%% + +update_fun_name(Token, #epp{fname=Toks0}=St) when is_list(Toks0) -> + %% ?FUNCTION_NAME or ?FUNCTION_ARITY is used for the first time in + %% a function. First expand macros (except ?FUNCTION_NAME and + %% ?FUNCTION_ARITY) in the form. + + Toks1 = (catch expand_macros(Toks0, St#epp{fname=undefined})), + + %% Now extract the name and arity from the stream of tokens, and store + %% the result in the #epp{} record so we don't have to do it + %% again. + + case Toks1 of + [{atom,_,Name},{'(',_}|Toks] -> + %% This is the beginning of a function definition. + %% Scan the token stream up to the matching right + %% parenthesis and count the number of arguments. + FA = update_fun_name_1(Toks, 1, {Name,0}, St), + St#epp{fname=FA}; + [{'?',_}|_] -> + %% ?FUNCTION_NAME/?FUNCTION_ARITY used at the beginning + %% of a form. Does not make sense. + {var,_,Macro} = Token, + throw({error,loc(Token),{illegal_function_usage,Macro}}); + _ when is_list(Toks1) -> + %% Not the beginning of a function (an attribute or a + %% syntax error). + {var,_,Macro} = Token, + throw({error,loc(Token),{illegal_function,Macro}}); + _ -> + %% A macro expansion error. Return a dummy value and + %% let the caller notice and handle the error. + St#epp{fname={'_',0}} + end; +update_fun_name(_Token, St) -> + St. + +update_fun_name_1([Tok|Toks], L, FA, St) -> + case classify_token(Tok) of + comma -> + if + L =:= 1 -> + {Name,Arity} = FA, + update_fun_name_1(Toks, L, {Name,Arity+1}, St); + true -> + update_fun_name_1(Toks, L, FA, St) + end; + left -> + update_fun_name_1(Toks, L+1, FA, St); + right when L =:= 1 -> + FA; + right -> + update_fun_name_1(Toks, L-1, FA, St); + other -> + case FA of + {Name,0} -> + update_fun_name_1(Toks, L, {Name,1}, St); + {_,_} -> + update_fun_name_1(Toks, L, FA, St) + end + end; +update_fun_name_1([], _, FA, _) -> + %% Syntax error, but never mind. + FA. + +classify_token({C,_}) -> classify_token_1(C); +classify_token(_) -> other. + +classify_token_1(',') -> comma; +classify_token_1('(') -> left; +classify_token_1('{') -> left; +classify_token_1('[') -> left; +classify_token_1('<<') -> left; +classify_token_1(')') -> right; +classify_token_1('}') -> right; +classify_token_1(']') -> right; +classify_token_1('>>') -> right; +classify_token_1(_) -> other. + + %%% stringify(Ts, L) returns a list of one token: a string which when %%% tokenized would yield the token list Ts. @@ -1421,6 +1549,18 @@ stringify(Ts, L) -> [$\s | S] = lists:flatten(stringify1(Ts)), [{string, L, S}]. +coalesce_strings([{string,A,S} | Tokens]) -> + coalesce_strings(Tokens, A, [S]); +coalesce_strings([T | Tokens]) -> + [T | coalesce_strings(Tokens)]; +coalesce_strings([]) -> + []. + +coalesce_strings([{string,_,S}|Tokens], A, S0) -> + coalesce_strings(Tokens, A, [S | S0]); +coalesce_strings(Tokens, A, S) -> + [{string,A,lists:append(lists:reverse(S))} | coalesce_strings(Tokens)]. + %% epp_request(Epp) %% epp_request(Epp, Request) %% epp_reply(From, Reply) diff --git a/lib/stdlib/src/erl_anno.erl b/lib/stdlib/src/erl_anno.erl index 143318aa55..d32c34dabd 100644 --- a/lib/stdlib/src/erl_anno.erl +++ b/lib/stdlib/src/erl_anno.erl @@ -33,7 +33,7 @@ -export_type([anno_term/0]). --define(LN(L), is_integer(L)). +-define(LN(L), is_integer(L), L >= 0). -define(COL(C), (is_integer(C) andalso C >= 1)). %% Location. @@ -52,13 +52,13 @@ | {'record', record()} | {'text', string()}. --type anno() :: location() | [annotation(), ...]. +-opaque anno() :: location() | [annotation(), ...]. -type anno_term() :: term(). -type column() :: pos_integer(). -type generated() :: boolean(). -type filename() :: file:filename_all(). --type line() :: integer(). +-type line() :: non_neg_integer(). -type location() :: line() | {line(), column()}. -type record() :: boolean(). -type text() :: string(). @@ -90,9 +90,13 @@ to_term(Anno) -> -ifdef(DEBUG). from_term(Term) when is_list(Term) -> Term; +from_term(Line) when is_integer(Line), Line < 0 -> % Before OTP 19 + set_generated(true, new(-Line)); from_term(Term) -> [{location, Term}]. -else. +from_term(Line) when is_integer(Line), Line < 0 -> % Before OTP 19 + set_generated(true, new(-Line)); from_term(Term) -> Term. -endif. @@ -198,18 +202,11 @@ file(Anno) -> Anno :: anno(). generated(Line) when ?ALINE(Line) -> - Line =< 0; + false; generated({Line, Column}) when ?ALINE(Line), ?ACOLUMN(Column) -> - Line =< 0; + false; generated(Anno) -> - _ = anno_info(Anno, generated, false), - {location, Location} = lists:keyfind(location, 1, Anno), - case Location of - {Line, _Column} -> - Line =< 0; - Line -> - Line =< 0 - end. + anno_info(Anno, generated, false). -spec line(Anno) -> line() when Anno :: anno(). @@ -226,18 +223,11 @@ line(Anno) -> Anno :: anno(). location(Line) when ?ALINE(Line) -> - abs(Line); -location({Line, Column}) when ?ALINE(Line), ?ACOLUMN(Column) -> - {abs(Line), Column}; + Line; +location({Line, Column}=Location) when ?ALINE(Line), ?ACOLUMN(Column) -> + Location; location(Anno) -> - case anno_info(Anno, location) of - Line when Line < 0 -> - -Line; - {Line, Column} when Line < 0 -> - {-Line, Column}; - Location -> - Location - end. + anno_info(Anno, location). -spec record(Anno) -> record() when Anno :: anno(). @@ -270,31 +260,8 @@ set_file(File, Anno) -> Generated :: generated(), Anno :: anno(). -set_generated(true, Line) when ?ALINE(Line) -> - -abs(Line); -set_generated(false, Line) when ?ALINE(Line) -> - abs(Line); -set_generated(true, {Line, Column}) when ?ALINE(Line), - ?ACOLUMN(Column) -> - {-abs(Line),Column}; -set_generated(false, {Line, Column}) when ?ALINE(Line), - ?ACOLUMN(Column) -> - {abs(Line),Column}; set_generated(Generated, Anno) -> - _ = set(generated, Generated, Anno), - {location, Location} = lists:keyfind(location, 1, Anno), - NewLocation = - case Location of - {Line, Column} when Generated -> - {-abs(Line), Column}; - {Line, Column} when not Generated -> - {abs(Line), Column}; - Line when Generated -> - -abs(Line); - Line when not Generated -> - abs(Line) - end, - lists:keyreplace(location, 1, Anno, {location, NewLocation}). + set(generated, Generated, Anno). -spec set_line(Line, Anno) -> Anno when Line :: line(), @@ -313,38 +280,17 @@ set_line(Line, Anno) -> Anno :: anno(). set_location(Line, L) when ?ALINE(L), ?LLINE(Line) -> - new_location(fix_line(Line, L)); + new_location(Line); set_location(Line, {L, Column}) when ?ALINE(L), ?ACOLUMN(Column), ?LLINE(Line) -> - new_location(fix_line(Line, L)); + new_location(Line); set_location({L, C}=Loc, Line) when ?ALINE(Line), ?LLINE(L), ?LCOLUMN(C) -> - new_location(fix_location(Loc, Line)); + new_location(Loc); set_location({L, C}=Loc, {Line, Column}) when ?ALINE(Line), ?ACOLUMN(Column), ?LLINE(L), ?LCOLUMN(C) -> - new_location(fix_location(Loc, Line)); + new_location(Loc); set_location(Location, Anno) -> - _ = set(location, Location, Anno), - {location, OldLocation} = lists:keyfind(location, 1, Anno), - NewLocation = - case {Location, OldLocation} of - {{_Line, _Column}=Loc, {L, _C}} -> - fix_location(Loc, L); - {Line, {L, _C}} -> - fix_line(Line, L); - {{_Line, _Column}=Loc, L} -> - fix_location(Loc, L); - {Line, L} -> - fix_line(Line, L) - end, - lists:keyreplace(location, 1, Anno, {location, NewLocation}). - -fix_location({Line, Column}, OldLine) -> - {fix_line(Line, OldLine), Column}. - -fix_line(Line, OldLine) when OldLine < 0, Line > 0 -> - -Line; -fix_line(Line, _OldLine) -> - Line. + set(location, Location, Anno). -spec set_record(Record, Anno) -> Anno when Record :: record(), @@ -383,7 +329,7 @@ set_anno(Item, Value, Anno) -> _ -> lists:keyreplace(Item, 1, Anno, {Item, Value}) end, - simplify(R) + reset_simplify(R) end. reset(Anno, Item) -> diff --git a/lib/stdlib/src/erl_bits.erl b/lib/stdlib/src/erl_bits.erl index ddcfcfdf02..5851401026 100644 --- a/lib/stdlib/src/erl_bits.erl +++ b/lib/stdlib/src/erl_bits.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/lib/stdlib/src/erl_compile.erl b/lib/stdlib/src/erl_compile.erl index 5ca233cde7..a6ae398d03 100644 --- a/lib/stdlib/src/erl_compile.erl +++ b/lib/stdlib/src/erl_compile.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2014. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -60,6 +60,7 @@ compile_cmdline() -> _ -> my_halt(2) end. +-spec my_halt(_) -> no_return(). my_halt(Reason) -> erlang:halt(Reason). diff --git a/lib/stdlib/src/erl_eval.erl b/lib/stdlib/src/erl_eval.erl index ca3cc43b19..40a34aa30f 100644 --- a/lib/stdlib/src/erl_eval.erl +++ b/lib/stdlib/src/erl_eval.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2015. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -415,7 +415,7 @@ expr({call,_,{atom,_,Func},As0}, Bs0, Lf, Ef, RBs) -> {As,Bs} = expr_list(As0, Bs0, Lf, Ef), bif(Func, As, Bs, Ef, RBs); false -> - local_func(Func, As0, Bs0, Lf, RBs) + local_func(Func, As0, Bs0, Lf, Ef, RBs) end; expr({call,_,Func0,As0}, Bs0, Lf, Ef, RBs) -> % function or {Mod,Fun} {value,Func,Bs1} = expr(Func0, Bs0, Lf, Ef, none), @@ -542,33 +542,34 @@ unhide_calls([E | Es], MaxLine, D) -> unhide_calls(E, _MaxLine, _D) -> E. -%% local_func(Function, Arguments, Bindings, LocalFuncHandler, RBs) -> +%% local_func(Function, Arguments, Bindings, LocalFuncHandler, +%% ExternalFuncHandler, RBs) -> %% {value,Value,Bindings} | Value when %% LocalFuncHandler = {value,F} | {value,F,Eas} | %% {eval,F} | {eval,F,Eas} | none. -local_func(Func, As0, Bs0, {value,F}, value) -> - {As1,_Bs1} = expr_list(As0, Bs0, {value,F}), +local_func(Func, As0, Bs0, {value,F}, Ef, value) -> + {As1,_Bs1} = expr_list(As0, Bs0, {value,F}, Ef), %% Make tail recursive calls when possible. F(Func, As1); -local_func(Func, As0, Bs0, {value,F}, RBs) -> - {As1,Bs1} = expr_list(As0, Bs0, {value,F}), +local_func(Func, As0, Bs0, {value,F}, Ef, RBs) -> + {As1,Bs1} = expr_list(As0, Bs0, {value,F}, Ef), ret_expr(F(Func, As1), Bs1, RBs); -local_func(Func, As0, Bs0, {value,F,Eas}, RBs) -> +local_func(Func, As0, Bs0, {value,F,Eas}, Ef, RBs) -> Fun = fun(Name, Args) -> apply(F, [Name,Args|Eas]) end, - local_func(Func, As0, Bs0, {value, Fun}, RBs); -local_func(Func, As, Bs, {eval,F}, RBs) -> + local_func(Func, As0, Bs0, {value, Fun}, Ef, RBs); +local_func(Func, As, Bs, {eval,F}, _Ef, RBs) -> local_func2(F(Func, As, Bs), RBs); -local_func(Func, As, Bs, {eval,F,Eas}, RBs) -> +local_func(Func, As, Bs, {eval,F,Eas}, _Ef, RBs) -> local_func2(apply(F, [Func,As,Bs|Eas]), RBs); %% These two clauses are for backwards compatibility. -local_func(Func, As0, Bs0, {M,F}, RBs) -> - {As1,Bs1} = expr_list(As0, Bs0, {M,F}), +local_func(Func, As0, Bs0, {M,F}, Ef, RBs) -> + {As1,Bs1} = expr_list(As0, Bs0, {M,F}, Ef), ret_expr(M:F(Func,As1), Bs1, RBs); -local_func(Func, As, _Bs, {M,F,Eas}, RBs) -> +local_func(Func, As, _Bs, {M,F,Eas}, _Ef, RBs) -> local_func2(apply(M, F, [Func,As|Eas]), RBs); %% Default unknown function handler to undefined function. -local_func(Func, As0, _Bs0, none, _RBs) -> +local_func(Func, As0, _Bs0, none, _Ef, _RBs) -> erlang:raise(error, undef, [{erl_eval,Func,length(As0)}|stacktrace()]). local_func2({value,V,Bs}, RBs) -> @@ -1184,7 +1185,7 @@ match_tuple([], _, _, Bs, _BBs) -> match_map([{map_field_exact, _, K, V}|Fs], Map, Bs0, BBs) -> Vm = try - {value, Ke, _} = expr(K, Bs0), + {value, Ke, _} = expr(K, BBs), maps:get(Ke,Map) catch error:_ -> throw(nomatch) diff --git a/lib/stdlib/src/erl_expand_records.erl b/lib/stdlib/src/erl_expand_records.erl index bcfeef7321..ebcbc54ab1 100644 --- a/lib/stdlib/src/erl_expand_records.erl +++ b/lib/stdlib/src/erl_expand_records.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2015. All Rights Reserved. +%% Copyright Ericsson AB 2005-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -33,59 +33,31 @@ vcount=0, % Variable counter imports=[], % Imports records=dict:new(), % Record definitions - trecords=sets:new(), % Typed records - uses_types=false, % Are there -spec or -type in the module strict_ra=[], % strict record accesses checked_ra=[] % successfully accessed records }). --spec(module(AbsForms, CompileOptions) -> AbsForms when +-spec(module(AbsForms, CompileOptions) -> AbsForms2 when AbsForms :: [erl_parse:abstract_form()], + AbsForms2 :: [erl_parse:abstract_form()], CompileOptions :: [compile:option()]). %% Is is assumed that Fs is a valid list of forms. It should pass %% erl_lint without errors. module(Fs0, Opts0) -> Opts = compiler_options(Fs0) ++ Opts0, - TRecs = typed_records(Fs0), - UsesTypes = uses_types(Fs0), - St0 = #exprec{compile = Opts, trecords = TRecs, uses_types = UsesTypes}, + St0 = #exprec{compile = Opts}, {Fs,_St} = forms(Fs0, St0), Fs. compiler_options(Forms) -> lists:flatten([C || {attribute,_,compile,C} <- Forms]). -typed_records(Fs) -> - typed_records(Fs, sets:new()). - -typed_records([{attribute,_L,type,{{record, Name},_Defs,[]}} | Fs], Trecs) -> - typed_records(Fs, sets:add_element(Name, Trecs)); -typed_records([_|Fs], Trecs) -> - typed_records(Fs, Trecs); -typed_records([], Trecs) -> - Trecs. - -uses_types([{attribute,_L,spec,_}|_]) -> true; -uses_types([{attribute,_L,type,_}|_]) -> true; -uses_types([{attribute,_L,opaque,_}|_]) -> true; -uses_types([_|Fs]) -> uses_types(Fs); -uses_types([]) -> false. - -forms([{attribute,L,record,{Name,Defs}} | Fs], St0) -> +forms([{attribute,_,record,{Name,Defs}}=Attr | Fs], St0) -> NDefs = normalise_fields(Defs), St = St0#exprec{records=dict:store(Name, NDefs, St0#exprec.records)}, {Fs1, St1} = forms(Fs, St), - %% Check if we need to keep the record information for usage in types. - case St#exprec.uses_types of - true -> - case sets:is_element(Name, St#exprec.trecords) of - true -> {Fs1, St1}; - false -> {[{attribute,L,type,{{record,Name},Defs,[]}}|Fs1], St1} - end; - false -> - {Fs1, St1} - end; + {[Attr | Fs1], St1}; forms([{attribute,L,import,Is} | Fs0], St0) -> St1 = import(Is, St0), {Fs,St2} = forms(Fs0, St1), @@ -513,7 +485,6 @@ lc_tq(Line, [F0 | Qs0], St0) -> lc_tq(_Line, [], St0) -> {[],St0#exprec{checked_ra = []}}. - %% normalise_fields([RecDef]) -> [Field]. %% Normalise the field definitions to always have a default value. If %% none has been given then use 'undefined'. diff --git a/lib/stdlib/src/erl_internal.erl b/lib/stdlib/src/erl_internal.erl index f7711d0ad7..c08328b4b7 100644 --- a/lib/stdlib/src/erl_internal.erl +++ b/lib/stdlib/src/erl_internal.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2014. All Rights Reserved. +%% Copyright Ericsson AB 1998-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index c4cb5fdc80..e9332ce069 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2015. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -31,12 +31,8 @@ -export([is_guard_expr/1]). -export([bool_option/4,value_option/3,value_option/7]). --export([modify_line/2]). - -import(lists, [member/2,map/2,foldl/3,foldr/3,mapfoldl/3,all/2,reverse/1]). --deprecated([{modify_line, 2, next_major_release}]). - %% bool_option(OnOpt, OffOpt, Default, Options) -> boolean(). %% value_option(Flag, Default, Options) -> Value. %% value_option(Flag, Default, OnOpt, OnVal, OffOpt, OffVal, Options) -> @@ -79,7 +75,7 @@ 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_anno:line(). % a convenient alias +-type line() :: erl_anno:anno(). % a convenient alias -type fa() :: {atom(), arity()}. % function+arity -type ta() :: {atom(), arity()}. % type+arity @@ -100,10 +96,10 @@ value_option(Flag, Default, On, OnVal, Off, OffVal, Opts) -> %% 'called' and 'exports' contain {Line, {Function, Arity}}, %% the other function collections contain {Function, Arity}. -record(lint, {state=start :: 'start' | 'attribute' | 'function', - module=[], %Module + module='', %Module behaviour=[], %Behaviour exports=gb_sets:empty() :: gb_sets:set(fa()),%Exports - imports=[] :: [fa()], %Imports, an orddict() + imports=[] :: orddict:orddict(fa(), module()),%Imports compile=[], %Compile flags records=dict:new() %Record definitions :: dict:dict(atom(), {line(),Fields :: term()}), @@ -238,6 +234,9 @@ format_error({removed, MFA, ReplacementMFA, Rel}) -> "use ~s", [format_mfa(MFA), Rel, format_mfa(ReplacementMFA)]); format_error({removed, MFA, String}) when is_list(String) -> io_lib:format("~s: ~s", [format_mfa(MFA), String]); +format_error({removed_type, MNA, ReplacementMNA, Rel}) -> + io_lib:format("the type ~s was removed in ~s; use ~s instead", + [format_mna(MNA), Rel, format_mna(ReplacementMNA)]); format_error({obsolete_guard, {F, A}}) -> io_lib:format("~p/~p obsolete", [F, A]); format_error({too_many_arguments,Arity}) -> @@ -293,6 +292,9 @@ format_error({variable_in_record_def,V}) -> %% --- binaries --- format_error({undefined_bittype,Type}) -> io_lib:format("bit type ~w undefined", [Type]); +format_error({bittype_mismatch,Val1,Val2,What}) -> + io_lib:format("conflict in ~s specification for bit field: '~p' and '~p'", + [What,Val1,Val2]); format_error(bittype_unit) -> "a bit unit size must not be specified unless a size is specified too"; format_error(illegal_bitsize) -> @@ -358,6 +360,9 @@ format_error({redefine_type, {TypeName, Arity}}) -> [TypeName, gen_type_paren(Arity)]); format_error({type_syntax, Constr}) -> io_lib:format("bad ~w type", [Constr]); +format_error(old_abstract_code) -> + io_lib:format("abstract code generated before Erlang/OTP 19.0 and " + "having typed record fields cannot be compiled", []); format_error({redefine_spec, {M, F, A}}) -> io_lib:format("spec for ~w:~w/~w already defined", [M, F, A]); format_error({redefine_spec, {F, A}}) -> @@ -371,9 +376,9 @@ format_error({spec_fun_undefined, {F, A}}) -> format_error({missing_spec, {F,A}}) -> io_lib:format("missing specification for function ~w/~w", [F, A]); format_error(spec_wrong_arity) -> - "spec has the wrong arity"; + "spec has wrong arity"; format_error(callback_wrong_arity) -> - "callback has the wrong arity"; + "callback has wrong arity"; format_error({deprecated_builtin_type, {Name, Arity}, Replacement, Rel}) -> UseS = case Replacement of @@ -413,6 +418,9 @@ format_mfa({M, F, A}) when is_integer(A) -> format_mf(M, F, ArityString) when is_atom(M), is_atom(F) -> atom_to_list(M) ++ ":" ++ atom_to_list(F) ++ "/" ++ ArityString. +format_mna({M, N, A}) when is_integer(A) -> + atom_to_list(M) ++ ":" ++ atom_to_list(N) ++ gen_type_paren(A). + format_where(L) when is_integer(L) -> io_lib:format("(line ~p)", [L]); format_where({L,C}) when is_integer(L), is_integer(C) -> @@ -459,7 +467,7 @@ used_vars(Exprs, BindingsList) -> %% really all ordsets! -spec(module(AbsForms) -> {ok, Warnings} | {error, Errors, Warnings} when - AbsForms :: [erl_parse:abstract_form()], + AbsForms :: [erl_parse:abstract_form() | erl_parse:form_info()], Warnings :: [{file:filename(),[ErrorInfo]}], Errors :: [{FileName2 :: file:filename(),[ErrorInfo]}], ErrorInfo :: error_info()). @@ -471,7 +479,7 @@ module(Forms) -> -spec(module(AbsForms, FileName) -> {ok, Warnings} | {error, Errors, Warnings} when - AbsForms :: [erl_parse:abstract_form()], + AbsForms :: [erl_parse:abstract_form() | erl_parse:form_info()], FileName :: atom() | string(), Warnings :: [{file:filename(),[ErrorInfo]}], Errors :: [{FileName2 :: file:filename(),[ErrorInfo]}], @@ -484,7 +492,7 @@ module(Forms, FileName) -> -spec(module(AbsForms, FileName, CompileOptions) -> {ok, Warnings} | {error, Errors, Warnings} when - AbsForms :: [erl_parse:abstract_form()], + AbsForms :: [erl_parse:abstract_form() | erl_parse:form_info()], FileName :: atom() | string(), CompileOptions :: [compile:option()], Warnings :: [{file:filename(),[ErrorInfo]}], @@ -691,7 +699,12 @@ set_form_file({function,L,N,A,C}, File) -> set_form_file(Form, _File) -> Form. +set_file(Ts, File) when is_list(Ts) -> + [anno_set_file(T, File) || T <- Ts]; set_file(T, File) -> + anno_set_file(T, File). + +anno_set_file(T, File) -> F = fun(Anno) -> erl_anno:set_file(File, Anno) end, erl_parse:map_anno(F, T). @@ -726,7 +739,7 @@ start_state(Form, St) -> %% attribute_state(Form, State) -> %% State' -attribute_state({attribute,_L,module,_M}, #lint{module=[]}=St) -> +attribute_state({attribute,_L,module,_M}, #lint{module=''}=St) -> St; attribute_state({attribute,L,module,_M}, St) -> add_error(L, redefine_module, St); @@ -1133,7 +1146,7 @@ check_untyped_records(Forms, St0) -> RecNames = dict:fetch_keys(St0#lint.records), %% these are the records with field(s) containing type info TRecNames = [Name || - {attribute,_,type,{{record,Name},Fields,_}} <- Forms, + {attribute,_,record,{Name,Fields}} <- Forms, lists:all(fun ({typed_record_field,_,_}) -> true; (_) -> false end, Fields)], @@ -1143,7 +1156,8 @@ check_untyped_records(Forms, St0) -> [] -> St; % exclude records with no fields [_|_] -> add_warning(L, {untyped_record, N}, St) end - end, St0, RecNames -- TRecNames); + end, St0, ordsets:subtract(ordsets:from_list(RecNames), + ordsets:from_list(TRecNames))); false -> St0 end. @@ -1488,7 +1502,7 @@ pattern({op,_Line,'++',{string,_Li,_S},R}, Vt, Old, Bvt, St) -> pattern({match,_Line,Pat1,Pat2}, Vt, Old, Bvt, St0) -> {Lvt,Bvt1,St1} = pattern(Pat1, Vt, Old, Bvt, St0), {Rvt,Bvt2,St2} = pattern(Pat2, Vt, Old, Bvt, St1), - St3 = reject_bin_alias(Pat1, Pat2, St2), + St3 = reject_invalid_alias(Pat1, Pat2, Vt, St2), {vtmerge_pat(Lvt, Rvt),vtmerge_pat(Bvt1,Bvt2),St3}; %% Catch legal constant expressions, including unary +,-. pattern(Pat, _Vt, _Old, _Bvt, St) -> @@ -1503,56 +1517,77 @@ pattern_list(Ps, Vt, Old, Bvt0, St) -> {vtmerge_pat(Pvt, Psvt),vtmerge_pat(Bvt,Bvt1),St1} end, {[],[],St}, Ps). -%% reject_bin_alias(Pat, Expr, St) -> St' + + +%% reject_invalid_alias(Pat, Expr, Vt, St) -> St' %% Reject aliases for binary patterns at the top level. +%% Reject aliases for maps patterns at the top level. +%% The variables table (Vt) are for maps checkking. -reject_bin_alias_expr({bin,_,_}=P, {match,_,P0,E}, St0) -> - St = reject_bin_alias(P, P0, St0), - reject_bin_alias_expr(P, E, St); -reject_bin_alias_expr({match,_,_,_}=P, {match,_,P0,E}, St0) -> - St = reject_bin_alias(P, P0, St0), - reject_bin_alias_expr(P, E, St); -reject_bin_alias_expr(_, _, St) -> St. +reject_invalid_alias_expr({bin,_,_}=P, {match,_,P0,E}, Vt, St0) -> + St = reject_invalid_alias(P, P0, Vt, St0), + reject_invalid_alias_expr(P, E, Vt, St); +reject_invalid_alias_expr({map,_,_}=P, {match,_,P0,E}, Vt, St0) -> + St = reject_invalid_alias(P, P0, Vt, St0), + reject_invalid_alias_expr(P, E, Vt, St); +reject_invalid_alias_expr({match,_,_,_}=P, {match,_,P0,E}, Vt, St0) -> + St = reject_invalid_alias(P, P0, Vt, St0), + reject_invalid_alias_expr(P, E, Vt, St); +reject_invalid_alias_expr(_, _, _, St) -> St. -%% reject_bin_alias(Pat1, Pat2, St) -> St' + +%% reject_invalid_alias(Pat1, Pat2, St) -> St' %% Aliases of binary patterns, such as <<A:8>> = <<B:4,C:4>> or even %% <<A:8>> = <<A:8>>, are not allowed. Traverse the patterns in parallel %% and generate an error if any binary aliases are found. %% We generate an error even if is obvious that the overall pattern can't %% possibly match, for instance, {a,<<A:8>>,c}={x,<<A:8>>} WILL generate an %% error. +%% Maps should reject unbound variables here. -reject_bin_alias({bin,Line,_}, {bin,_,_}, St) -> +reject_invalid_alias({bin,Line,_}, {bin,_,_}, _, St) -> add_error(Line, illegal_bin_pattern, St); -reject_bin_alias({cons,_,H1,T1}, {cons,_,H2,T2}, St0) -> - St = reject_bin_alias(H1, H2, 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_invalid_alias({map,_Line,Ps1}, {map,_,Ps2}, Vt, St0) -> + Fun = fun ({map_field_exact,L,{var,_,K},_V}, Sti) -> + case is_var_bound(K,Vt) of + true -> + Sti; + false -> + add_error(L, {unbound_var,K}, Sti) + end; + ({map_field_exact,_L,_K,_V}, Sti) -> + Sti + end, + foldl(Fun, foldl(Fun, St0, Ps1), Ps2); +reject_invalid_alias({cons,_,H1,T1}, {cons,_,H2,T2}, Vt, St0) -> + St = reject_invalid_alias(H1, H2, Vt, St0), + reject_invalid_alias(T1, T2, Vt, St); +reject_invalid_alias({tuple,_,Es1}, {tuple,_,Es2}, Vt, St) -> + reject_invalid_alias_list(Es1, Es2, Vt, St); +reject_invalid_alias({record,_,Name1,Pfs1}, {record,_,Name2,Pfs2}, Vt, #lint{records=Recs}=St) -> case {dict:find(Name1, Recs),dict:find(Name2, Recs)} of {{ok,{_Line1,Fields1}},{ok,{_Line2,Fields2}}} -> - reject_bin_alias_rec(Pfs1, Pfs2, Fields1, Fields2, St); + reject_invalid_alias_rec(Pfs1, Pfs2, Fields1, Fields2, Vt, St); {_,_} -> %% One or more non-existing records. (An error messages has %% already been generated, so we are done here.) St end; -reject_bin_alias({match,_,P1,P2}, P, St0) -> - St = reject_bin_alias(P1, P, St0), - reject_bin_alias(P2, P, St); -reject_bin_alias(P, {match,_,_,_}=M, St) -> - reject_bin_alias(M, P, St); -reject_bin_alias(_P1, _P2, St) -> St. - -reject_bin_alias_list([E1|Es1], [E2|Es2], St0) -> - St = reject_bin_alias(E1, E2, St0), - reject_bin_alias_list(Es1, Es2, St); -reject_bin_alias_list(_, _, St) -> St. - -reject_bin_alias_rec(PfsA0, PfsB0, FieldsA0, FieldsB0, St) -> +reject_invalid_alias({match,_,P1,P2}, P, Vt, St0) -> + St = reject_invalid_alias(P1, P, Vt, St0), + reject_invalid_alias(P2, P, Vt, St); +reject_invalid_alias(P, {match,_,_,_}=M, Vt, St) -> + reject_invalid_alias(M, P, Vt, St); +reject_invalid_alias(_P1, _P2, _Vt, St) -> St. + +reject_invalid_alias_list([E1|Es1], [E2|Es2], Vt, St0) -> + St = reject_invalid_alias(E1, E2, Vt, St0), + reject_invalid_alias_list(Es1, Es2, Vt, St); +reject_invalid_alias_list(_, _, _, St) -> St. + +reject_invalid_alias_rec(PfsA0, PfsB0, FieldsA0, FieldsB0, Vt, St) -> %% We treat records as if they have been converted to tuples. PfsA1 = rbia_field_vars(PfsA0), PfsB1 = rbia_field_vars(PfsB0), @@ -1568,7 +1603,7 @@ reject_bin_alias_rec(PfsA0, PfsB0, FieldsA0, FieldsB0, St) -> D = sofs:projection({external,fun({_,_,P1,_,P2}) -> {P1,P2} end}, C), E = sofs:to_external(D), {Ps1,Ps2} = lists:unzip(E), - reject_bin_alias_list(Ps1, Ps2, St). + reject_invalid_alias_list(Ps1, Ps2, Vt, St). rbia_field_vars(Fs) -> [{Name,Pat} || {record_field,_,{atom,_,Name},Pat} <- Fs]. @@ -2270,7 +2305,7 @@ expr({'catch',Line,E}, Vt, St0) -> expr({match,_Line,P,E}, Vt, St0) -> {Evt,St1} = expr(E, Vt, St0), {Pvt,Bvt,St2} = pattern(P, vtupdate(Evt, Vt), St1), - St = reject_bin_alias_expr(P, E, St2), + St = reject_invalid_alias_expr(P, E, Vt, St2), {vtupdate(Bvt, vtmerge(Evt, Pvt)),St}; %% No comparison or boolean operators yet. expr({op,_Line,_Op,A}, Vt, St) -> @@ -2367,7 +2402,7 @@ is_valid_call(Call) -> _ -> true end. -%% is_valid_map_key(K,St) -> true | false +%% is_valid_map_key(K) -> true | false %% variables are allowed for patterns only at the top of the tree is_valid_map_key({var,_,_}) -> true; @@ -2433,7 +2468,10 @@ record_def(Line, Name, Fs0, St0) -> true -> add_error(Line, {redefine_record,Name}, St0); false -> {Fs1,St1} = def_fields(normalise_fields(Fs0), Name, St0), - St1#lint{records=dict:store(Name, {Line,Fs1}, St1#lint.records)} + St2 = St1#lint{records=dict:store(Name, {Line,Fs1}, + St1#lint.records)}, + Types = [T || {typed_record_field, _, T} <- Fs0], + check_type({type, nowarn(), product, Types}, St2) end. %% def_fields([RecDef], RecordName, State) -> {[DefField],State}. @@ -2636,11 +2674,8 @@ find_field(_F, []) -> error. %% Attr :: 'type' | 'opaque' %% Checks that a type definition is valid. -type_def(_Attr, _Line, {record, _RecName}, Fields, [], St0) -> - %% The record field names and such are checked in the record format. - %% We only need to check the types. - Types = [T || {typed_record_field, _, T} <- Fields], - check_type({type, nowarn(), product, Types}, St0); +-dialyzer({no_match, type_def/6}). + type_def(Attr, Line, TypeName, ProtoType, Args, St0) -> TypeDefs = St0#lint.types, Arity = length(Args), @@ -2702,8 +2737,6 @@ check_type(Types, St) -> 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]}, SeenVars, St0) -> St = deprecated_type(L, Mod, Name, Args, St0), @@ -2743,10 +2776,8 @@ check_type({type, L, range, [From, To]}, SeenVars, St) -> _ -> add_error(L, {type_syntax, range}, St) end, {SeenVars, St1}; -check_type({type, L, map, any}, SeenVars, St) -> - %% To get usage right while map/0 is a newly_introduced_builtin_type. - St1 = used_type({map, 0}, L, St), - {SeenVars, St1}; +check_type({type, _L, map, any}, SeenVars, St) -> + {SeenVars, St}; check_type({type, _L, map, Pairs}, SeenVars, St) -> lists:foldl(fun(Pair, {AccSeenVars, AccSt}) -> check_type(Pair, AccSeenVars, AccSt) @@ -2803,6 +2834,8 @@ check_type({user_type, L, TypeName, Args}, SeenVars, St) -> lists:foldl(fun(T, {AccSeenVars, AccSt}) -> check_type(T, AccSeenVars, AccSt) end, {SeenVars, St1}, Args); +check_type([{typed_record_field,Field,_T}|_], SeenVars, St) -> + {SeenVars, add_error(element(2, Field), old_abstract_code, St)}; check_type(I, SeenVars, St) -> case erl_eval:partial_eval(I) of {integer,_ILn,_Integer} -> {SeenVars, St}; @@ -2852,7 +2885,6 @@ used_type(TypePair, L, #lint{usage = Usage, file = File} = St) -> is_default_type({Name, NumberOfTypeVariables}) -> erl_internal:is_type(Name, NumberOfTypeVariables). -is_newly_introduced_builtin_type({map, 0}) -> true; is_newly_introduced_builtin_type({Name, _}) when is_atom(Name) -> false. is_obsolete_builtin_type(TypePair) -> @@ -2873,7 +2905,7 @@ spec_decl(Line, MFA0, TypeSpecs, St0 = #lint{specs = Specs, module = Mod}) -> St1 = St0#lint{specs = dict:store(MFA, Line, Specs)}, case dict:is_key(MFA, Specs) of true -> add_error(Line, {redefine_spec, MFA0}, St1); - false -> check_specs(TypeSpecs, Arity, St1) + false -> check_specs(TypeSpecs, spec_wrong_arity, Arity, St1) end. %% callback_decl(Line, Fun, Types, State) -> State. @@ -2887,7 +2919,8 @@ callback_decl(Line, MFA0, TypeSpecs, St1 = St0#lint{callbacks = dict:store(MFA, Line, Callbacks)}, case dict:is_key(MFA, Callbacks) of true -> add_error(Line, {redefine_callback, MFA0}, St1); - false -> check_specs(TypeSpecs, Arity, St1) + false -> check_specs(TypeSpecs, callback_wrong_arity, + Arity, St1) end end. @@ -2924,7 +2957,7 @@ is_fa({FuncName, Arity}) when is_atom(FuncName), is_integer(Arity), Arity >= 0 -> true; is_fa(_) -> false. -check_specs([FunType|Left], Arity, St0) -> +check_specs([FunType|Left], ETag, Arity, St0) -> {FunType1, CTypes} = case FunType of {type, _, bounded_fun, [FT = {type, _, 'fun', _}, Cs]} -> @@ -2932,18 +2965,16 @@ check_specs([FunType|Left], Arity, St0) -> {FT, lists:append(Types0)}; {type, _, 'fun', _} = FT -> {FT, []} end, - SpecArity = - case FunType1 of - {type, L, 'fun', [any, _]} -> any; - {type, L, 'fun', [{type, _, product, D}, _]} -> length(D) - end, + {type, L, 'fun', [{type, _, product, D}, _]} = FunType1, + SpecArity = length(D), St1 = case Arity =:= SpecArity of true -> St0; - false -> add_error(L, spec_wrong_arity, St0) + false -> %% Cannot happen if called from the compiler. + add_error(L, ETag, St0) end, St2 = check_type({type, nowarn(), product, [FunType1|CTypes]}, St1), - check_specs(Left, Arity, St2); -check_specs([], _Arity, St) -> + check_specs(Left, ETag, Arity, St2); +check_specs([], _ETag, _Arity, St) -> St. nowarn() -> @@ -2985,9 +3016,10 @@ add_missing_spec_warnings(Forms, St0, Type) -> [{FA,L} || {function,L,F,A,_} <- Forms, not lists:member(FA = {F,A}, Specs)]; exported -> - Exps = gb_sets:to_list(St0#lint.exports) -- pseudolocals(), + Exps0 = gb_sets:to_list(St0#lint.exports) -- pseudolocals(), + Exps = Exps0 -- Specs, [{FA,L} || {function,L,F,A,_} <- Forms, - member(FA = {F,A}, Exps -- Specs)] + member(FA = {F,A}, Exps)] end, foldl(fun ({FA,L}, St) -> add_warning(L, {missing_spec,FA}, St) @@ -3000,7 +3032,9 @@ check_unused_types(Forms, #lint{usage=Usage, types=Ts, exp_types=ExpTs}=St) -> L = gb_sets:to_list(ExpTs) ++ dict:fetch_keys(D), UsedTypes = gb_sets:from_list(L), FoldFun = - fun(Type, #typeinfo{line = FileLine}, AccSt) -> + fun({{record, _}=_Type, 0}, _, AccSt) -> + AccSt; % Before Erlang/OTP 19.0 + (Type, #typeinfo{line = FileLine}, AccSt) -> case loc(FileLine, AccSt) of {FirstFile, _} -> case gb_sets:is_member(Type, UsedTypes) of @@ -3187,8 +3221,8 @@ handle_generator(P,E,Vt,Uvt,St0) -> handle_bitstring_gen_pat({bin,_,Segments=[_|_]},St) -> case lists:last(Segments) of {bin_element,Line,{var,_,_},default,Flags} when is_list(Flags) -> - case member(binary, Flags) orelse member(bits, Flags) - orelse member(bitstring, Flags) of + case member(binary, Flags) orelse member(bytes, Flags) + orelse member(bits, Flags) orelse member(bitstring, Flags) of true -> add_error(Line, unsized_binary_in_bin_gen_pattern, St); false -> @@ -3400,6 +3434,14 @@ warn_unused_vars(U, Vt, St0) -> UVt = map(fun ({V,{State,_,Ls}}) -> {V,{State,used,Ls}} end, U), {vtmerge(Vt, UVt), St1}. + +is_var_bound(V, Vt) -> + case orddict:find(V, Vt) of + {ok,{bound,_Usage,_}} -> true; + _ -> false + end. + + %% vtupdate(UpdVarTable, VarTable) -> VarTable. %% Add the variables in the updated vartable to VarTable. The variables %% will be updated with their property in UpdVarTable. The state of @@ -3482,13 +3524,6 @@ vt_no_unused(Vt) -> [V || {_,{_,U,_L}}=V <- Vt, U =/= unused]. copy_expr(Expr, Anno) -> erl_parse:map_anno(fun(_A) -> Anno end, Expr). -%% modify_line(Form, Fun) -> Form -%% modify_line(Expression, Fun) -> Expression -%% Applies Fun to each line number occurrence. - -modify_line(T, F0) -> - erl_parse:map_anno(F0, T). - %% Check a record_info call. We have already checked that it is not %% shadowed by an import. @@ -3529,6 +3564,8 @@ check_qlc_hrl(Line, M, F, As, St) -> %% deprecated_function(Line, ModName, FuncName, [Arg], State) -> State. %% Add warning for calls to deprecated functions. +-dialyzer({no_match, deprecated_function/5}). + deprecated_function(Line, M, F, As, St) -> Arity = length(As), MFA = {M, F, Arity}, @@ -3557,6 +3594,8 @@ deprecated_function(Line, M, F, As, St) -> St end. +-dialyzer({no_match, deprecated_type/5}). + deprecated_type(L, M, N, As, St) -> NAs = length(As), case otp_internal:obsolete_type(M, N, NAs) of @@ -3567,6 +3606,8 @@ deprecated_type(L, M, N, As, St) -> false -> St end; + {removed, Replacement, Rel} -> + add_warning(L, {removed_type, {M,N,NAs}, Replacement, Rel}, St); no -> St end. diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl index e82282421e..4f38256e6b 100644 --- a/lib/stdlib/src/erl_parse.yrl +++ b/lib/stdlib/src/erl_parse.yrl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2015. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -85,10 +85,6 @@ type_spec -> '(' spec_fun type_sigs ')' : {'$2', '$3'}. spec_fun -> atom : '$1'. spec_fun -> atom ':' atom : {'$1', '$3'}. -%% The following two are retained only for backwards compatibility; -%% they are not part of the EEP syntax and should be removed. -spec_fun -> atom '/' integer '::' : {'$1', '$3'}. -spec_fun -> atom ':' atom '/' integer '::' : {'$1', '$3', '$5'}. typed_attr_val -> expr ',' typed_record_fields : {typed_record, '$1', '$3'}. typed_attr_val -> expr '::' top_type : {type_def, '$1', '$3'}. @@ -176,7 +172,11 @@ fun_type -> '(' top_types ')' '->' top_type map_pair_types -> map_pair_type : ['$1']. map_pair_types -> map_pair_type ',' map_pair_types : ['$1'|'$3']. -map_pair_type -> top_type '=>' top_type : {type, ?anno('$2'), map_field_assoc,['$1','$3']}. + +map_pair_type -> top_type '=>' top_type : {type, ?anno('$2'), + map_field_assoc,['$1','$3']}. +map_pair_type -> top_type ':=' top_type : {type, ?anno('$2'), + map_field_exact,['$1','$3']}. field_types -> field_type : ['$1']. field_types -> field_type ',' field_types : ['$1'|'$3']. @@ -315,7 +315,7 @@ bit_size_expr -> expr_max : '$1'. list_comprehension -> '[' expr '||' lc_exprs ']' : {lc,?anno('$1'),'$2','$4'}. -binary_comprehension -> '<<' binary '||' lc_exprs '>>' : +binary_comprehension -> '<<' expr_max '||' lc_exprs '>>' : {bc,?anno('$1'),'$2','$4'}. lc_exprs -> lc_expr : ['$1']. lc_exprs -> lc_expr ',' lc_exprs : ['$1'|'$3']. @@ -525,23 +525,430 @@ Erlang code. -export([type_inop_prec/1,type_preop_prec/1]). -export([map_anno/2, fold_anno/3, mapfold_anno/3, new_anno/1, anno_to_term/1, anno_from_term/1]). --export([set_line/2,get_attribute/2,get_attributes/1]). - --deprecated([{set_line, 2, next_major_release}, - {get_attribute, 2, next_major_release}, - {get_attributes, 1, next_major_release}]). %% The following directive is needed for (significantly) faster compilation %% of the generated .erl file by the HiPE compiler. Please do not remove. -compile([{hipe,[{regalloc,linear_scan}]}]). -export_type([abstract_clause/0, abstract_expr/0, abstract_form/0, - error_info/0]). + abstract_type/0, form_info/0, error_info/0]). + +%% Start of Abstract Format + +-type anno() :: erl_anno:anno(). + +-type abstract_form() :: af_module() + | af_behavior() + | af_behaviour() + | af_export() + | af_import() + | af_export_type() + | af_compile() + | af_file() + | af_record_decl() + | af_type_decl() + | af_function_spec() + | af_wild_attribute() + | af_function_decl(). + +-type af_module() :: {'attribute', anno(), 'module', module()}. + +-type af_behavior() :: {'attribute', anno(), 'behavior', behaviour()}. + +-type af_behaviour() :: {'attribute', anno(), 'behaviour', behaviour()}. + +-type behaviour() :: atom(). + +-type af_export() :: {'attribute', anno(), 'export', af_fa_list()}. + +-type af_import() :: {'attribute', anno(), 'import', af_fa_list()}. + +-type af_fa_list() :: [{function_name(), arity()}]. + +-type af_export_type() :: {'attribute', anno(), 'export_type', af_ta_list()}. + +-type af_ta_list() :: [{type_name(), arity()}]. + +-type af_compile() :: {'attribute', anno(), 'compile', any()}. + +-type af_file() :: {'attribute', anno(), 'file', {string(), anno()}}. + +-type af_record_decl() :: + {'attribute', anno(), 'record', {record_name(), [af_field_decl()]}}. + +-type af_field_decl() :: af_typed_field() | af_field(). + +-type af_typed_field() :: + {'typed_record_field', af_field(), abstract_type()}. + +-type af_field() :: {'record_field', anno(), af_field_name()} + | {'record_field', anno(), af_field_name(), abstract_expr()}. + +-type af_type_decl() :: {'attribute', anno(), type_attr(), + {type_name(), abstract_type(), [af_variable()]}}. + +-type type_attr() :: 'opaque' | 'type'. + +-type af_function_spec() :: {'attribute', anno(), spec_attr(), + {{function_name(), arity()}, + af_function_type_list()}} + | {'attribute', anno(), 'spec', + {{module(), function_name(), arity()}, + af_function_type_list()}}. + +-type spec_attr() :: 'callback' | 'spec'. + +-type af_wild_attribute() :: {'attribute', anno(), atom(), any()}. + +-type af_function_decl() :: + {'function', anno(), function_name(), arity(), af_clause_seq()}. + +-type abstract_expr() :: af_literal() + | af_match(abstract_expr()) + | af_variable() + | af_tuple(abstract_expr()) + | af_nil() + | af_cons(abstract_expr()) + | af_bin(abstract_expr()) + | af_binary_op(abstract_expr()) + | af_unary_op(abstract_expr()) + | af_record_creation(abstract_expr()) + | af_record_update(abstract_expr()) + | af_record_index() + | af_record_field_access(abstract_expr()) + | af_map_creation(abstract_expr()) + | af_map_update(abstract_expr()) + | af_catch() + | af_local_call() + | af_remote_call() + | af_list_comprehension() + | af_binary_comprehension() + | af_block() + | af_if() + | af_case() + | af_try() + | af_receive() + | af_local_fun() + | af_remote_fun() + | af_fun() + | af_named_fun(). + +-type af_record_update(T) :: {'record', + anno(), + abstract_expr(), + record_name(), + [af_record_field(T)]}. + +-type af_catch() :: {'catch', anno(), abstract_expr()}. + +-type af_local_call() :: {'call', anno(), af_local_function(), af_args()}. + +-type af_remote_call() :: {'call', anno(), af_remote_function(), af_args()}. + +-type af_args() :: [abstract_expr()]. + +-type af_local_function() :: abstract_expr(). + +-type af_remote_function() :: + {'remote', anno(), abstract_expr(), abstract_expr()}. + +-type af_list_comprehension() :: + {'lc', anno(), af_template(), af_qualifier_seq()}. + +-type af_binary_comprehension() :: + {'bc', anno(), af_template(), af_qualifier_seq()}. + +-type af_template() :: abstract_expr(). + +-type af_qualifier_seq() :: [af_qualifier()]. + +-type af_qualifier() :: af_generator() | af_filter(). + +-type af_generator() :: {'generate', anno(), af_pattern(), abstract_expr()} + | {'b_generate', anno(), af_pattern(), abstract_expr()}. + +-type af_filter() :: abstract_expr(). + +-type af_block() :: {'block', anno(), af_body()}. + +-type af_if() :: {'if', anno(), af_clause_seq()}. + +-type af_case() :: {'case', anno(), abstract_expr(), af_clause_seq()}. + +-type af_try() :: {'try', + anno(), + af_body() | [], + af_clause_seq() | [], + af_clause_seq() | [], + af_body() | []}. + +-type af_clause_seq() :: [af_clause(), ...]. + +-type af_receive() :: + {'receive', anno(), af_clause_seq()} + | {'receive', anno(), af_clause_seq(), abstract_expr(), af_body()}. + +-type af_local_fun() :: + {'fun', anno(), {'function', function_name(), arity()}}. + +-type af_remote_fun() :: + {'fun', anno(), {'function', module(), function_name(), arity()}} + | {'fun', anno(), {'function', af_atom(), af_atom(), af_integer()}}. + +-type af_fun() :: {'fun', anno(), {'clauses', af_clause_seq()}}. + +-type af_named_fun() :: {'named_fun', anno(), fun_name(), af_clause_seq()}. + +-type fun_name() :: atom(). + +-type abstract_clause() :: af_clause(). + +-type af_clause() :: + {'clause', anno(), [af_pattern()], af_guard_seq(), af_body()}. + +-type af_body() :: [abstract_expr(), ...]. + +-type af_guard_seq() :: [af_guard()]. + +-type af_guard() :: [af_guard_test(), ...]. + +-type af_guard_test() :: af_literal() + | af_variable() + | af_tuple(af_guard_test()) + | af_nil() + | af_cons(af_guard_test()) + | af_bin(af_guard_test()) + | af_binary_op(af_guard_test()) + | af_unary_op(af_guard_test()) + | af_record_creation(af_guard_test()) + | af_record_index() + | af_record_field_access(af_guard_test()) + | af_map_creation(abstract_expr()) + | af_map_update(abstract_expr()) + | af_guard_call() + | af_remote_guard_call(). + +-type af_record_field_access(T) :: + {'record_field', anno(), T, record_name(), af_field_name()}. + +-type af_map_creation(T) :: {'map', anno(), [af_assoc(T)]}. + +-type af_map_update(T) :: {'map', anno(), T, [af_assoc(T)]}. + +-type af_assoc(T) :: {'map_field_assoc', anno(), T, T} + | af_assoc_exact(T). + +-type af_assoc_exact(T) :: {'map_field_exact', anno(), T, T}. + +-type af_guard_call() :: {'call', anno(), function_name(), [af_guard_test()]}. + +-type af_remote_guard_call() :: + {'call', anno(), + {'remote', anno(), af_lit_atom('erlang'), af_atom()}, + [af_guard_test()]}. + +-type af_pattern() :: af_literal() + | af_match(af_pattern()) + | af_variable() + | af_tuple(af_pattern()) + | af_nil() + | af_cons(af_pattern()) + | af_bin(af_pattern()) + | af_binary_op(af_pattern()) + | af_unary_op(af_pattern()) + | af_record_creation(af_pattern()) + | af_record_index() + | af_map_pattern(). + +-type af_record_index() :: + {'record_index', anno(), record_name(), af_field_name()}. + +-type af_record_creation(T) :: + {'record', anno(), record_name(), [af_record_field(T)]}. + +-type af_record_field(T) :: {'record_field', anno(), af_field_name(), T}. + +-type af_map_pattern() :: + {'map', anno(), [af_assoc_exact(abstract_expr)]}. + +-type abstract_type() :: af_annotated_type() + | af_atom() + | af_bitstring_type() + | af_empty_list_type() + | af_fun_type() + | af_integer_range_type() + | af_map_type() + | af_predefined_type() + | af_record_type() + | af_remote_type() + | af_singleton_integer_type() + | af_tuple_type() + | af_type_union() + | af_type_variable() + | af_user_defined_type(). + +-type af_annotated_type() :: + {'ann_type', anno(), [af_anno() | abstract_type()]}. % [Var, Type] + +-type af_anno() :: af_variable(). + +-type af_bitstring_type() :: + {'type', anno(), 'binary', [af_singleton_integer_type()]}. + +-type af_empty_list_type() :: {'type', anno(), 'nil', []}. + +-type af_fun_type() :: {'type', anno(), 'fun', []} + | {'type', anno(), 'fun', [{'type', anno(), 'any'} | + abstract_type()]} + | {'type', anno(), 'fun', af_function_type()}. + +-type af_integer_range_type() :: + {'type', anno(), 'range', [af_singleton_integer_type()]}. + +-type af_map_type() :: {'type', anno(), 'map', 'any'} + | {'type', anno(), 'map', [af_assoc_type()]}. + +-type af_assoc_type() :: + {'type', anno(), 'map_field_assoc', [abstract_type()]} + | {'type', anno(), 'map_field_exact', [abstract_type()]}. + +-type af_predefined_type() :: + {'type', anno(), type_name(), [abstract_type()]}. + +-type af_record_type() :: + {'type', anno(), 'record', [(Name :: af_atom()) % [Name, T1, ... Tk] + | af_record_field_type()]}. + +-type af_record_field_type() :: + {'type', anno(), 'field_type', [(Name :: af_atom()) | + abstract_type()]}. % [Name, Type] + +-type af_remote_type() :: + {'remote_type', anno(), [(Module :: af_atom()) | + (TypeName :: af_atom()) | + [abstract_type()]]}. % [Module, Name, [T]] + +-type af_tuple_type() :: {'type', anno(), 'tuple', 'any'} + | {'type', anno(), 'tuple', [abstract_type()]}. + +-type af_type_union() :: {'type', anno(), 'union', [abstract_type()]}. + +-type af_type_variable() :: {'var', anno(), atom()}. % except '_' + +-type af_user_defined_type() :: + {'user_type', anno(), type_name(), [abstract_type()]}. + +-type af_function_type_list() :: [af_constrained_function_type() | + af_function_type()]. + +-type af_constrained_function_type() :: + {'type', anno(), 'bounded_fun', [af_function_type() | % [Ft, Fc] + af_function_constraint()]}. + +-type af_function_type() :: + {'type', anno(), 'fun', + [{'type', anno(), 'product', [abstract_type()]} | abstract_type()]}. + +-type af_function_constraint() :: [af_constraint()]. + +-type af_constraint() :: {'type', anno(), 'constraint', + af_lit_atom('is_subtype'), + [af_type_variable() | abstract_type()]}. % [V, T] + +-type af_singleton_integer_type() :: af_integer() + | af_unary_op(af_singleton_integer_type()) + | af_binary_op(af_singleton_integer_type()). + +-type af_literal() :: af_atom() + | af_character() + | af_float() + | af_integer() + | af_string(). + +-type af_atom() :: af_lit_atom(atom()). + +-type af_lit_atom(A) :: {'atom', anno(), A}. + +-type af_character() :: {'char', anno(), char()}. + +-type af_float() :: {'float', anno(), float()}. + +-type af_integer() :: {'integer', anno(), non_neg_integer()}. + +-type af_string() :: {'string', anno(), string()}. + +-type af_match(T) :: {'match', anno(), af_pattern(), T}. + +-type af_variable() :: {'var', anno(), atom()}. % | af_anon_variable() + +%-type af_anon_variable() :: {'var', anno(), '_'}. + +-type af_tuple(T) :: {'tuple', anno(), [T]}. + +-type af_nil() :: {'nil', anno()}. + +-type af_cons(T) :: {'cons', anno(), T, T}. + +-type af_bin(T) :: {'bin', anno(), [af_binelement(T)]}. + +-type af_binelement(T) :: {'bin_element', + anno(), + T, + af_binelement_size(), + type_specifier_list()}. + +-type af_binelement_size() :: 'default' | abstract_expr(). + +-type af_binary_op(T) :: {'op', anno(), binary_op(), T, T}. + +-type binary_op() :: '/' | '*' | 'div' | 'rem' | 'band' | 'and' | '+' | '-' + | 'bor' | 'bxor' | 'bsl' | 'bsr' | 'or' | 'xor' | '++' + | '--' | '==' | '/=' | '=<' | '<' | '>=' | '>' | '=:=' + | '=/='. + +-type af_unary_op(T) :: {'op', anno(), unary_op(), T}. + +-type unary_op() :: '+' | '*' | 'bnot' | 'not'. + +%% See also lib/stdlib/{src/erl_bits.erl,include/erl_bits.hrl}. +-type type_specifier_list() :: 'default' | [type_specifier(), ...]. + +-type type_specifier() :: type() + | signedness() + | endianness() + | unit(). + +-type type() :: 'integer' + | 'float' + | 'binary' + | 'bytes' + | 'bitstring' + | 'bits' + | 'utf8' + | 'utf16' + | 'utf32'. + +-type signedness() :: 'signed' | 'unsigned'. + +-type endianness() :: 'big' | 'little' | 'native'. + +-type unit() :: {'unit', 1..256}. + +-type record_name() :: atom(). + +-type af_field_name() :: af_atom(). + +-type function_name() :: atom(). + +-type type_name() :: atom(). + +-type form_info() :: {'eof', erl_anno:line()} + | {'error', erl_scan:error_info() | error_info()} + | {'warning', erl_scan:error_info() | error_info()}. + +%% End of Abstract Format %% XXX. To be refined. --type abstract_clause() :: term(). --type abstract_expr() :: term(). --type abstract_form() :: term(). -type error_description() :: term(). -type error_info() :: {erl_anno:line(), module(), error_description()}. -type token() :: erl_scan:token(). @@ -639,14 +1046,8 @@ build_type_spec({Kind,Aa}, {SpecFun, TypeSpecs}) {atom, _, Fun} -> {Fun, find_arity_from_specs(TypeSpecs)}; {{atom,_, Mod}, {atom,_, Fun}} -> - {Mod,Fun,find_arity_from_specs(TypeSpecs)}; - {{atom, _, Fun}, {integer, _, Arity}} -> - %% Old style spec. Allow this for now. - {Fun,Arity}; - {{atom,_, Mod}, {atom, _, Fun}, {integer, _, Arity}} -> - %% Old style spec. Allow this for now. - {Mod,Fun,Arity} - end, + {Mod,Fun,find_arity_from_specs(TypeSpecs)} + end, {attribute,Aa,Kind,{NewSpecFun, TypeSpecs}}. find_arity_from_specs([Spec|_]) -> @@ -795,31 +1196,11 @@ record_fields([{match,_Am,{atom,Aa,A},Expr}|Fields]) -> [{record_field,Aa,{atom,Aa,A},Expr}|record_fields(Fields)]; record_fields([{typed,Expr,TypeInfo}|Fields]) -> [Field] = record_fields([Expr]), - TypeInfo1 = - case Expr of - {match, _, _, _} -> TypeInfo; %% If we have an initializer. - {atom, Aa, _} -> - case has_undefined(TypeInfo) of - false -> - lift_unions(abstract2(undefined, Aa), TypeInfo); - true -> - TypeInfo - end - end, - [{typed_record_field,Field,TypeInfo1}|record_fields(Fields)]; + [{typed_record_field,Field,TypeInfo}|record_fields(Fields)]; record_fields([Other|_Fields]) -> ret_err(?anno(Other), "bad record field"); record_fields([]) -> []. -has_undefined({atom,_,undefined}) -> - true; -has_undefined({ann_type,_,[_,T]}) -> - has_undefined(T); -has_undefined({type,_,union,Ts}) -> - lists:any(fun has_undefined/1, Ts); -has_undefined(_) -> - false. - term(Expr) -> try normalise(Expr) catch _:_R -> ret_err(?anno(Expr), "bad attribute") @@ -1118,47 +1499,31 @@ type_preop_prec('-') -> {600,700}; type_preop_prec('bnot') -> {600,700}; type_preop_prec('#') -> {700,800}. -%%% [Experimental]. The parser just copies the attributes of the -%%% scanner tokens to the abstract format. This design decision has -%%% been hidden to some extent: use set_line() and get_attribute() to -%%% access the second element of (almost all) of the abstract format -%%% tuples. A typical use is to negate line numbers to prevent the -%%% compiler from emitting warnings and errors. The second element can -%%% (of course) be set to any value, but then these functions no -%%% longer apply. To get all present attributes as a property list -%%% get_attributes() should be used. - --compile({nowarn_deprecated_function,{erl_scan,set_attribute,3}}). -set_line(L, F) -> - erl_scan:set_attribute(line, L, F). - --compile({nowarn_deprecated_function,{erl_scan,attributes_info,2}}). -get_attribute(L, Name) -> - erl_scan:attributes_info(L, Name). - --compile({nowarn_deprecated_function,{erl_scan,attributes_info,1}}). -get_attributes(L) -> - erl_scan:attributes_info(L). +-type erl_parse_tree() :: abstract_clause() + | abstract_expr() + | abstract_form() + | abstract_type(). -spec map_anno(Fun, Abstr) -> NewAbstr when - Fun :: fun((Anno) -> Anno), + Fun :: fun((Anno) -> NewAnno), Anno :: erl_anno:anno(), - Abstr :: abstract_form() | abstract_expr(), - NewAbstr :: abstract_form() | abstract_expr(). + NewAnno :: erl_anno:anno(), + Abstr :: erl_parse_tree(), + NewAbstr :: erl_parse_tree(). map_anno(F0, Abstr) -> F = fun(A, Acc) -> {F0(A), Acc} end, {NewAbstr, []} = modify_anno1(Abstr, [], F), NewAbstr. --spec fold_anno(Fun, Acc0, Abstr) -> NewAbstr when +-spec fold_anno(Fun, Acc0, Abstr) -> Acc1 when Fun :: fun((Anno, AccIn) -> AccOut), Anno :: erl_anno:anno(), Acc0 :: term(), + Acc1 :: term(), AccIn :: term(), AccOut :: term(), - Abstr :: abstract_form() | abstract_expr(), - NewAbstr :: abstract_form() | abstract_expr(). + Abstr :: erl_parse_tree(). fold_anno(F0, Acc0, Abstr) -> F = fun(A, Acc) -> {A, F0(A, Acc)} end, @@ -1166,32 +1531,35 @@ fold_anno(F0, Acc0, Abstr) -> NewAcc. -spec mapfold_anno(Fun, Acc0, Abstr) -> {NewAbstr, Acc1} when - Fun :: fun((Anno, AccIn) -> {Anno, AccOut}), + Fun :: fun((Anno, AccIn) -> {NewAnno, AccOut}), Anno :: erl_anno:anno(), + NewAnno :: erl_anno:anno(), Acc0 :: term(), Acc1 :: term(), AccIn :: term(), AccOut :: term(), - Abstr :: abstract_form() | abstract_expr(), - NewAbstr :: abstract_form() | abstract_expr(). + Abstr :: erl_parse_tree(), + NewAbstr :: erl_parse_tree(). mapfold_anno(F, Acc0, Abstr) -> modify_anno1(Abstr, Acc0, F). -spec new_anno(Term) -> Abstr when Term :: term(), - Abstr :: abstract_form() | abstract_expr(). + Abstr :: erl_parse_tree(). new_anno(Term) -> - map_anno(fun erl_anno:new/1, Term). + F = fun(L, Acc) -> {erl_anno:new(L), Acc} end, + {NewAbstr, []} = modify_anno1(Term, [], F), + NewAbstr. -spec anno_to_term(Abstr) -> term() when - Abstr :: abstract_form() | abstract_expr(). + Abstr :: erl_parse_tree(). anno_to_term(Abstract) -> map_anno(fun erl_anno:to_term/1, Abstract). --spec anno_from_term(Term) -> abstract_form() | abstract_expr() when +-spec anno_from_term(Term) -> erl_parse_tree() when Term :: term(). anno_from_term(Term) -> diff --git a/lib/stdlib/src/erl_posix_msg.erl b/lib/stdlib/src/erl_posix_msg.erl index 5eac230631..bfafca1ff7 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-2010. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/lib/stdlib/src/erl_pp.erl b/lib/stdlib/src/erl_pp.erl index f7a969977a..d30cd508c1 100644 --- a/lib/stdlib/src/erl_pp.erl +++ b/lib/stdlib/src/erl_pp.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2015. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -70,19 +70,19 @@ %%% -spec(form(Form) -> io_lib:chars() when - Form :: erl_parse:abstract_form()). + Form :: erl_parse:abstract_form() | erl_parse:form_info()). form(Thing) -> form(Thing, none). -spec(form(Form, Options) -> io_lib:chars() when - Form :: erl_parse:abstract_form(), + Form :: erl_parse:abstract_form() | erl_parse:form_info(), Options :: options()). form(Thing, Options) -> ?TEST(Thing), State = state(Options), - frmt(lform(Thing, options(Options), State), State). + frmt(lform(Thing, options(Options)), State). -spec(attribute(Attribute) -> io_lib:chars() when Attribute :: erl_parse:abstract_form()). @@ -97,7 +97,7 @@ attribute(Thing) -> attribute(Thing, Options) -> ?TEST(Thing), State = state(Options), - frmt(lattribute(Thing, options(Options), State), State). + frmt(lattribute(Thing, options(Options)), State). -spec(function(Function) -> io_lib:chars() when Function :: erl_parse:abstract_form()). @@ -217,53 +217,55 @@ encoding(Options) -> unicode -> unicode end. -lform({attribute,Line,Name,Arg}, Opts, State) -> - lattribute({attribute,Line,Name,Arg}, Opts, State); -lform({function,Line,Name,Arity,Clauses}, Opts, _State) -> +lform({attribute,Line,Name,Arg}, Opts) -> + lattribute({attribute,Line,Name,Arg}, Opts); +lform({function,Line,Name,Arity,Clauses}, Opts) -> lfunction({function,Line,Name,Arity,Clauses}, Opts); %% These are specials to make it easier for the compiler. -lform({error,E}, _Opts, _State) -> +lform({error,E}, _Opts) -> leaf(format("~p\n", [{error,E}])); -lform({warning,W}, _Opts, _State) -> +lform({warning,W}, _Opts) -> leaf(format("~p\n", [{warning,W}])); -lform({eof,_Line}, _Opts, _State) -> +lform({eof,_Line}, _Opts) -> $\n. -lattribute({attribute,_Line,type,Type}, Opts, _State) -> +lattribute({attribute,_Line,type,Type}, Opts) -> [typeattr(type, Type, Opts),leaf(".\n")]; -lattribute({attribute,_Line,opaque,Type}, Opts, _State) -> +lattribute({attribute,_Line,opaque,Type}, Opts) -> [typeattr(opaque, Type, Opts),leaf(".\n")]; -lattribute({attribute,_Line,spec,Arg}, _Opts, _State) -> +lattribute({attribute,_Line,spec,Arg}, _Opts) -> [specattr(spec, Arg),leaf(".\n")]; -lattribute({attribute,_Line,callback,Arg}, _Opts, _State) -> +lattribute({attribute,_Line,callback,Arg}, _Opts) -> [specattr(callback, Arg),leaf(".\n")]; -lattribute({attribute,_Line,Name,Arg}, Opts, State) -> - [lattribute(Name, Arg, Opts, State),leaf(".\n")]. +lattribute({attribute,_Line,Name,Arg}, Opts) -> + [lattribute(Name, Arg, Opts),leaf(".\n")]. -lattribute(module, {M,Vs}, _Opts, _State) -> +lattribute(module, {M,Vs}, _Opts) -> A = a0(), attr("module",[{var,A,pname(M)}, foldr(fun(V, C) -> {cons,A,{var,A,V},C} end, {nil,A}, Vs)]); -lattribute(module, M, _Opts, _State) -> +lattribute(module, M, _Opts) -> attr("module", [{var,a0(),pname(M)}]); -lattribute(export, Falist, _Opts, _State) -> +lattribute(export, Falist, _Opts) -> call({var,a0(),"-export"}, [falist(Falist)], 0, options(none)); -lattribute(import, Name, _Opts, _State) when is_list(Name) -> +lattribute(import, Name, _Opts) when is_list(Name) -> attr("import", [{var,a0(),pname(Name)}]); -lattribute(import, {From,Falist}, _Opts, _State) -> +lattribute(import, {From,Falist}, _Opts) -> attr("import",[{var,a0(),pname(From)},falist(Falist)]); -lattribute(optional_callbacks, Falist, Opts, _State) -> +lattribute(export_type, Talist, _Opts) -> + call({var,a0(),"-export_type"}, [falist(Talist)], 0, options(none)); +lattribute(optional_callbacks, Falist, Opts) -> ArgL = try falist(Falist) catch _:_ -> abstract(Falist, Opts) end, call({var,a0(),"-optional_callbacks"}, [ArgL], 0, options(none)); -lattribute(file, {Name,Line}, _Opts, State) -> - attr("file", [{var,a0(),(State#pp.string_fun)(Name)},{integer,a0(),Line}]); -lattribute(record, {Name,Is}, Opts, _State) -> +lattribute(file, {Name,Line}, _Opts) -> + attr("file", [{string,a0(),Name},{integer,a0(),Line}]); +lattribute(record, {Name,Is}, Opts) -> Nl = leaf(format("-record(~w,", [Name])), [{first,Nl,record_fields(Is, Opts)},$)]; -lattribute(Name, Arg, Options, _State) -> +lattribute(Name, Arg, Options) -> attr(write(Name), [abstract(Arg, Options)]). abstract(Arg, #options{encoding = Encoding}) -> @@ -321,7 +323,6 @@ ltype({type,_,'fun',[{type,_,any},_]}=FunType, _) -> ltype({type,_Line,'fun',[{type,_,product,_},_]}=FunType, _) -> [fun_type(['fun',$(], FunType),$)]; ltype({type,Line,T,Ts}, _) -> - %% Compatibility. Before 18.0. simple_type({atom,Line,T}, Ts); ltype({user_type,Line,T,Ts}, _) -> simple_type({atom,Line,T}, Ts); @@ -346,16 +347,10 @@ map_type(Fs) -> map_pair_types(Fs) -> tuple_type(Fs, fun map_pair_type/2). -map_pair_type({type,_Line,map_field_assoc,[Ktype,Vtype]}, Prec) -> - map_assoc_typed(ltype(Ktype), Vtype, Prec). - -map_assoc_typed(B, {type,_,union,Ts}, Prec) -> - {first,[B,$\s],{seq,[],[],[],map_assoc_union_type(Ts, Prec)}}; -map_assoc_typed(B, Type, Prec) -> - {list,[{cstep,[B," =>"],ltype(Type, Prec)}]}. - -map_assoc_union_type([T|Ts], Prec) -> - [[leaf("=> "),ltype(T)] | ltypes(Ts, fun union_elem/2, Prec)]. +map_pair_type({type,_Line,map_field_assoc,[KType,VType]}, Prec) -> + {list,[{cstep,[ltype(KType, Prec),leaf(" =>")],ltype(VType, Prec)}]}; +map_pair_type({type,_Line,map_field_exact,[KType,VType]}, Prec) -> + {list,[{cstep,[ltype(KType, Prec),leaf(" :=")],ltype(VType, Prec)}]}. record_type(Name, Fields) -> {first,[record_name(Name)],field_types(Fields)}. @@ -370,9 +365,6 @@ typed(B, Type) -> {_L,_P,R} = type_inop_prec('::'), {list,[{cstep,[B,' ::'],ltype(Type, R)}]}. -union_elem(T, Prec) -> - [leaf(" | "),ltype(T, Prec)]. - tuple_type(Ts, F) -> {seq,${,$},[$,],ltypes(Ts, F, 0)}. @@ -399,6 +391,9 @@ guard_type(Before, Gs) -> Gl = {list,[{step,'when',expr_list(Gs, [$,], fun constraint/2, Opts)}]}, {list,[{step,Before,Gl}]}. +constraint({type,_Line,constraint,[{atom,_,is_subtype},[{var,_,_}=V,Type]]}, + _Opts) -> + typed(lexpr(V, options(none)), Type); constraint({type,_Line,constraint,[Tag,As]}, _Opts) -> simple_type(Tag, As). diff --git a/lib/stdlib/src/erl_scan.erl b/lib/stdlib/src/erl_scan.erl index d2f53816b8..47223b129c 100644 --- a/lib/stdlib/src/erl_scan.erl +++ b/lib/stdlib/src/erl_scan.erl @@ -52,25 +52,15 @@ %%% External exports -export([string/1,string/2,string/3,tokens/3,tokens/4, - format_error/1,reserved_word/1, - token_info/1,token_info/2, - attributes_info/1,attributes_info/2,set_attribute/3]). + format_error/1,reserved_word/1]). -export([column/1,end_location/1,line/1,location/1,text/1, category/1,symbol/1]). --deprecated([{attributes_info, 1, next_major_release}, - {attributes_info, 2, next_major_release}, - {set_attribute, 3, next_major_release}, - {token_info, 1, next_major_release}, - {token_info, 2, next_major_release}]). - %%% Private -export([continuation_location/1]). -export_type([error_info/0, - line/0, - location/0, options/0, return_cont/0, token/0, @@ -85,29 +75,18 @@ -define(ALINE(L), is_integer(L)). -define(STRING(S), is_list(S)). -define(RESWORDFUN(F), is_function(F, 1)). --define(SETATTRFUN(F), is_function(F, 1)). -type category() :: atom(). --type column() :: pos_integer(). % Deprecated --type line() :: integer(). % Deprecated --type location() :: line() | {line(),column()}. % Deprecated -type resword_fun() :: fun((atom()) -> boolean()). -type option() :: 'return' | 'return_white_spaces' | 'return_comments' | 'text' | {'reserved_word_fun', resword_fun()}. -type options() :: option() | [option()]. -type symbol() :: atom() | float() | integer() | string(). --type info_line() :: integer() | term(). --type attributes_data() - :: [{'column', column()} | {'line', info_line()} | {'text', string()}] - | {line(), column()}. -%% The fact that {line(),column()} is a possible attributes() type -%% is hidden. --type attributes() :: line() | attributes_data(). --type token() :: {category(), attributes(), symbol()} - | {category(), attributes()}. +-type token() :: {category(), Anno :: erl_anno:anno(), symbol()} + | {category(), Anno :: erl_anno:anno()}. -type tokens() :: [token()]. -type error_description() :: term(). --type error_info() :: {location(), module(), error_description()}. +-type error_info() :: {erl_anno:location(), module(), error_description()}. %%% Local record. -record(erl_scan, @@ -136,8 +115,8 @@ format_error(Other) -> String :: string(), Return :: {'ok', Tokens :: tokens(), EndLocation} | {'error', ErrorInfo :: error_info(), ErrorLocation}, - EndLocation :: location(), - ErrorLocation :: location(). + EndLocation :: erl_anno:location(), + ErrorLocation :: erl_anno:location(). string(String) -> string(String, 1, []). @@ -145,9 +124,9 @@ string(String) -> String :: string(), Return :: {'ok', Tokens :: tokens(), EndLocation} | {'error', ErrorInfo :: error_info(), ErrorLocation}, - StartLocation :: location(), - EndLocation :: location(), - ErrorLocation :: location(). + StartLocation :: erl_anno:location(), + EndLocation :: erl_anno:location(), + ErrorLocation :: erl_anno:location(). string(String, StartLocation) -> string(String, StartLocation, []). @@ -156,9 +135,9 @@ string(String, StartLocation) -> Options :: options(), Return :: {'ok', Tokens :: tokens(), EndLocation} | {'error', ErrorInfo :: error_info(), ErrorLocation}, - StartLocation :: location(), - EndLocation :: location(), - ErrorLocation :: location(). + StartLocation :: erl_anno:location(), + EndLocation :: erl_anno:location(), + ErrorLocation :: erl_anno:location(). string(String, Line, Options) when ?STRING(String), ?ALINE(Line) -> string1(String, options(Options), Line, no_col, []); string(String, {Line,Column}, Options) when ?STRING(String), @@ -167,20 +146,23 @@ string(String, {Line,Column}, Options) when ?STRING(String), string1(String, options(Options), Line, Column, []). -type char_spec() :: string() | 'eof'. --type cont_fun() :: fun((char_spec(), #erl_scan{}, line(), column(), +-type cont_fun() :: fun((char_spec(), #erl_scan{}, + erl_anno:line(), erl_anno:column(), tokens(), any()) -> any()). -opaque return_cont() :: {erl_scan_continuation, - string(), column(), tokens(), line(), + string(), erl_anno:column(), tokens(), + erl_anno:line(), #erl_scan{}, any(), cont_fun()}. --type tokens_result() :: {'ok', Tokens :: tokens(), EndLocation :: location()} - | {'eof', EndLocation :: location()} +-type tokens_result() :: {'ok', Tokens :: tokens(), + EndLocation :: erl_anno:location()} + | {'eof', EndLocation :: erl_anno:location()} | {'error', ErrorInfo :: error_info(), - EndLocation :: location()}. + EndLocation :: erl_anno:location()}. -spec tokens(Continuation, CharSpec, StartLocation) -> Return when Continuation :: return_cont() | [], CharSpec :: char_spec(), - StartLocation :: location(), + StartLocation :: erl_anno:location(), Return :: {'done',Result :: tokens_result(),LeftOverChars :: char_spec()} | {'more', Continuation1 :: return_cont()}. tokens(Cont, CharSpec, StartLocation) -> @@ -189,7 +171,7 @@ tokens(Cont, CharSpec, StartLocation) -> -spec tokens(Continuation, CharSpec, StartLocation, Options) -> Return when Continuation :: return_cont() | [], CharSpec :: char_spec(), - StartLocation :: location(), + StartLocation :: erl_anno:location(), Options :: options(), Return :: {'done',Result :: tokens_result(),LeftOverChars :: char_spec()} | {'more', Continuation1 :: return_cont()}. @@ -257,155 +239,6 @@ symbol({_Category,_Anno,Symbol}) -> symbol(T) -> erlang:error(badarg, [T]). --type attribute_item() :: 'column' | 'length' | 'line' - | 'location' | 'text'. --type info_location() :: location() | term(). --type attribute_info() :: {'column', column()}| {'length', pos_integer()} - | {'line', info_line()} - | {'location', info_location()} - | {'text', string()}. --type token_item() :: 'category' | 'symbol' | attribute_item(). --type token_info() :: {'category', category()} | {'symbol', symbol()} - | attribute_info(). - --spec token_info(Token) -> TokenInfo when - Token :: token(), - TokenInfo :: [TokenInfoTuple :: token_info()]. -token_info(Token) -> - Items = [category,column,length,line,symbol,text], % undefined order - token_info(Token, Items). - --spec token_info(Token, TokenItem) -> TokenInfoTuple | 'undefined' when - Token :: token(), - TokenItem :: token_item(), - TokenInfoTuple :: token_info(); - (Token, TokenItems) -> TokenInfo when - Token :: token(), - TokenItems :: [TokenItem :: token_item()], - TokenInfo :: [TokenInfoTuple :: token_info()]. -token_info(_Token, []) -> - []; -token_info(Token, [Item|Items]) when is_atom(Item) -> - case token_info(Token, Item) of - undefined -> - token_info(Token, Items); - TokenInfo when is_tuple(TokenInfo) -> - [TokenInfo|token_info(Token, Items)] - end; -token_info({Category,_Attrs}, category=Item) -> - {Item,Category}; -token_info({Category,_Attrs,_Symbol}, category=Item) -> - {Item,Category}; -token_info({Category,_Attrs}, symbol=Item) -> - {Item,Category}; -token_info({_Category,_Attrs,Symbol}, symbol=Item) -> - {Item,Symbol}; -token_info({_Category,Attrs}, Item) -> - attributes_info(Attrs, Item); -token_info({_Category,Attrs,_Symbol}, Item) -> - attributes_info(Attrs, Item). - --spec attributes_info(Attributes) -> AttributesInfo when - Attributes :: attributes(), - AttributesInfo :: [AttributeInfoTuple :: attribute_info()]. -attributes_info(Attributes) -> - Items = [column,length,line,text], % undefined order - attributes_info(Attributes, Items). - --spec attributes_info - (Attributes, AttributeItem) -> AttributeInfoTuple | 'undefined' when - Attributes :: attributes(), - AttributeItem :: attribute_item(), - AttributeInfoTuple :: attribute_info(); - (Attributes, AttributeItems) -> AttributeInfo when - Attributes :: attributes(), - AttributeItems :: [AttributeItem :: attribute_item()], - AttributeInfo :: [AttributeInfoTuple :: attribute_info()]. -attributes_info(_Attrs, []) -> - []; -attributes_info(Attrs, [A|As]) when is_atom(A) -> - case attributes_info(Attrs, A) of - undefined -> - attributes_info(Attrs, As); - AttributeInfo when is_tuple(AttributeInfo) -> - [AttributeInfo|attributes_info(Attrs, As)] - end; -attributes_info({Line,Column}, column=Item) when ?ALINE(Line), - ?COLUMN(Column) -> - {Item,Column}; -attributes_info(Line, column) when ?ALINE(Line) -> - undefined; -attributes_info(Attrs, column=Item) -> - case attr_info(Attrs, Item) of - undefined -> - case erl_anno:column(Attrs) of - undefined -> - undefined; - Column -> - {Item,Column} - end; - T -> - T - end; -attributes_info(Attrs, length=Item) -> - case attributes_info(Attrs, text) of - undefined -> - undefined; - {text,Text} -> - {Item,length(Text)} - end; -attributes_info(Line, line=Item) when ?ALINE(Line) -> - {Item,Line}; -attributes_info({Line,Column}, line=Item) when ?ALINE(Line), - ?COLUMN(Column) -> - {Item,Line}; -attributes_info(Attrs, line=Item) -> - case attr_info(Attrs, Item) of - undefined -> - case attr_info(Attrs, location) of - {location,{Line,_Column}} -> - {Item,Line}; - {location,Line} -> - {Item,Line}; - undefined -> - undefined - end; - T -> - T - end; -attributes_info({Line,Column}=Location, location=Item) when ?ALINE(Line), - ?COLUMN(Column) -> - {Item,Location}; -attributes_info(Line, location=Item) when ?ALINE(Line) -> - {Item,Line}; -attributes_info(Attrs, location=Item) -> - {line,Line} = attributes_info(Attrs, line), - case attributes_info(Attrs, column) of - undefined -> - %% If set_attribute() has assigned a term such as {17,42} - %% to 'line', then Line will look like {Line,Column}. One - %% should not use 'location' but 'line' and 'column' in - %% such special cases. - {Item,Line}; - {column,Column} -> - {Item,{Line,Column}} - end; -attributes_info({Line,Column}, text) when ?ALINE(Line), ?COLUMN(Column) -> - undefined; -attributes_info(Line, text) when ?ALINE(Line) -> - undefined; -attributes_info(Attrs, text=Item) -> - attr_info(Attrs, Item); -attributes_info(T1, T2) -> - erlang:error(badarg, [T1,T2]). - --spec set_attribute(AttributeItem, Attributes, SetAttributeFun) -> Attributes when - AttributeItem :: 'line', - Attributes :: attributes(), - SetAttributeFun :: fun((info_line()) -> info_line()). -set_attribute(Tag, Attributes, Fun) when ?SETATTRFUN(Fun) -> - set_attr(Tag, Attributes, Fun). - %%% %%% Local functions %%% @@ -471,62 +304,6 @@ expand_opt(return, Os) -> expand_opt(O, Os) -> [O|Os]. -attr_info(Attrs, Item) -> - try lists:keyfind(Item, 1, Attrs) of - {_Item, _Value} = T -> - T; - false -> - undefined - catch - _:_ -> - erlang:error(badarg, [Attrs, Item]) - end. - --spec set_attr('line', attributes(), fun((line()) -> line())) -> attributes(). - -set_attr(line, Line, Fun) when ?ALINE(Line) -> - Ln = Fun(Line), - if - ?ALINE(Ln) -> - Ln; - true -> - [{line,Ln}] - end; -set_attr(line, {Line,Column}, Fun) when ?ALINE(Line), ?COLUMN(Column) -> - Ln = Fun(Line), - if - ?ALINE(Ln) -> - {Ln,Column}; - true -> - [{line,Ln},{column,Column}] - end; -set_attr(line=Tag, Attrs, Fun) when is_list(Attrs) -> - case lists:keyfind(Tag, 1, Attrs) of - {line,Line} -> - case lists:keyreplace(Tag, 1, Attrs, {line,Fun(Line)}) of - [{line,Ln}] when ?ALINE(Ln) -> - Ln; - As -> - As - end; - false -> - {location, Location} = lists:keyfind(location, 1, Attrs), - Ln = case Location of - {Line,Column} when ?ALINE(Line), ?COLUMN(Column) -> - {Fun(Line),Column}; - _ -> - Fun(Location) - end, - case lists:keyreplace(location, 1, Attrs, {location,Ln}) of - [{location,Ln}] when ?ALINE(Ln) -> - Ln; - As -> - As - end - end; -set_attr(T1, T2, T3) -> - erlang:error(badarg, [T1,T2,T3]). - tokens1(Cs, St, Line, Col, Toks, Fun, Any) when ?STRING(Cs); Cs =:= eof -> case Fun(Cs, St, Line, Col, Toks, Any) of {more,{Cs0,Ncol,Ntoks,Nline,Nany,Nfun}} -> diff --git a/lib/stdlib/src/erl_tar.erl b/lib/stdlib/src/erl_tar.erl index d0e7a827a8..a383a0fc67 100644 --- a/lib/stdlib/src/erl_tar.erl +++ b/lib/stdlib/src/erl_tar.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/lib/stdlib/src/error_logger_file_h.erl b/lib/stdlib/src/error_logger_file_h.erl index a7f3615972..665685d3ee 100644 --- a/lib/stdlib/src/error_logger_file_h.erl +++ b/lib/stdlib/src/error_logger_file_h.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2012. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -24,24 +24,28 @@ %%% %%% A handler that can be connected to the error_logger -%%% event handler. -%%% Writes all events formatted to file. -%%% Handles events tagged error, emulator and info. +%%% event handler. Writes all events formatted to file. %%% %%% It can only be started from error_logger:swap_handler({logfile, File}) -%%% or error_logger:logfile(File) +%%% or error_logger:logfile(File). %%% -export([init/1, handle_event/2, handle_call/2, handle_info/2, terminate/2, code_change/3]). +-record(st, + {fd, + filename, + prev_handler, + depth=unlimited :: 'unlimited' | non_neg_integer()}). + %% This one is used when we takeover from the simple error_logger. init({File, {error_logger, Buf}}) -> case init(File, error_logger) of - {ok, {Fd, File, PrevHandler}} -> - write_events(Fd, Buf), - {ok, {Fd, File, PrevHandler}}; + {ok, State} -> + write_events(State, Buf), + {ok, State}; Error -> Error end; @@ -53,49 +57,45 @@ init(File, PrevHandler) -> process_flag(trap_exit, true), case file:open(File, [write]) of {ok,Fd} -> - {ok, {Fd, File, PrevHandler}}; + Depth = get_depth(), + State = #st{fd=Fd,filename=File,prev_handler=PrevHandler, + depth=Depth}, + {ok, State}; Error -> Error end. - + +get_depth() -> + case application:get_env(kernel, error_logger_format_depth) of + {ok, Depth} when is_integer(Depth) -> + max(10, Depth); + undefined -> + unlimited + end. + handle_event({_Type, GL, _Msg}, State) when node(GL) =/= node() -> {ok, State}; -handle_event(Event, {Fd, File, PrevHandler}) -> - write_event(Fd, tag_event(Event)), - {ok, {Fd, File, PrevHandler}}; -handle_event(_, State) -> +handle_event(Event, State) -> + write_event(State, Event), {ok, State}. -handle_info({'EXIT', Fd, _Reason}, {Fd, _File, PrevHandler}) -> +handle_info({'EXIT', Fd, _Reason}, #st{fd=Fd,prev_handler=PrevHandler}) -> case PrevHandler of [] -> remove_handler; _ -> {swap_handler, install_prev, [], PrevHandler, go_back} end; -handle_info({emulator, GL, Chars}, {Fd, File, PrevHandler}) - when node(GL) == node() -> - write_event(Fd, tag_event({emulator, GL, Chars})), - {ok, {Fd, File, PrevHandler}}; -handle_info({emulator, noproc, Chars}, {Fd, File, PrevHandler}) -> - write_event(Fd, tag_event({emulator, noproc, Chars})), - {ok, {Fd, File, PrevHandler}}; handle_info(_, State) -> {ok, State}. -handle_call(filename, {Fd, File, Prev}) -> - {ok, File, {Fd, File, Prev}}; +handle_call(filename, #st{filename=File}=State) -> + {ok, File, State}; handle_call(_Query, State) -> {ok, {error, bad_query}, State}. -terminate(_Reason, State) -> - case State of - {Fd, _File, _Prev} -> - ok = file:close(Fd); - _ -> - ok - end, - []. +terminate(_Reason, #st{fd=Fd}) -> + file:close(Fd). code_change(_OldVsn, State, _Extra) -> {ok, State}. @@ -104,69 +104,73 @@ code_change(_OldVsn, State, _Extra) -> %%% Misc. functions. %%% ------------------------------------------------------ -tag_event(Event) -> - {erlang:universaltime(), Event}. +write_events(State, [Ev|Es]) -> + %% Write the events in reversed order. + write_events(State, Es), + write_event(State, Ev); +write_events(_State, []) -> + ok. -write_events(Fd, Events) -> write_events1(Fd, lists:reverse(Events)). +write_event(#st{fd=Fd}=State, Event) -> + case parse_event(Event) of + ignore -> + ok; + {Head,Pid,FormatList} -> + Time = maybe_utc(erlang:universaltime()), + Header = write_time(Time, Head), + Body = format_body(State, FormatList), + AtNode = if + node(Pid) =/= node() -> + ["** at node ",atom_to_list(node(Pid))," **\n"]; + true -> + [] + end, + io:put_chars(Fd, [Header,Body,AtNode]) + end. -write_events1(Fd, [Event|Es]) -> - write_event(Fd, Event), - write_events1(Fd, Es); -write_events1(_, []) -> - ok. +format_body(State, [{Format,Args}|T]) -> + S = try format(State, Format, Args) of + S0 -> + S0 + catch + _:_ -> + format(State, "ERROR: ~p - ~p\n", [Format,Args]) + end, + [S|format_body(State, T)]; +format_body(_State, []) -> + []. -write_event(Fd, {Time, {error, _GL, {Pid, Format, Args}}}) -> - T = write_time(maybe_utc(Time)), - case catch io_lib:format(add_node(Format,Pid), Args) of - S when is_list(S) -> - io:format(Fd, T ++ S, []); - _ -> - F = add_node("ERROR: ~p - ~p~n", Pid), - io:format(Fd, T ++ F, [Format,Args]) - end; -write_event(Fd, {Time, {emulator, _GL, Chars}}) -> - T = write_time(maybe_utc(Time)), - case catch io_lib:format(Chars, []) of - S when is_list(S) -> - io:format(Fd, T ++ S, []); - _ -> - io:format(Fd, T ++ "ERROR: ~p ~n", [Chars]) - end; -write_event(Fd, {Time, {info, _GL, {Pid, Info, _}}}) -> - T = write_time(maybe_utc(Time)), - io:format(Fd, T ++ add_node("~p~n",Pid),[Info]); -write_event(Fd, {Time, {error_report, _GL, {Pid, std_error, Rep}}}) -> - T = write_time(maybe_utc(Time)), - S = format_report(Rep), - io:format(Fd, T ++ S ++ add_node("", Pid), []); -write_event(Fd, {Time, {info_report, _GL, {Pid, std_info, Rep}}}) -> - T = write_time(maybe_utc(Time), "INFO REPORT"), - S = format_report(Rep), - io:format(Fd, T ++ S ++ add_node("", Pid), []); -write_event(Fd, {Time, {info_msg, _GL, {Pid, Format, Args}}}) -> - T = write_time(maybe_utc(Time), "INFO REPORT"), - case catch io_lib:format(add_node(Format,Pid), Args) of - S when is_list(S) -> - io:format(Fd, T ++ S, []); - _ -> - F = add_node("ERROR: ~p - ~p~n", Pid), - io:format(Fd, T ++ F, [Format,Args]) - end; -write_event(Fd, {Time, {warning_report, _GL, {Pid, std_warning, Rep}}}) -> - T = write_time(maybe_utc(Time), "WARNING REPORT"), - S = format_report(Rep), - io:format(Fd, T ++ S ++ add_node("", Pid), []); -write_event(Fd, {Time, {warning_msg, _GL, {Pid, Format, Args}}}) -> - T = write_time(maybe_utc(Time), "WARNING REPORT"), - case catch io_lib:format(add_node(Format,Pid), Args) of - S when is_list(S) -> - io:format(Fd, T ++ S, []); - _ -> - F = add_node("ERROR: ~p - ~p~n", Pid), - io:format(Fd, T ++ F, [Format,Args]) - end; -write_event(_, _) -> - ok. +format(#st{depth=unlimited}, Format, Args) -> + io_lib:format(Format, Args); +format(#st{depth=Depth}, Format0, Args) -> + Format1 = io_lib:scan_format(Format0, Args), + Format = limit_format(Format1, Depth), + io_lib:build_text(Format). + +limit_format([#{control_char:=C0}=M0|T], Depth) when C0 =:= $p; + C0 =:= $w -> + C = C0 - ($a - $A), %To uppercase. + #{args:=Args} = M0, + M = M0#{control_char:=C,args:=Args++[Depth]}, + [M|limit_format(T, Depth)]; +limit_format([H|T], Depth) -> + [H|limit_format(T, Depth)]; +limit_format([], _) -> + []. + +parse_event({error, _GL, {Pid, Format, Args}}) -> + {"ERROR REPORT",Pid,[{Format,Args}]}; +parse_event({info_msg, _GL, {Pid, Format, Args}}) -> + {"INFO REPORT",Pid,[{Format, Args}]}; +parse_event({warning_msg, _GL, {Pid, Format, Args}}) -> + {"WARNING REPORT",Pid,[{Format,Args}]}; +parse_event({error_report, _GL, {Pid, std_error, Args}}) -> + {"ERROR REPORT",Pid,format_term(Args)}; +parse_event({info_report, _GL, {Pid, std_info, Args}}) -> + {"INFO REPORT",Pid,format_term(Args)}; +parse_event({warning_report, _GL, {Pid, std_warning, Args}}) -> + {"WARNING REPORT",Pid,format_term(Args)}; +parse_event(_) -> ignore. maybe_utc(Time) -> UTC = case application:get_env(sasl, utc_log) of @@ -183,30 +187,27 @@ maybe_utc(Time) -> maybe_utc(Time, true) -> {utc, Time}; maybe_utc(Time, _) -> {local, calendar:universal_time_to_local_time(Time)}. -format_report(Rep) when is_list(Rep) -> - case string_p(Rep) of +format_term(Term) when is_list(Term) -> + case string_p(Term) of true -> - io_lib:format("~s~n",[Rep]); - _ -> - format_rep(Rep) + [{"~s\n",[Term]}]; + false -> + format_term_list(Term) end; -format_report(Rep) -> - io_lib:format("~p~n",[Rep]). +format_term(Term) -> + [{"~p\n",[Term]}]. -format_rep([{Tag,Data}|Rep]) -> - io_lib:format(" ~p: ~p~n",[Tag,Data]) ++ format_rep(Rep); -format_rep([Other|Rep]) -> - io_lib:format(" ~p~n",[Other]) ++ format_rep(Rep); -format_rep(_) -> +format_term_list([{Tag,Data}|T]) -> + [{" ~p: ~p\n",[Tag,Data]}|format_term_list(T)]; +format_term_list([Data|T]) -> + [{" ~p\n",[Data]}|format_term_list(T)]; +format_term_list([]) -> + []; +format_term_list(_) -> + %% Continue to allow non-proper lists for now. + %% FIXME: Remove this clause in OTP 19. []. -add_node(X, Pid) when is_atom(X) -> - add_node(atom_to_list(X), Pid); -add_node(X, Pid) when node(Pid) =/= node() -> - lists:concat([X,"** at node ",node(Pid)," **~n"]); -add_node(X, _) -> - X. - string_p([]) -> false; string_p(Term) -> @@ -222,15 +223,10 @@ string_p1([$\b|T]) -> string_p1(T); string_p1([$\f|T]) -> string_p1(T); string_p1([$\e|T]) -> string_p1(T); string_p1([H|T]) when is_list(H) -> - case string_p1(H) of - true -> string_p1(T); - _ -> false - end; + string_p1(H) andalso string_p1(T); string_p1([]) -> true; string_p1(_) -> false. -write_time(Time) -> write_time(Time, "ERROR REPORT"). - write_time({utc,{{Y,Mo,D},{H,Mi,S}}}, Type) -> io_lib:format("~n=~s==== ~p-~s-~p::~s:~s:~s UTC ===~n", [Type,D,month(Mo),Y,t(H),t(Mi),t(S)]); diff --git a/lib/stdlib/src/error_logger_tty_h.erl b/lib/stdlib/src/error_logger_tty_h.erl index 65ea645bd9..cb22a8c0b6 100644 --- a/lib/stdlib/src/error_logger_tty_h.erl +++ b/lib/stdlib/src/error_logger_tty_h.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -23,145 +23,180 @@ %%% %%% A handler that can be connected to the error_logger -%%% event handler. -%%% Writes all events formatted to stdout. -%%% Handles events tagged error, emulator and info. +%%% event handler. Writes all events formatted to stdout. %%% %%% It can only be started from error_logger:swap_handler(tty) -%%% or error_logger:tty(true) +%%% or error_logger:tty(true). %%% -export([init/1, handle_event/2, handle_call/2, handle_info/2, terminate/2, code_change/3]). --export([write_event/2]). +-export([write_event/2,write_event/3]). + +-record(st, + {user, + prev_handler, + io_mod=io, + depth=unlimited}). %% This one is used when we takeover from the simple error_logger. init({[], {error_logger, Buf}}) -> User = set_group_leader(), - write_events(Buf,io), - {ok, {User, error_logger}}; + Depth = get_depth(), + State = #st{user=User,prev_handler=error_logger,depth=Depth}, + write_events(State, Buf), + {ok, State}; %% This one is used if someone took over from us, and now wants to %% go back. init({[], {error_logger_tty_h, PrevHandler}}) -> User = set_group_leader(), - {ok, {User, PrevHandler}}; + {ok, #st{user=User,prev_handler=PrevHandler}}; %% This one is used when we are started directly. init([]) -> User = set_group_leader(), - {ok, {User, []}}. + Depth = get_depth(), + {ok, #st{user=User,prev_handler=[],depth=Depth}}. + +get_depth() -> + case application:get_env(kernel, error_logger_format_depth) of + {ok, Depth} when is_integer(Depth) -> + max(10, Depth); + undefined -> + unlimited + end. handle_event({_Type, GL, _Msg}, State) when node(GL) =/= node() -> {ok, State}; handle_event(Event, State) -> - ok = write_event(tag_event(Event),io), + ok = do_write_event(State, tag_event(Event)), {ok, State}. -handle_info({'EXIT', User, _Reason}, {User, PrevHandler}) -> +handle_info({'EXIT', User, _Reason}, + #st{user=User,prev_handler=PrevHandler}=State) -> case PrevHandler of [] -> remove_handler; _ -> - {swap_handler, install_prev, {User, PrevHandler}, + {swap_handler, install_prev, State, PrevHandler, go_back} end; -handle_info({emulator, GL, Chars}, State) when node(GL) == node() -> - ok = write_event(tag_event({emulator, GL, Chars}),io), - {ok, State}; -handle_info({emulator, noproc, Chars}, State) -> - ok = write_event(tag_event({emulator, noproc, Chars}),io), - {ok, State}; handle_info(_, State) -> {ok, State}. handle_call(_Query, State) -> {ok, {error, bad_query}, State}. -% unfortunately, we can't unlink from User - links are not counted! -% if pid(User) -> unlink(User); true -> ok end, terminate(install_prev, _State) -> []; -terminate(_Reason, {_User, PrevHandler}) -> +terminate(_Reason, #st{prev_handler=PrevHandler}) -> {error_logger_tty_h, PrevHandler}. code_change(_OldVsn, State, _Extra) -> {ok, State}. +%% Exported (but unoffical) API. +write_event(Event, IoMod) -> + do_write_event(#st{io_mod=IoMod}, Event). + +write_event(Event, IoMod, Depth) -> + do_write_event(#st{io_mod=IoMod,depth=Depth}, Event). + + %%% ------------------------------------------------------ %%% Misc. functions. %%% ------------------------------------------------------ set_group_leader() -> case whereis(user) of - User when is_pid(User) -> link(User), group_leader(User,self()), User; - _ -> false + User when is_pid(User) -> + link(User), + group_leader(User,self()), + User; + _ -> + false end. tag_event(Event) -> {erlang:universaltime(), Event}. -%% IOMOd is always 'io' -write_events(Events,IOMod) -> write_events1(lists:reverse(Events),IOMod). - -write_events1([Event|Es],IOMod) -> - ok = write_event(Event,IOMod), - write_events1(Es,IOMod); -write_events1([],_IOMod) -> +write_events(State, [Ev|Es]) -> + %% Write the events in reverse order. + _ = write_events(State, Es), + _ = do_write_event(State, Ev), + ok; +write_events(_State, []) -> ok. -write_event({Time, {error, _GL, {Pid, Format, Args}}},IOMod) -> - T = write_time(maybe_utc(Time)), - case catch io_lib:format(add_node(Format,Pid), Args) of - S when is_list(S) -> - format(IOMod, T ++ S); - _ -> - F = add_node("ERROR: ~p - ~p~n", Pid), - format(IOMod, T ++ F, [Format,Args]) +do_write_event(State, {Time0, Event}) -> + case parse_event(Event) of + ignore -> + ok; + {Head,Pid,FormatList} -> + Time = maybe_utc(Time0), + Header = write_time(Time, Head), + Body = format_body(State, FormatList), + AtNode = if + node(Pid) =/= node() -> + ["** at node ",atom_to_list(node(Pid))," **\n"]; + true -> + [] + end, + Str = [Header,Body,AtNode], + case State#st.io_mod of + io_lib -> + Str; + io -> + io:put_chars(user, Str) + end end; -write_event({Time, {emulator, _GL, Chars}},IOMod) -> - T = write_time(maybe_utc(Time)), - case catch io_lib:format(Chars, []) of - S when is_list(S) -> - format(IOMod, T ++ S); - _ -> - format(IOMod, T ++ "ERROR: ~p ~n", [Chars]) - end; -write_event({Time, {info, _GL, {Pid, Info, _}}},IOMod) -> - T = write_time(maybe_utc(Time)), - format(IOMod, T ++ add_node("~p~n",Pid),[Info]); -write_event({Time, {error_report, _GL, {Pid, std_error, Rep}}},IOMod) -> - T = write_time(maybe_utc(Time)), - S = format_report(Rep), - format(IOMod, T ++ S ++ add_node("", Pid)); -write_event({Time, {info_report, _GL, {Pid, std_info, Rep}}},IOMod) -> - T = write_time(maybe_utc(Time), "INFO REPORT"), - S = format_report(Rep), - format(IOMod, T ++ S ++ add_node("", Pid)); -write_event({Time, {info_msg, _GL, {Pid, Format, Args}}},IOMod) -> - T = write_time(maybe_utc(Time), "INFO REPORT"), - case catch io_lib:format(add_node(Format,Pid), Args) of - S when is_list(S) -> - format(IOMod, T ++ S); - _ -> - F = add_node("ERROR: ~p - ~p~n", Pid), - format(IOMod, T ++ F, [Format,Args]) - end; -write_event({Time, {warning_report, _GL, {Pid, std_warning, Rep}}},IOMod) -> - T = write_time(maybe_utc(Time), "WARNING REPORT"), - S = format_report(Rep), - format(IOMod, T ++ S ++ add_node("", Pid)); -write_event({Time, {warning_msg, _GL, {Pid, Format, Args}}},IOMod) -> - T = write_time(maybe_utc(Time), "WARNING REPORT"), - case catch io_lib:format(add_node(Format,Pid), Args) of - S when is_list(S) -> - format(IOMod, T ++ S); - _ -> - F = add_node("ERROR: ~p - ~p~n", Pid), - format(IOMod, T ++ F, [Format,Args]) - end; -write_event({_Time, _Error},_IOMod) -> +do_write_event(_, _) -> ok. +format_body(State, [{Format,Args}|T]) -> + S = try format(State, Format, Args) of + S0 -> + S0 + catch + _:_ -> + format(State, "ERROR: ~p - ~p\n", [Format,Args]) + end, + [S|format_body(State, T)]; +format_body(_State, []) -> + []. + +format(#st{depth=unlimited}, Format, Args) -> + io_lib:format(Format, Args); +format(#st{depth=Depth}, Format0, Args) -> + Format1 = io_lib:scan_format(Format0, Args), + Format = limit_format(Format1, Depth), + io_lib:build_text(Format). + +limit_format([#{control_char:=C0}=M0|T], Depth) when C0 =:= $p; + C0 =:= $w -> + C = C0 - ($a - $A), %To uppercase. + #{args:=Args} = M0, + M = M0#{control_char:=C,args:=Args++[Depth]}, + [M|limit_format(T, Depth)]; +limit_format([H|T], Depth) -> + [H|limit_format(T, Depth)]; +limit_format([], _) -> + []. + +parse_event({error, _GL, {Pid, Format, Args}}) -> + {"ERROR REPORT",Pid,[{Format,Args}]}; +parse_event({info_msg, _GL, {Pid, Format, Args}}) -> + {"INFO REPORT",Pid,[{Format, Args}]}; +parse_event({warning_msg, _GL, {Pid, Format, Args}}) -> + {"WARNING REPORT",Pid,[{Format,Args}]}; +parse_event({error_report, _GL, {Pid, std_error, Args}}) -> + {"ERROR REPORT",Pid,format_term(Args)}; +parse_event({info_report, _GL, {Pid, std_info, Args}}) -> + {"INFO REPORT",Pid,format_term(Args)}; +parse_event({warning_report, _GL, {Pid, std_warning, Args}}) -> + {"WARNING REPORT",Pid,format_term(Args)}; +parse_event(_) -> ignore. + maybe_utc(Time) -> UTC = case application:get_env(sasl, utc_log) of {ok, Val} -> Val; @@ -177,33 +212,26 @@ maybe_utc(Time) -> maybe_utc(Time, true) -> {utc, Time}; maybe_utc(Time, _) -> {local, calendar:universal_time_to_local_time(Time)}. -format(IOMod, String) -> format(IOMod, String, []). -format(io_lib, String, Args) -> io_lib:format(String, Args); -format(io, String, Args) -> io:format(user, String, Args). - -format_report(Rep) when is_list(Rep) -> - case string_p(Rep) of +format_term(Term) when is_list(Term) -> + case string_p(Term) of true -> - io_lib:format("~s~n",[Rep]); - _ -> - format_rep(Rep) + [{"~s\n",[Term]}]; + false -> + format_term_list(Term) end; -format_report(Rep) -> - io_lib:format("~p~n",[Rep]). - -format_rep([{Tag,Data}|Rep]) -> - io_lib:format(" ~p: ~p~n",[Tag,Data]) ++ format_rep(Rep); -format_rep([Other|Rep]) -> - io_lib:format(" ~p~n",[Other]) ++ format_rep(Rep); -format_rep(_) -> - []. +format_term(Term) -> + [{"~p\n",[Term]}]. -add_node(X, Pid) when is_atom(X) -> - add_node(atom_to_list(X), Pid); -add_node(X, Pid) when node(Pid) =/= node() -> - lists:concat([X,"** at node ",node(Pid)," **~n"]); -add_node(X, _) -> - X. +format_term_list([{Tag,Data}|T]) -> + [{" ~p: ~p\n",[Tag,Data]}|format_term_list(T)]; +format_term_list([Data|T]) -> + [{" ~p\n",[Data]}|format_term_list(T)]; +format_term_list([]) -> + []; +format_term_list(_) -> + %% Continue to allow non-proper lists for now. + %% FIXME: Remove this clause in OTP 19. + []. string_p([]) -> false; @@ -227,7 +255,6 @@ string_p1([H|T]) when is_list(H) -> string_p1([]) -> true; string_p1(_) -> false. -write_time(Time) -> write_time(Time, "ERROR REPORT"). write_time({utc,{{Y,Mo,D},{H,Mi,S}}},Type) -> io_lib:format("~n=~s==== ~p-~s-~p::~s:~s:~s UTC ===~n", [Type,D,month(Mo),Y,t(H),t(Mi),t(S)]); diff --git a/lib/stdlib/src/escript.erl b/lib/stdlib/src/escript.erl index 41b49f4a86..f53b0e2246 100644 --- a/lib/stdlib/src/escript.erl +++ b/lib/stdlib/src/escript.erl @@ -38,7 +38,7 @@ -record(state, {file :: file:filename(), module :: module(), forms_or_bin, - source :: source(), + source :: source() | 'undefined', n_errors :: non_neg_integer(), mode :: mode(), exports_main :: boolean(), @@ -49,9 +49,9 @@ -type emu_args() :: string(). -record(sections, {type, - shebang :: shebang(), - comment :: comment(), - emu_args :: emu_args(), + shebang :: shebang() | 'undefined', + comment :: comment() | 'undefined', + emu_args :: emu_args() | 'undefined', body}). -record(extract_options, {compile_source}). @@ -906,6 +906,7 @@ anno(L) -> fatal(Str) -> throw(Str). +-spec my_halt(_) -> no_return(). my_halt(Reason) -> erlang:halt(Reason). diff --git a/lib/stdlib/src/ets.erl b/lib/stdlib/src/ets.erl index 847def2fd8..20de06fd0b 100644 --- a/lib/stdlib/src/ets.erl +++ b/lib/stdlib/src/ets.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -146,7 +146,7 @@ info(_) -> Tab :: tab(), Item :: compressed | fixed | heir | keypos | memory | name | named_table | node | owner | protection - | safe_fixed | size | stats | type + | safe_fixed | safe_fixed_monotonic_time | size | stats | type | write_concurrency | read_concurrency, Value :: term(). @@ -232,20 +232,20 @@ match(_) -> match_object(_, _) -> erlang:nif_error(undef). --spec match_object(Tab, Pattern, Limit) -> {[Match], Continuation} | +-spec match_object(Tab, Pattern, Limit) -> {[Object], Continuation} | '$end_of_table' when Tab :: tab(), Pattern :: match_pattern(), Limit :: pos_integer(), - Match :: [term()], + Object :: tuple(), Continuation :: continuation(). match_object(_, _, _) -> erlang:nif_error(undef). --spec match_object(Continuation) -> {[Match], Continuation} | +-spec match_object(Continuation) -> {[Object], Continuation} | '$end_of_table' when - Match :: [term()], + Object :: tuple(), Continuation :: continuation(). match_object(_) -> diff --git a/lib/stdlib/src/eval_bits.erl b/lib/stdlib/src/eval_bits.erl index b3698fb3f5..80667023fb 100644 --- a/lib/stdlib/src/eval_bits.erl +++ b/lib/stdlib/src/eval_bits.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2013. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/lib/stdlib/src/file_sorter.erl b/lib/stdlib/src/file_sorter.erl index 47adb133b0..3aeaff8dc4 100644 --- a/lib/stdlib/src/file_sorter.erl +++ b/lib/stdlib/src/file_sorter.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2013. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -28,6 +28,8 @@ check/1, check/2, keycheck/2, keycheck/3]). +-dialyzer(no_improper_lists). + -include_lib("kernel/include/file.hrl"). -define(CHUNKSIZE, 16384). @@ -305,7 +307,6 @@ options(Option) -> options([{format, Format} | L], Opts) when Format =:= binary; Format =:= term; - is_function(Format), is_function(Format, 1) -> options(L, Opts#opts{format = Format}); options([{format, binary_term} | L], Opts) -> @@ -324,7 +325,7 @@ options([{tmpdir, Dir} | L], Opts) -> FileName -> options(L, Opts#opts{tmpdir = {dir, FileName}}) end; -options([{order, Fun} | L], Opts) when is_function(Fun), is_function(Fun, 2) -> +options([{order, Fun} | L], Opts) when is_function(Fun, 2) -> options(L, Opts#opts{order = Fun}); options([{order, Order} | L], Opts) when Order =:= ascending; Order =:= descending -> @@ -409,7 +410,7 @@ merge_terms_fun(RFun) -> case RFun(read) of end_of_input -> eof; - {Objs, NRFun} when is_function(NRFun), is_function(NRFun, 1) -> + {Objs, NRFun} when is_function(NRFun, 1) -> {_, [], Ts, _} = fun_objs(Objs, [], 0, ?MAXSIZE, I, W), {{I, Ts, ?CHUNKSIZE}, merge_terms_fun(NRFun)}; Error -> @@ -425,13 +426,12 @@ merge_bins_fun(FileName) -> Fun(A) end. -wrap_output_terms(term, OutFun, _Z) when is_function(OutFun), - is_function(OutFun, 1) -> +wrap_output_terms(term, OutFun, _Z) when is_function(OutFun, 1) -> {fun_wterms(OutFun), true}; wrap_output_terms(term, File, Z) when File =/= undefined -> {file_wterms(name, File, Z++[write]), false}; wrap_output_terms(_Format, Output, _Z) -> - {Output, is_function(Output) and is_function(Output, 1)}. + {Output, is_function(Output, 1)}. binary_term_fun() -> fun binary_to_term/1. @@ -1309,8 +1309,7 @@ infun(W) -> {end_of_input, W1}; {end_of_input, Value} -> {end_of_input, W1#w{inout_value = {value, Value}}}; - {Objs, NFun} when is_function(NFun), - is_function(NFun, 1), + {Objs, NFun} when is_function(NFun, 1), is_list(Objs) -> {cont, W#w{in = NFun}, Objs}; Error -> @@ -1333,7 +1332,7 @@ outfun(A, W) -> try (W#w.out)(A) of Reply when A =:= close -> Reply; - NF when is_function(NF), is_function(NF, 1) -> + NF when is_function(NF, 1) -> W#w{out = NF}; Error -> error(Error, W1) @@ -1358,7 +1357,7 @@ is_keyposs([Bad | _]) -> is_keyposs(Bad) -> {badarg, Bad}. -is_input(Fun) when is_function(Fun), is_function(Fun, 1) -> +is_input(Fun) when is_function(Fun, 1) -> {true, Fun}; is_input(Files) -> is_files(Files). @@ -1378,7 +1377,7 @@ is_files([], L) -> is_files(Bad, _L) -> {badarg, Bad}. -maybe_output(Fun) when is_function(Fun), is_function(Fun, 1) -> +maybe_output(Fun) when is_function(Fun, 1) -> {true, Fun}; maybe_output(File) -> case read_file_info(File) of @@ -1587,7 +1586,6 @@ fun_rterms(InFun) -> (read) -> case InFun(read) of {Ts, NInFun} when is_list(Ts), - is_function(NInFun), is_function(NInFun, 1) -> {to_bin(Ts, []), fun_rterms(NInFun)}; Else -> @@ -1600,7 +1598,7 @@ fun_wterms(OutFun) -> OutFun(close); (L) -> case OutFun(wterms_arg(L)) of - NOutFun when is_function(NOutFun), is_function(NOutFun, 1) -> + NOutFun when is_function(NOutFun, 1) -> fun_wterms(NOutFun); Else -> Else diff --git a/lib/stdlib/src/filelib.erl b/lib/stdlib/src/filelib.erl index 51ffd1cff9..7029389e2f 100644 --- a/lib/stdlib/src/filelib.erl +++ b/lib/stdlib/src/filelib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/lib/stdlib/src/filename.erl b/lib/stdlib/src/filename.erl index 008beb8b67..c4586171ca 100644 --- a/lib/stdlib/src/filename.erl +++ b/lib/stdlib/src/filename.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2014. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -36,6 +36,7 @@ extension/1, join/1, join/2, pathtype/1, rootname/1, rootname/2, split/1, nativename/1]). -export([find_src/1, find_src/2, flatten/1]). +-export([basedir/2, basedir/3]). %% Undocumented and unsupported exports. -export([append/2]). @@ -139,6 +140,7 @@ absname_join(AbsBase, Name) -> -spec basename(Filename) -> file:filename_all() when Filename :: file:name_all(). + basename(Name) when is_binary(Name) -> case os:type() of {win32,_} -> @@ -954,3 +956,180 @@ filename_string_to_binary(List) -> Bin end. +%% Application Base Directories +%% basedir +%% http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html + +-type basedir_type() :: 'user_cache' | 'user_config' | 'user_data' + | 'user_log' + | 'site_config' | 'site_data'. + +-spec basedir(Type,Application) -> file:filename_all() when + Type :: basedir_type(), + Application :: string() | binary(). + +basedir(Type,Application) when is_atom(Type), is_list(Application) orelse + is_binary(Application) -> + basedir(Type, Application, #{}). + +-spec basedir(Type,Application,Opts) -> file:filename_all() when + Type :: basedir_type(), + Application :: string() | binary(), + Opts :: #{author => string() | binary(), + os => 'windows' | 'darwin' | 'linux', + version => string() | binary()}. + +basedir(Type,Application,Opts) when is_atom(Type), is_map(Opts), + is_list(Application) orelse + is_binary(Application) -> + Os = basedir_os_from_opts(Opts), + Name = basedir_name_from_opts(Os,Application,Opts), + Base = basedir_from_os(Type,Os), + case {Type,Os} of + {user_log,linux} -> + filename:join([Base,Name,"log"]); + {user_log,windows} -> + filename:join([Base,Name,"Logs"]); + {user_cache,windows} -> + filename:join([Base,Name,"Cache"]); + {Type,_} when Type =:= site_config orelse Type =:= site_data -> + [filename:join([B,Name]) || B <- Base]; + _ -> + filename:join([Base,Name]) + end. + +basedir_os_from_opts(#{os := linux}) -> linux; +basedir_os_from_opts(#{os := windows}) -> windows; +basedir_os_from_opts(#{os := darwin}) -> darwin; +basedir_os_from_opts(#{}) -> basedir_os_type(). + +basedir_name_from_opts(windows,App,#{author:=Author,version:=Vsn}) -> + filename:join([Author,App,Vsn]); +basedir_name_from_opts(windows,App,#{author:=Author}) -> + filename:join([Author,App]); +basedir_name_from_opts(_,App,#{version:=Vsn}) -> + filename:join([App,Vsn]); +basedir_name_from_opts(_,App,_) -> + App. + +basedir_from_os(Type,Os) -> + case Os of + linux -> basedir_linux(Type); + darwin -> basedir_darwin(Type); + windows -> basedir_windows(Type) + end. + +-define(basedir_linux_user_data, ".local/share"). +-define(basedir_linux_user_config, ".config"). +-define(basedir_linux_user_cache, ".cache"). +-define(basedir_linux_user_log, ".cache"). %% .cache/App/log +-define(basedir_linux_site_data, "/usr/local/share/:/usr/share/"). +-define(basedir_linux_site_config, "/etc/xdg"). + +basedir_linux(Type) -> + case Type of + user_data -> getenv("XDG_DATA_HOME", ?basedir_linux_user_data, true); + user_config -> getenv("XDG_CONFIG_HOME",?basedir_linux_user_config,true); + user_cache -> getenv("XDG_CACHE_HOME", ?basedir_linux_user_cache, true); + user_log -> getenv("XDG_CACHE_HOME", ?basedir_linux_user_log, true); + site_data -> + Base = getenv("XDG_DATA_DIRS",?basedir_linux_site_data,false), + string:tokens(Base,":"); + site_config -> + Base = getenv("XDG_CONFIG_DIRS",?basedir_linux_site_config,false), + string:tokens(Base,":") + end. + +-define(basedir_darwin_user_data, "Library/Application Support"). +-define(basedir_darwin_user_config, "Library/Application Support"). +-define(basedir_darwin_user_cache, "Library/Caches"). +-define(basedir_darwin_user_log, "Library/Logs"). +-define(basedir_darwin_site_data, "/Library/Application Support"). +-define(basedir_darwin_site_config, "/Library/Application Support"). + +basedir_darwin(Type) -> + case Type of + user_data -> basedir_join_home(?basedir_darwin_user_data); + user_config -> basedir_join_home(?basedir_darwin_user_config); + user_cache -> basedir_join_home(?basedir_darwin_user_cache); + user_log -> basedir_join_home(?basedir_darwin_user_log); + site_data -> [?basedir_darwin_site_data]; + site_config -> [?basedir_darwin_site_config] + end. + +%% On Windows: +%% ex. C:\Users\egil\AppData\Local\Ericsson\Erlang +%% %LOCALAPPDATA% is defined on Windows 7 and onwards +%% %APPDATA% is used instead of %LOCALAPPDATA% if it's not defined. +%% %APPDATA% is used for roaming, i.e. for user_config on Windows 7 and beyond. +%% +%% user_data %LOCALAPPDATA%[/$author]/$appname[/$version] +%% user_config %APPDATA%[/$author]/$appname[/$version] +%% user_cache %LOCALAPPDATA%[/$author]/$appname[/$version]/Cache +%% user_log %LOCALAPPDATA%[/$author]/$appname[/$version]/Logs + +-define(basedir_windows_user_data, "Local"). +-define(basedir_windows_user_config, "Roaming"). +-define(basedir_windows_user_cache, "Local"). %% Cache is added later +-define(basedir_windows_user_log, "Local"). %% Logs is added later + +basedir_windows(Type) -> + %% If LOCALAPPDATA is not defined we are likely on an + %% XP machine. Use APPDATA instead. + case basedir_windows_appdata() of + noappdata -> + %% No AppData is set + %% Probably running MSYS + case Type of + user_data -> basedir_join_home(?basedir_windows_user_data); + user_config -> basedir_join_home(?basedir_windows_user_config); + user_cache -> basedir_join_home(?basedir_windows_user_cache); + user_log -> basedir_join_home(?basedir_windows_user_log); + site_data -> []; + site_config -> [] + end; + {ok, AppData} -> + case Type of + user_data -> getenv("LOCALAPPDATA", AppData); + user_config -> AppData; + user_cache -> getenv("LOCALAPPDATA", AppData); + user_log -> getenv("LOCALAPPDATA", AppData); + site_data -> []; + site_config -> [] + end + end. + +basedir_windows_appdata() -> + case os:getenv("APPDATA") of + Invalid when Invalid =:= false orelse Invalid =:= [] -> + noappdata; + Val -> + {ok, Val} + end. + +%% basedir aux + +getenv(K,Def,false) -> getenv(K,Def); +getenv(K,Def,true) -> getenv(K,basedir_join_home(Def)). + +getenv(K,Def) -> + case os:getenv(K) of + [] -> Def; + false -> Def; + Val -> Val + end. + +basedir_join_home(Dir) -> + case os:getenv("HOME") of + false -> + {ok,[[Home]]} = init:get_argument(home), + filename:join(Home,Dir); + Home -> filename:join(Home,Dir) + end. + +basedir_os_type() -> + case os:type() of + {unix,darwin} -> darwin; + {win32,_} -> windows; + _ -> linux + end. diff --git a/lib/stdlib/src/gen.erl b/lib/stdlib/src/gen.erl index a05c2ce6fd..597830cf9a 100644 --- a/lib/stdlib/src/gen.erl +++ b/lib/stdlib/src/gen.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -26,7 +26,8 @@ %%% %%% The standard behaviour should export init_it/6. %%%----------------------------------------------------------------- --export([start/5, start/6, debug_options/1, +-export([start/5, start/6, debug_options/2, + name/1, unregister_name/1, get_proc_name/1, get_parent/0, call/3, call/4, reply/2, stop/1, stop/3]). -export([init_it/6, init_it/7]). @@ -124,7 +125,7 @@ init_it(GenMod, Starter, Parent, Mod, Args, Options) -> init_it2(GenMod, Starter, Parent, self(), Mod, Args, Options). init_it(GenMod, Starter, Parent, Name, Mod, Args, Options) -> - case name_register(Name) of + case register_name(Name) of true -> init_it2(GenMod, Starter, Parent, Name, Mod, Args, Options); {false, Pid} -> @@ -297,19 +298,19 @@ where({global, Name}) -> global:whereis_name(Name); where({via, Module, Name}) -> Module:whereis_name(Name); where({local, Name}) -> whereis(Name). -name_register({local, Name} = LN) -> +register_name({local, Name} = LN) -> try register(Name, self()) of true -> true catch error:_ -> {false, where(LN)} end; -name_register({global, Name} = GN) -> +register_name({global, Name} = GN) -> case global:register_name(Name, self()) of yes -> true; no -> {false, where(GN)} end; -name_register({via, Module, Name} = GN) -> +register_name({via, Module, Name} = GN) -> case Module:register_name(Name, self()) of yes -> true; @@ -317,34 +318,108 @@ name_register({via, Module, Name} = GN) -> {false, where(GN)} end. +name({local,Name}) -> Name; +name({global,Name}) -> Name; +name({via,_, Name}) -> Name; +name(Pid) when is_pid(Pid) -> Pid. + +unregister_name({local,Name}) -> + try unregister(Name) of + _ -> ok + catch + _:_ -> ok + end; +unregister_name({global,Name}) -> + _ = global:unregister_name(Name), + ok; +unregister_name({via, Mod, Name}) -> + _ = Mod:unregister_name(Name), + ok; +unregister_name(Pid) when is_pid(Pid) -> + ok. + +get_proc_name(Pid) when is_pid(Pid) -> + Pid; +get_proc_name({local, Name}) -> + case process_info(self(), registered_name) of + {registered_name, Name} -> + Name; + {registered_name, _Name} -> + exit(process_not_registered); + [] -> + exit(process_not_registered) + end; +get_proc_name({global, Name}) -> + case global:whereis_name(Name) of + undefined -> + exit(process_not_registered_globally); + Pid when Pid =:= self() -> + Name; + _Pid -> + exit(process_not_registered_globally) + end; +get_proc_name({via, Mod, Name}) -> + case Mod:whereis_name(Name) of + undefined -> + exit({process_not_registered_via, Mod}); + Pid when Pid =:= self() -> + Name; + _Pid -> + exit({process_not_registered_via, Mod}) + end. + +get_parent() -> + case get('$ancestors') of + [Parent | _] when is_pid(Parent) -> + Parent; + [Parent | _] when is_atom(Parent) -> + name_to_pid(Parent); + _ -> + exit(process_was_not_started_by_proc_lib) + end. + +name_to_pid(Name) -> + case whereis(Name) of + undefined -> + case global:whereis_name(Name) of + undefined -> + exit(could_not_find_registered_name); + Pid -> + Pid + end; + Pid -> + Pid + end. + timeout(Options) -> - case opt(timeout, Options) of - {ok, Time} -> + case lists:keyfind(timeout, 1, Options) of + {_,Time} -> Time; - _ -> + false -> infinity end. spawn_opts(Options) -> - case opt(spawn_opt, Options) of - {ok, Opts} -> + case lists:keyfind(spawn_opt, 1, Options) of + {_,Opts} -> Opts; - _ -> + false -> [] end. -opt(Op, [{Op, Value}|_]) -> - {ok, Value}; -opt(Op, [_|Options]) -> - opt(Op, Options); -opt(_, []) -> - false. - -debug_options(Opts) -> - case opt(debug, Opts) of - {ok, Options} -> sys:debug_options(Options); - _ -> [] +debug_options(Name, Opts) -> + case lists:keyfind(debug, 1, Opts) of + {_,Options} -> + try sys:debug_options(Options) + catch _:_ -> + error_logger:format( + "~p: ignoring erroneous debug options - ~p~n", + [Name,Options]), + [] + end; + false -> + [] end. format_status_header(TagLine, Pid) when is_pid(Pid) -> diff --git a/lib/stdlib/src/gen_event.erl b/lib/stdlib/src/gen_event.erl index 3d63c19de7..ccacf658e9 100644 --- a/lib/stdlib/src/gen_event.erl +++ b/lib/stdlib/src/gen_event.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -147,16 +147,11 @@ init_it(Starter, self, Name, Mod, Args, Options) -> init_it(Starter, self(), Name, Mod, Args, Options); init_it(Starter, Parent, Name0, _, _, Options) -> process_flag(trap_exit, true), - Debug = gen:debug_options(Options), + Name = gen:name(Name0), + Debug = gen:debug_options(Name, Options), proc_lib:init_ack(Starter, {ok, self()}), - Name = name(Name0), loop(Parent, Name, [], Debug, false). -name({local,Name}) -> Name; -name({global,Name}) -> Name; -name({via,_, Name}) -> Name; -name(Pid) when is_pid(Pid) -> Pid. - -spec add_handler(emgr_ref(), handler(), term()) -> term(). add_handler(M, Handler, Args) -> rpc(M, {add_handler, Handler, Args}). diff --git a/lib/stdlib/src/gen_fsm.erl b/lib/stdlib/src/gen_fsm.erl index 7eabb95548..6e7528fd98 100644 --- a/lib/stdlib/src/gen_fsm.erl +++ b/lib/stdlib/src/gen_fsm.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -305,64 +305,11 @@ enter_loop(Mod, Options, StateName, StateData, Timeout) -> enter_loop(Mod, Options, StateName, StateData, self(), Timeout). enter_loop(Mod, Options, StateName, StateData, ServerName, Timeout) -> - Name = get_proc_name(ServerName), - Parent = get_parent(), - Debug = gen:debug_options(Options), + Name = gen:get_proc_name(ServerName), + Parent = gen:get_parent(), + Debug = gen:debug_options(Name, Options), loop(Parent, Name, StateName, StateData, Mod, Timeout, Debug). -get_proc_name(Pid) when is_pid(Pid) -> - Pid; -get_proc_name({local, Name}) -> - case process_info(self(), registered_name) of - {registered_name, Name} -> - Name; - {registered_name, _Name} -> - exit(process_not_registered); - [] -> - exit(process_not_registered) - end; -get_proc_name({global, Name}) -> - case global:whereis_name(Name) of - undefined -> - exit(process_not_registered_globally); - Pid when Pid =:= self() -> - Name; - _Pid -> - exit(process_not_registered_globally) - end; -get_proc_name({via, Mod, Name}) -> - case Mod:whereis_name(Name) of - undefined -> - exit({process_not_registered_via, Mod}); - Pid when Pid =:= self() -> - Name; - _Pid -> - exit({process_not_registered_via, Mod}) - end. - -get_parent() -> - case get('$ancestors') of - [Parent | _] when is_pid(Parent) -> - Parent; - [Parent | _] when is_atom(Parent) -> - name_to_pid(Parent); - _ -> - exit(process_was_not_started_by_proc_lib) - end. - -name_to_pid(Name) -> - case whereis(Name) of - undefined -> - case global:whereis_name(Name) of - undefined -> - exit(could_not_find_registered_name); - Pid -> - Pid - end; - Pid -> - Pid - end. - %%% --------------------------------------------------- %%% Initiate the new process. %%% Register the name using the Rfunc function @@ -373,8 +320,8 @@ name_to_pid(Name) -> init_it(Starter, self, Name, Mod, Args, Options) -> init_it(Starter, self(), Name, Mod, Args, Options); init_it(Starter, Parent, Name0, Mod, Args, Options) -> - Name = name(Name0), - Debug = gen:debug_options(Options), + Name = gen:name(Name0), + Debug = gen:debug_options(Name, Options), case catch Mod:init(Args) of {ok, StateName, StateData} -> proc_lib:init_ack(Starter, {ok, self()}), @@ -383,15 +330,15 @@ init_it(Starter, Parent, Name0, Mod, Args, Options) -> proc_lib:init_ack(Starter, {ok, self()}), loop(Parent, Name, StateName, StateData, Mod, Timeout, Debug); {stop, Reason} -> - unregister_name(Name0), + gen:unregister_name(Name0), proc_lib:init_ack(Starter, {error, Reason}), exit(Reason); ignore -> - unregister_name(Name0), + gen:unregister_name(Name0), proc_lib:init_ack(Starter, ignore), exit(normal); {'EXIT', Reason} -> - unregister_name(Name0), + gen:unregister_name(Name0), proc_lib:init_ack(Starter, {error, Reason}), exit(Reason); Else -> @@ -400,20 +347,6 @@ init_it(Starter, Parent, Name0, Mod, Args, Options) -> exit(Error) end. -name({local,Name}) -> Name; -name({global,Name}) -> Name; -name({via,_, Name}) -> Name; -name(Pid) when is_pid(Pid) -> Pid. - -unregister_name({local,Name}) -> - _ = (catch unregister(Name)); -unregister_name({global,Name}) -> - _ = global:unregister_name(Name); -unregister_name({via, Mod, Name}) -> - _ = Mod:unregister_name(Name); -unregister_name(Pid) when is_pid(Pid) -> - Pid. - %%----------------------------------------------------------------- %% The MAIN loop %%----------------------------------------------------------------- diff --git a/lib/stdlib/src/gen_server.erl b/lib/stdlib/src/gen_server.erl index c58b1de609..5800aca66f 100644 --- a/lib/stdlib/src/gen_server.erl +++ b/lib/stdlib/src/gen_server.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -304,9 +304,9 @@ enter_loop(Mod, Options, State, Timeout) -> enter_loop(Mod, Options, State, self(), Timeout). enter_loop(Mod, Options, State, ServerName, Timeout) -> - Name = get_proc_name(ServerName), - Parent = get_parent(), - Debug = debug_options(Name, Options), + Name = gen:get_proc_name(ServerName), + Parent = gen:get_parent(), + Debug = gen:debug_options(Name, Options), loop(Parent, Name, State, Mod, Timeout, Debug). %%%======================================================================== @@ -323,8 +323,8 @@ enter_loop(Mod, Options, State, ServerName, Timeout) -> init_it(Starter, self, Name, Mod, Args, Options) -> init_it(Starter, self(), Name, Mod, Args, Options); init_it(Starter, Parent, Name0, Mod, Args, Options) -> - Name = name(Name0), - Debug = debug_options(Name, Options), + Name = gen:name(Name0), + Debug = gen:debug_options(Name, Options), case catch Mod:init(Args) of {ok, State} -> proc_lib:init_ack(Starter, {ok, self()}), @@ -339,15 +339,15 @@ init_it(Starter, Parent, Name0, Mod, Args, Options) -> %% (Otherwise, the parent process could get %% an 'already_started' error if it immediately %% tried starting the process again.) - unregister_name(Name0), + gen:unregister_name(Name0), proc_lib:init_ack(Starter, {error, Reason}), exit(Reason); ignore -> - unregister_name(Name0), + gen:unregister_name(Name0), proc_lib:init_ack(Starter, ignore), exit(normal); {'EXIT', Reason} -> - unregister_name(Name0), + gen:unregister_name(Name0), proc_lib:init_ack(Starter, {error, Reason}), exit(Reason); Else -> @@ -356,20 +356,6 @@ init_it(Starter, Parent, Name0, Mod, Args, Options) -> exit(Error) end. -name({local,Name}) -> Name; -name({global,Name}) -> Name; -name({via,_, Name}) -> Name; -name(Pid) when is_pid(Pid) -> Pid. - -unregister_name({local,Name}) -> - _ = (catch unregister(Name)); -unregister_name({global,Name}) -> - _ = global:unregister_name(Name); -unregister_name({via, Mod, Name}) -> - _ = Mod:unregister_name(Name); -unregister_name(Pid) when is_pid(Pid) -> - Pid. - %%%======================================================================== %%% Internal functions %%%======================================================================== @@ -858,86 +844,6 @@ error_info(Reason, Name, Msg, State, Debug) -> sys:print_log(Debug), ok. -%%% --------------------------------------------------- -%%% Misc. functions. -%%% --------------------------------------------------- - -opt(Op, [{Op, Value}|_]) -> - {ok, Value}; -opt(Op, [_|Options]) -> - opt(Op, Options); -opt(_, []) -> - false. - -debug_options(Name, Opts) -> - case opt(debug, Opts) of - {ok, Options} -> dbg_opts(Name, Options); - _ -> [] - end. - -dbg_opts(Name, Opts) -> - case catch sys:debug_options(Opts) of - {'EXIT',_} -> - format("~p: ignoring erroneous debug options - ~p~n", - [Name, Opts]), - []; - Dbg -> - Dbg - end. - -get_proc_name(Pid) when is_pid(Pid) -> - Pid; -get_proc_name({local, Name}) -> - case process_info(self(), registered_name) of - {registered_name, Name} -> - Name; - {registered_name, _Name} -> - exit(process_not_registered); - [] -> - exit(process_not_registered) - end; -get_proc_name({global, Name}) -> - case global:whereis_name(Name) of - undefined -> - exit(process_not_registered_globally); - Pid when Pid =:= self() -> - Name; - _Pid -> - exit(process_not_registered_globally) - end; -get_proc_name({via, Mod, Name}) -> - case Mod:whereis_name(Name) of - undefined -> - exit({process_not_registered_via, Mod}); - Pid when Pid =:= self() -> - Name; - _Pid -> - exit({process_not_registered_via, Mod}) - end. - -get_parent() -> - case get('$ancestors') of - [Parent | _] when is_pid(Parent)-> - Parent; - [Parent | _] when is_atom(Parent)-> - name_to_pid(Parent); - _ -> - exit(process_was_not_started_by_proc_lib) - end. - -name_to_pid(Name) -> - case whereis(Name) of - undefined -> - case global:whereis_name(Name) of - undefined -> - exit(could_not_find_registered_name); - Pid -> - Pid - end; - Pid -> - Pid - end. - %%----------------------------------------------------------------- %% Status information %%----------------------------------------------------------------- diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl new file mode 100644 index 0000000000..018aca90e6 --- /dev/null +++ b/lib/stdlib/src/gen_statem.erl @@ -0,0 +1,1664 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(gen_statem). + +%% API +-export( + [start/3,start/4,start_link/3,start_link/4, + stop/1,stop/3, + cast/2,call/2,call/3, + enter_loop/4,enter_loop/5,enter_loop/6, + reply/1,reply/2]). + +%% gen callbacks +-export( + [init_it/6]). + +%% sys callbacks +-export( + [system_continue/3, + system_terminate/4, + system_code_change/4, + system_get_state/1, + system_replace_state/2, + format_status/2]). + +%% Internal callbacks +-export( + [wakeup_from_hibernate/3]). + +%% Type exports for templates and callback modules +-export_type( + [event_type/0, + init_result/0, + callback_mode_result/0, + state_function_result/0, + handle_event_result/0, + state_enter_result/1, + event_handler_result/1, + reply_action/0, + enter_action/0, + action/0]). + +%% Type that is exported just to be documented +-export_type([transition_option/0]). + +%%%========================================================================== +%%% Interface functions. +%%%========================================================================== + +-type from() :: + {To :: pid(), Tag :: term()}. % Reply-to specifier for call + +-type state() :: + state_name() | % For StateName/3 callback functions + term(). % For handle_event/4 callback function + +-type state_name() :: atom(). + +-type data() :: term(). + +-type event_type() :: + {'call',From :: from()} | 'cast' | + 'info' | 'timeout' | 'state_timeout' | 'internal'. + +-type callback_mode_result() :: + callback_mode() | [callback_mode() | state_enter()]. +-type callback_mode() :: 'state_functions' | 'handle_event_function'. +-type state_enter() :: 'state_enter'. + +-type transition_option() :: + postpone() | hibernate() | + event_timeout() | state_timeout(). +-type postpone() :: + %% If 'true' postpone the current event + %% and retry it when the state changes (=/=) + boolean(). +-type hibernate() :: + %% If 'true' hibernate the server instead of going into receive + boolean(). +-type event_timeout() :: + %% Generate a ('timeout', EventContent, ...) event after Time + %% unless some other event is delivered + Time :: timeout(). +-type state_timeout() :: + %% Generate a ('state_timeout', EventContent, ...) event after Time + %% unless the state is changed + Time :: timeout(). + +-type action() :: + %% During a state change: + %% * NextState and NewData are set. + %% * All action()s are executed in order of apperance. + %% * Postponing the current event is performed + %% iff 'postpone' is 'true'. + %% * A state timeout is started iff 'timeout' is set. + %% * Pending events are handled or if there are + %% no pending events the server goes into receive + %% or hibernate (iff 'hibernate' is 'true') + %% + %% These action()s are executed in order of appearence + %% in the containing list. The ones that set options + %% will override any previous so the last of each kind wins. + %% + 'postpone' | % Set the postpone option + {'postpone', Postpone :: postpone()} | + %% + %% All 'next_event' events are kept in a list and then + %% inserted at state changes so the first in the + %% action() list is the first to be delivered. + {'next_event', % Insert event as the next to handle + EventType :: event_type(), + EventContent :: term()} | + enter_action(). +-type enter_action() :: + 'hibernate' | % Set the hibernate option + {'hibernate', Hibernate :: hibernate()} | + %% + (Timeout :: event_timeout()) | % {timeout,Timeout} + {'timeout', % Set the event_timeout option + Time :: event_timeout(), EventContent :: term()} | + {'state_timeout', % Set the state_timeout option + Time :: state_timeout(), EventContent :: term()} | + %% + reply_action(). +-type reply_action() :: + {'reply', % Reply to a caller + From :: from(), Reply :: term()}. + +-type init_result() :: + {ok, state(), data()} | + {ok, state(), data(), [action()] | action()} | + 'ignore' | + {'stop', Reason :: term()}. + +%% Old, not advertised +-type state_function_result() :: + event_handler_result(state_name()). +-type handle_event_result() :: + event_handler_result(state()). +%% +-type state_enter_result(State) :: + {'next_state', % {next_state,NextState,NewData,[]} + State, + NewData :: data()} | + {'next_state', % State transition, maybe to the same state + State, + NewData :: data(), + Actions :: [enter_action()] | enter_action()} | + state_callback_result(enter_action()). +-type event_handler_result(StateType) :: + {'next_state', % {next_state,NextState,NewData,[]} + NextState :: StateType, + NewData :: data()} | + {'next_state', % State transition, maybe to the same state + NextState :: StateType, + NewData :: data(), + Actions :: [action()] | action()} | + state_callback_result(action()). +-type state_callback_result(ActionType) :: + {'keep_state', % {keep_state,NewData,[]} + NewData :: data()} | + {'keep_state', % Keep state, change data + NewData :: data(), + Actions :: [ActionType] | ActionType} | + 'keep_state_and_data' | % {keep_state_and_data,[]} + {'keep_state_and_data', % Keep state and data -> only actions + Actions :: [ActionType] | ActionType} | + 'stop' | % {stop,normal} + {'stop', % Stop the server + Reason :: term()} | + {'stop', % Stop the server + Reason :: term(), + NewData :: data()} | + {'stop_and_reply', % Reply then stop the server + Reason :: term(), + Replies :: [reply_action()] | reply_action()} | + {'stop_and_reply', % Reply then stop the server + Reason :: term(), + Replies :: [reply_action()] | reply_action(), + NewData :: data()}. + + +%% The state machine init function. It is called only once and +%% the server is not running until this function has returned +%% an {ok, ...} tuple. Thereafter the state callbacks are called +%% for all events to this server. +-callback init(Args :: term()) -> init_result(). + +%% This callback shall return the callback mode of the callback module. +%% +%% It is called once after init/0 and code_change/4 but before +%% the first state callback StateName/3 or handle_event/4. +-callback callback_mode() -> callback_mode_result(). + +%% Example state callback for StateName = 'state_name' +%% when callback_mode() =:= state_functions. +%% +%% In this mode all states has to be of type state_name() i.e atom(). +%% +%% Note that the only callbacks that have arity 3 are these +%% StateName/3 callbacks and terminate/3, so the state name +%% 'terminate' is unusable in this mode. +-callback state_name( + 'enter', + OldStateName :: state_name(), + Data :: data()) -> + state_enter_result('state_name'); + (event_type(), + EventContent :: term(), + Data :: data()) -> + event_handler_result(state_name()). +%% +%% State callback for all states +%% when callback_mode() =:= handle_event_function. +-callback handle_event( + 'enter', + OldState :: state(), + State, % Current state + Data :: data()) -> + state_enter_result(State); + (event_type(), + EventContent :: term(), + State :: state(), % Current state + Data :: data()) -> + event_handler_result(state()). + +%% Clean up before the server terminates. +-callback terminate( + Reason :: 'normal' | 'shutdown' | {'shutdown', term()} + | term(), + State :: state(), + Data :: data()) -> + any(). + +%% Note that the new code can expect to get an OldState from +%% the old code version not only in code_change/4 but in the first +%% state callback function called thereafter +-callback code_change( + OldVsn :: term() | {'down', term()}, + OldState :: state(), + OldData :: data(), + Extra :: term()) -> + {ok, NewState :: state(), NewData :: data()} | + (Reason :: term()). + +%% Format the callback module state in some sensible that is +%% often condensed way. For StatusOption =:= 'normal' the perferred +%% return term is [{data,[{"State",FormattedState}]}], and for +%% StatusOption =:= 'terminate' it is just FormattedState. +-callback format_status( + StatusOption, + [ [{Key :: term(), Value :: term()}] | + state() | + data()]) -> + Status :: term() when + StatusOption :: 'normal' | 'terminate'. + +-optional_callbacks( + [init/1, % One may use enter_loop/5,6,7 instead + format_status/2, % Has got a default implementation + %% + state_name/3, % Example for callback_mode() =:= state_functions: + %% there has to be a StateName/3 callback function + %% for every StateName in your state machine but the state name + %% 'state_name' does of course not have to be used. + %% + handle_event/4 % For callback_mode() =:= handle_event_function + ]). + +%% Type validation functions +callback_mode(CallbackMode) -> + case CallbackMode of + state_functions -> + true; + handle_event_function -> + true; + _ -> + false + end. +%% +from({Pid,_}) when is_pid(Pid) -> + true; +from(_) -> + false. +%% +event_type({call,From}) -> + from(From); +event_type(Type) -> + case Type of + cast -> + true; + info -> + true; + timeout -> + true; + internal -> + true; + _ -> + false + end. + + + +-define( + STACKTRACE(), + try throw(ok) catch _ -> erlang:get_stacktrace() end). + +%%%========================================================================== +%%% API + +-type server_name() :: + {'global', GlobalName :: term()} + | {'via', RegMod :: module(), Name :: term()} + | {'local', atom()}. +-type server_ref() :: + pid() + | (LocalName :: atom()) + | {Name :: atom(), Node :: atom()} + | {'global', GlobalName :: term()} + | {'via', RegMod :: module(), ViaName :: term()}. +-type debug_opt() :: + {'debug', + Dbgs :: + ['trace' | 'log' | 'statistics' | 'debug' + | {'logfile', string()}]}. +-type start_opt() :: + debug_opt() + | {'timeout', Time :: timeout()} + | {'spawn_opt', [proc_lib:spawn_option()]}. +-type start_ret() :: {'ok', pid()} | 'ignore' | {'error', term()}. + + + +%% Start a state machine +-spec start( + Module :: module(), Args :: term(), Opts :: [start_opt()]) -> + start_ret(). +start(Module, Args, Opts) -> + gen:start(?MODULE, nolink, Module, Args, Opts). +%% +-spec start( + ServerName :: server_name(), + Module :: module(), Args :: term(), Opts :: [start_opt()]) -> + start_ret(). +start(ServerName, Module, Args, Opts) -> + gen:start(?MODULE, nolink, ServerName, Module, Args, Opts). + +%% Start and link to a state machine +-spec start_link( + Module :: module(), Args :: term(), Opts :: [start_opt()]) -> + start_ret(). +start_link(Module, Args, Opts) -> + gen:start(?MODULE, link, Module, Args, Opts). +%% +-spec start_link( + ServerName :: server_name(), + Module :: module(), Args :: term(), Opts :: [start_opt()]) -> + start_ret(). +start_link(ServerName, Module, Args, Opts) -> + gen:start(?MODULE, link, ServerName, Module, Args, Opts). + +%% Stop a state machine +-spec stop(ServerRef :: server_ref()) -> ok. +stop(ServerRef) -> + gen:stop(ServerRef). +%% +-spec stop( + ServerRef :: server_ref(), + Reason :: term(), + Timeout :: timeout()) -> ok. +stop(ServerRef, Reason, Timeout) -> + gen:stop(ServerRef, Reason, Timeout). + +%% Send an event to a state machine that arrives with type 'event' +-spec cast(ServerRef :: server_ref(), Msg :: term()) -> ok. +cast({global,Name}, Msg) -> + try global:send(Name, wrap_cast(Msg)) of + _ -> ok + catch + _:_ -> ok + end; +cast({via,RegMod,Name}, Msg) -> + try RegMod:send(Name, wrap_cast(Msg)) of + _ -> ok + catch + _:_ -> ok + end; +cast({Name,Node} = ServerRef, Msg) when is_atom(Name), is_atom(Node) -> + send(ServerRef, wrap_cast(Msg)); +cast(ServerRef, Msg) when is_atom(ServerRef) -> + send(ServerRef, wrap_cast(Msg)); +cast(ServerRef, Msg) when is_pid(ServerRef) -> + send(ServerRef, wrap_cast(Msg)). + +%% Call a state machine (synchronous; a reply is expected) that +%% arrives with type {call,From} +-spec call(ServerRef :: server_ref(), Request :: term()) -> Reply :: term(). +call(ServerRef, Request) -> + call(ServerRef, Request, infinity). +%% +-spec call( + ServerRef :: server_ref(), + Request :: term(), + Timeout :: + timeout() | + {'clean_timeout',T :: timeout()} | + {'dirty_timeout',T :: timeout()}) -> + Reply :: term(). +call(ServerRef, Request, Timeout) -> + case parse_timeout(Timeout) of + {dirty_timeout,T} -> + try gen:call(ServerRef, '$gen_call', Request, T) of + {ok,Reply} -> + Reply + catch + Class:Reason -> + erlang:raise( + Class, + {Reason,{?MODULE,call,[ServerRef,Request,Timeout]}}, + erlang:get_stacktrace()) + end; + {clean_timeout,T} -> + %% Call server through proxy process to dodge any late reply + Ref = make_ref(), + Self = self(), + Pid = spawn( + fun () -> + Self ! + try gen:call( + ServerRef, '$gen_call', Request, T) of + Result -> + {Ref,Result} + catch Class:Reason -> + {Ref,Class,Reason, + erlang:get_stacktrace()} + end + end), + Mref = monitor(process, Pid), + receive + {Ref,Result} -> + demonitor(Mref, [flush]), + case Result of + {ok,Reply} -> + Reply + end; + {Ref,Class,Reason,Stacktrace} -> + demonitor(Mref, [flush]), + erlang:raise( + Class, + {Reason,{?MODULE,call,[ServerRef,Request,Timeout]}}, + Stacktrace); + {'DOWN',Mref,_,_,Reason} -> + %% There is a theoretical possibility that the + %% proxy process gets killed between try--of and ! + %% so this clause is in case of that + exit(Reason) + end; + Error when is_atom(Error) -> + erlang:error(Error, [ServerRef,Request,Timeout]) + end. + +parse_timeout(Timeout) -> + case Timeout of + {clean_timeout,infinity} -> + {dirty_timeout,infinity}; + {clean_timeout,_} -> + Timeout; + {dirty_timeout,_} -> + Timeout; + {_,_} -> + %% Be nice and throw a badarg for speling errors + badarg; + infinity -> + {dirty_timeout,infinity}; + T -> + {clean_timeout,T} + end. + +%% Reply from a state machine callback to whom awaits in call/2 +-spec reply([reply_action()] | reply_action()) -> ok. +reply({reply,From,Reply}) -> + reply(From, Reply); +reply(Replies) when is_list(Replies) -> + replies(Replies). +%% +-spec reply(From :: from(), Reply :: term()) -> ok. +reply({To,Tag}, Reply) when is_pid(To) -> + Msg = {Tag,Reply}, + try To ! Msg of + _ -> + ok + catch + _:_ -> ok + end. + +%% Instead of starting the state machine through start/3,4 +%% or start_link/3,4 turn the current process presumably +%% started by proc_lib into a state machine using +%% the same arguments as you would have returned from init/1 +-spec enter_loop( + Module :: module(), Opts :: [debug_opt()], + State :: state(), Data :: data()) -> + no_return(). +enter_loop(Module, Opts, State, Data) -> + enter_loop(Module, Opts, State, Data, self()). +%% +-spec enter_loop( + Module :: module(), Opts :: [debug_opt()], + State :: state(), Data :: data(), + Server_or_Actions :: + server_name() | pid() | [action()]) -> + no_return(). +enter_loop(Module, Opts, State, Data, Server_or_Actions) -> + if + is_list(Server_or_Actions) -> + enter_loop(Module, Opts, State, Data, self(), Server_or_Actions); + true -> + enter_loop(Module, Opts, State, Data, Server_or_Actions, []) + end. +%% +-spec enter_loop( + Module :: module(), Opts :: [debug_opt()], + State :: state(), Data :: data(), + Server :: server_name() | pid(), + Actions :: [action()] | action()) -> + no_return(). +enter_loop(Module, Opts, State, Data, Server, Actions) -> + is_atom(Module) orelse error({atom,Module}), + Parent = gen:get_parent(), + enter(Module, Opts, State, Data, Server, Actions, Parent). + +%%--------------------------------------------------------------------------- +%% API helpers + +wrap_cast(Event) -> + {'$gen_cast',Event}. + +replies([{reply,From,Reply}|Replies]) -> + reply(From, Reply), + replies(Replies); +replies([]) -> + ok. + +%% Might actually not send the message in case of caught exception +send(Proc, Msg) -> + try erlang:send(Proc, Msg, [noconnect]) of + noconnect -> + _ = spawn(erlang, send, [Proc,Msg]), + ok; + ok -> + ok + catch + _:_ -> + ok + end. + +%% Here the init_it/6 and enter_loop/5,6,7 functions converge +enter(Module, Opts, State, Data, Server, Actions, Parent) -> + %% The values should already have been type checked + Name = gen:get_proc_name(Server), + Debug = gen:debug_options(Name, Opts), + Events = [], + P = [], + Event = {internal,init_state}, + %% We enforce {postpone,false} to ensure that + %% our fake Event gets discarded, thought it might get logged + NewActions = + if + is_list(Actions) -> + Actions ++ [{postpone,false}]; + true -> + [Actions,{postpone,false}] + end, + S = #{ + callback_mode => undefined, + state_enter => false, + module => Module, + name => Name, + state => State, + data => Data, + postponed => P, + %% The rest of the fields are set from to the arguments to + %% loop_event_actions/10 when it finally loops back to loop/3 + %% in loop_events/10 + %% + %% Marker for initial state, cleared immediately when used + init_state => true + }, + NewDebug = sys_debug(Debug, S, State, {enter,Event,State}), + case call_callback_mode(S) of + {ok,NewS} -> + TimerRefs = #{}, + TimerTypes = #{}, + loop_event_actions( + Parent, NewDebug, NewS, TimerRefs, TimerTypes, + Events, Event, State, Data, NewActions); + {Class,Reason,Stacktrace} -> + terminate( + Class, Reason, Stacktrace, + NewDebug, S, [Event|Events]) + end. + +%%%========================================================================== +%%% gen callbacks + +init_it(Starter, self, ServerRef, Module, Args, Opts) -> + init_it(Starter, self(), ServerRef, Module, Args, Opts); +init_it(Starter, Parent, ServerRef, Module, Args, Opts) -> + try Module:init(Args) of + Result -> + init_result(Starter, Parent, ServerRef, Module, Result, Opts) + catch + Result -> + init_result(Starter, Parent, ServerRef, Module, Result, Opts); + Class:Reason -> + Stacktrace = erlang:get_stacktrace(), + Name = gen:get_proc_name(ServerRef), + gen:unregister_name(ServerRef), + proc_lib:init_ack(Starter, {error,Reason}), + error_info( + Class, Reason, Stacktrace, + #{name => Name, + callback_mode => undefined, + state_enter => false}, + [], [], undefined), + erlang:raise(Class, Reason, Stacktrace) + end. + +%%--------------------------------------------------------------------------- +%% gen callbacks helpers + +init_result(Starter, Parent, ServerRef, Module, Result, Opts) -> + case Result of + {ok,State,Data} -> + proc_lib:init_ack(Starter, {ok,self()}), + enter(Module, Opts, State, Data, ServerRef, [], Parent); + {ok,State,Data,Actions} -> + proc_lib:init_ack(Starter, {ok,self()}), + enter(Module, Opts, State, Data, ServerRef, Actions, Parent); + {stop,Reason} -> + gen:unregister_name(ServerRef), + proc_lib:init_ack(Starter, {error,Reason}), + exit(Reason); + ignore -> + gen:unregister_name(ServerRef), + proc_lib:init_ack(Starter, ignore), + exit(normal); + _ -> + Name = gen:get_proc_name(ServerRef), + gen:unregister_name(ServerRef), + Error = {bad_return_from_init,Result}, + proc_lib:init_ack(Starter, {error,Error}), + error_info( + error, Error, ?STACKTRACE(), + #{name => Name, + callback_mode => undefined, + state_enter => false}, + [], [], undefined), + exit(Error) + end. + +%%%========================================================================== +%%% sys callbacks + +system_continue(Parent, Debug, S) -> + loop(Parent, Debug, S). + +system_terminate(Reason, _Parent, Debug, S) -> + terminate( + exit, Reason, ?STACKTRACE(), + Debug, S, []). + +system_code_change( + #{module := Module, + state := State, + data := Data} = S, + _Mod, OldVsn, Extra) -> + case + try Module:code_change(OldVsn, State, Data, Extra) + catch + Result -> Result + end + of + {ok,NewState,NewData} -> + {ok, + S#{callback_mode := undefined, + state := NewState, + data := NewData}}; + {ok,_} = Error -> + error({case_clause,Error}); + Error -> + Error + end. + +system_get_state(#{state := State, data := Data}) -> + {ok,{State,Data}}. + +system_replace_state( + StateFun, + #{state := State, + data := Data} = S) -> + {NewState,NewData} = Result = StateFun({State,Data}), + {ok,Result,S#{state := NewState, data := NewData}}. + +format_status( + Opt, + [PDict,SysState,Parent,Debug, + #{name := Name, postponed := P} = S]) -> + Header = gen:format_status_header("Status for state machine", Name), + Log = sys:get_debug(log, Debug, []), + [{header,Header}, + {data, + [{"Status",SysState}, + {"Parent",Parent}, + {"Logged Events",Log}, + {"Postponed",P}]} | + case format_status(Opt, PDict, S) of + L when is_list(L) -> L; + T -> [T] + end]. + +%%--------------------------------------------------------------------------- +%% Format debug messages. Print them as the call-back module sees +%% them, not as the real erlang messages. Use trace for that. +%%--------------------------------------------------------------------------- + +print_event(Dev, {in,Event}, {Name,State}) -> + io:format( + Dev, "*DBG* ~p receive ~s in state ~p~n", + [Name,event_string(Event),State]); +print_event(Dev, {out,Reply,{To,_Tag}}, {Name,State}) -> + io:format( + Dev, "*DBG* ~p send ~p to ~p from state ~p~n", + [Name,Reply,To,State]); +print_event(Dev, {terminate,Reason}, {Name,State}) -> + io:format( + Dev, "*DBG* ~p terminate ~p in state ~p~n", + [Name,Reason,State]); +print_event(Dev, {Tag,Event,NextState}, {Name,State}) -> + StateString = + case NextState of + State -> + io_lib:format("~p", [State]); + _ -> + io_lib:format("~p => ~p", [State,NextState]) + end, + io:format( + Dev, "*DBG* ~p ~w ~s in state ~s~n", + [Name,Tag,event_string(Event),StateString]). + +event_string(Event) -> + case Event of + {{call,{Pid,_Tag}},Request} -> + io_lib:format("call ~p from ~w", [Request,Pid]); + {EventType,EventContent} -> + io_lib:format("~w ~p", [EventType,EventContent]) + end. + +sys_debug(Debug, #{name := Name}, State, Entry) -> + case Debug of + [] -> + Debug; + _ -> + sys:handle_debug( + Debug, fun print_event/3, {Name,State}, Entry) + end. + +%%%========================================================================== +%%% Internal callbacks + +wakeup_from_hibernate(Parent, Debug, S) -> + %% It is a new message that woke us up so we have to receive it now + loop_receive(Parent, Debug, S). + +%%%========================================================================== +%%% State Machine engine implementation of proc_lib/gen server + +%% Server loop, consists of all loop* functions +%% and detours through sys:handle_system_message/7 and proc_lib:hibernate/3 + +%% Entry point for system_continue/3 +loop(Parent, Debug, #{hibernate := Hibernate} = S) -> + case Hibernate of + true -> + %% Does not return but restarts process at + %% wakeup_from_hibernate/3 that jumps to loop_receive/3 + proc_lib:hibernate( + ?MODULE, wakeup_from_hibernate, [Parent,Debug,S]), + error( + {should_not_have_arrived_here_but_instead_in, + {wakeup_from_hibernate,3}}); + false -> + loop_receive(Parent, Debug, S) + end. + +%% Entry point for wakeup_from_hibernate/3 +loop_receive( + Parent, Debug, #{timer_refs := TimerRefs, timer_types := TimerTypes} = S) -> + receive + Msg -> + case Msg of + {system,Pid,Req} -> + #{hibernate := Hibernate} = S, + %% Does not return but tail recursively calls + %% system_continue/3 that jumps to loop/3 + sys:handle_system_msg( + Req, Pid, Parent, ?MODULE, Debug, S, Hibernate); + {'EXIT',Parent,Reason} = EXIT -> + %% EXIT is not a 2-tuple and therefore + %% not an event and has no event_type(), + %% but this will stand out in the crash report... + terminate( + exit, Reason, ?STACKTRACE(), Debug, S, [EXIT]); + {timeout,TimerRef,TimerMsg} -> + case TimerRefs of + #{TimerRef := TimerType} -> + Event = {TimerType,TimerMsg}, + %% Unregister the triggered timeout + loop_receive_result( + Parent, Debug, S, + maps:remove(TimerRef, TimerRefs), + maps:remove(TimerType, TimerTypes), + Event); + _ -> + Event = {info,Msg}, + loop_receive_result( + Parent, Debug, S, + TimerRefs, TimerTypes, Event) + end; + _ -> + Event = + case Msg of + {'$gen_call',From,Request} -> + {{call,From},Request}; + {'$gen_cast',E} -> + {cast,E}; + _ -> + {info,Msg} + end, + loop_receive_result( + Parent, Debug, S, + TimerRefs, TimerTypes, Event) + end + end. + +loop_receive_result( + Parent, Debug, #{state := State} = S, + TimerRefs, TimerTypes, Event) -> + %% The fields 'timer_refs', 'timer_types' and 'hibernate' + %% are now invalid in state map S - they will be recalculated + %% and restored when we return to loop/3 + %% + NewDebug = sys_debug(Debug, S, State, {in,Event}), + %% Here the queue of not yet handled events is created + Events = [], + Hibernate = false, + loop_event( + Parent, NewDebug, S, TimerRefs, TimerTypes, Events, Event, Hibernate). + +%% Entry point for handling an event, received or enqueued +loop_event( + Parent, Debug, #{state := State, data := Data} = S, TimerRefs, TimerTypes, + Events, {Type,Content} = Event, Hibernate) -> + %% + %% If Hibernate is true here it can only be + %% because it was set from an event action + %% and we did not go into hibernation since there + %% were events in queue, so we do what the user + %% might rely on i.e collect garbage which + %% would have happened if we actually hibernated + %% and immediately was awakened + Hibernate andalso garbage_collect(), + case call_state_function(S, Type, Content, State, Data) of + {ok,Result,NewS} -> + %% Cancel event timeout + {NewTimerRefs,NewTimerTypes} = + cancel_timer_by_type( + timeout, TimerRefs, TimerTypes), + {NewData,NextState,Actions} = + parse_event_result( + true, Debug, NewS, Result, + Events, Event, State, Data), + loop_event_actions( + Parent, Debug, S, NewTimerRefs, NewTimerTypes, + Events, Event, NextState, NewData, Actions); + {Class,Reason,Stacktrace} -> + terminate( + Class, Reason, Stacktrace, Debug, S, [Event|Events]) + end. + +loop_event_actions( + Parent, Debug, + #{state := State, state_enter := StateEnter} = S, TimerRefs, TimerTypes, + Events, Event, NextState, NewData, Actions) -> + case parse_actions(Debug, S, State, Actions) of + {ok,NewDebug,Hibernate,TimeoutsR,Postpone,NextEventsR} -> + if + StateEnter, NextState =/= State -> + loop_event_enter( + Parent, NewDebug, S, TimerRefs, TimerTypes, + Events, Event, NextState, NewData, + Hibernate, TimeoutsR, Postpone, NextEventsR); + StateEnter -> + case maps:is_key(init_state, S) of + true -> + %% Avoid infinite loop in initial state + %% with state entry events + NewS = maps:remove(init_state, S), + loop_event_enter( + Parent, NewDebug, NewS, TimerRefs, TimerTypes, + Events, Event, NextState, NewData, + Hibernate, TimeoutsR, Postpone, NextEventsR); + false -> + loop_event_result( + Parent, NewDebug, S, TimerRefs, TimerTypes, + Events, Event, NextState, NewData, + Hibernate, TimeoutsR, Postpone, NextEventsR) + end; + true -> + loop_event_result( + Parent, NewDebug, S, TimerRefs, TimerTypes, + Events, Event, NextState, NewData, + Hibernate, TimeoutsR, Postpone, NextEventsR) + end; + {Class,Reason,Stacktrace} -> + terminate( + Class, Reason, Stacktrace, + Debug, S#{data := NewData}, [Event|Events]) + end. + +loop_event_enter( + Parent, Debug, #{state := State} = S, TimerRefs, TimerTypes, + Events, Event, NextState, NewData, + Hibernate, TimeoutsR, Postpone, NextEventsR) -> + case call_state_function(S, enter, State, NextState, NewData) of + {ok,Result,NewS} -> + {NewerData,_,Actions} = + parse_event_result( + false, Debug, NewS, Result, + Events, Event, NextState, NewData), + loop_event_enter_actions( + Parent, Debug, NewS, TimerRefs, TimerTypes, + Events, Event, NextState, NewerData, + Hibernate, TimeoutsR, Postpone, NextEventsR, Actions); + {Class,Reason,Stacktrace} -> + terminate( + Class, Reason, Stacktrace, + Debug, S#{state := NextState, data := NewData}, + [Event|Events]) + end. + +loop_event_enter_actions( + Parent, Debug, S, TimerRefs, TimerTypes, + Events, Event, NextState, NewData, + Hibernate, TimeoutsR, Postpone, NextEventsR, Actions) -> + case + parse_enter_actions( + Debug, S, NextState, Actions, + Hibernate, TimeoutsR) + of + {ok,NewDebug,NewHibernate,NewTimeoutsR,_,_} -> + loop_event_result( + Parent, NewDebug, S, TimerRefs, TimerTypes, + Events, Event, NextState, NewData, + NewHibernate, NewTimeoutsR, Postpone, NextEventsR); + {Class,Reason,Stacktrace} -> + terminate( + Class, Reason, Stacktrace, + Debug, S#{state := NextState, data := NewData}, + [Event|Events]) + end. + +loop_event_result( + Parent, Debug, + #{state := State, postponed := P_0} = S, TimerRefs_0, TimerTypes_0, + Events, Event, NextState, NewData, + Hibernate, TimeoutsR, Postpone, NextEventsR) -> + %% + %% All options have been collected and next_events are buffered. + %% Do the actual state transition. + %% + {NewDebug,P_1} = % Move current event to postponed if Postpone + case Postpone of + true -> + {sys_debug(Debug, S, State, {postpone,Event,State}), + [Event|P_0]}; + false -> + {sys_debug(Debug, S, State, {consume,Event,State}), + P_0} + end, + {Events_1,NewP,{TimerRefs_1,TimerTypes_1}} = + %% Move all postponed events to queue and cancel the + %% state timeout if the state changes + if + NextState =:= State -> + {Events,P_1,{TimerRefs_0,TimerTypes_0}}; + true -> + {lists:reverse(P_1, Events),[], + cancel_timer_by_type( + state_timeout, TimerRefs_0, TimerTypes_0)} + end, + {TimerRefs_2,TimerTypes_2,TimeoutEvents} = + %% Stop and start timers non-event timers + parse_timers(TimerRefs_1, TimerTypes_1, TimeoutsR), + %% Place next events last in reversed queue + Events_2R = lists:reverse(Events_1, NextEventsR), + %% Enqueue immediate timeout events and start event timer + {NewTimerRefs,NewTimerTypes,Events_3R} = + process_timeout_events( + TimerRefs_2, TimerTypes_2, TimeoutEvents, Events_2R), + NewEvents = lists:reverse(Events_3R), + loop_events( + Parent, NewDebug, S, NewTimerRefs, NewTimerTypes, + NewEvents, Hibernate, NextState, NewData, NewP). + +%% Loop until out of enqueued events +%% +loop_events( + Parent, Debug, S, TimerRefs, TimerTypes, + [] = _Events, Hibernate, State, Data, P) -> + %% Update S and loop back to loop/3 to receive a new event + NewS = + S#{ + state := State, + data := Data, + postponed := P, + hibernate => Hibernate, + timer_refs => TimerRefs, + timer_types => TimerTypes}, + loop(Parent, Debug, NewS); +loop_events( + Parent, Debug, S, TimerRefs, TimerTypes, + [Event|Events], Hibernate, State, Data, P) -> + %% Update S and continue with enqueued events + NewS = + S#{ + state := State, + data := Data, + postponed := P}, + loop_event( + Parent, Debug, NewS, TimerRefs, TimerTypes, Events, Event, Hibernate). + + + +%%--------------------------------------------------------------------------- +%% Server loop helpers + +call_callback_mode(#{module := Module} = S) -> + try Module:callback_mode() of + CallbackMode -> + callback_mode_result(S, CallbackMode) + catch + CallbackMode -> + callback_mode_result(S, CallbackMode); + error:undef -> + %% Process undef to check for the simple mistake + %% of calling a nonexistent state function + %% to make the undef more precise + case erlang:get_stacktrace() of + [{Module,callback_mode,[]=Args,_} + |Stacktrace] -> + {error, + {undef_callback,{Module,callback_mode,Args}}, + Stacktrace}; + Stacktrace -> + {error,undef,Stacktrace} + end; + Class:Reason -> + {Class,Reason,erlang:get_stacktrace()} + end. + +callback_mode_result(S, CallbackMode) -> + case + parse_callback_mode( + if + is_atom(CallbackMode) -> + [CallbackMode]; + true -> + CallbackMode + end, undefined, false) + of + {undefined,_} -> + {error, + {bad_return_from_callback_mode,CallbackMode}, + ?STACKTRACE()}; + {CBMode,StateEnter} -> + {ok, + S#{ + callback_mode := CBMode, + state_enter := StateEnter}} + end. + +parse_callback_mode([], CBMode, StateEnter) -> + {CBMode,StateEnter}; +parse_callback_mode([H|T], CBMode, StateEnter) -> + case callback_mode(H) of + true -> + parse_callback_mode(T, H, StateEnter); + false -> + case H of + state_enter -> + parse_callback_mode(T, CBMode, true); + _ -> + {undefined,StateEnter} + end + end; +parse_callback_mode(_, _CBMode, StateEnter) -> + {undefined,StateEnter}. + + +call_state_function( + #{callback_mode := undefined} = S, + Type, Content, State, Data) -> + case call_callback_mode(S) of + {ok,NewS} -> + call_state_function(NewS, Type, Content, State, Data); + Error -> + Error + end; +call_state_function( + #{callback_mode := CallbackMode, + module := Module} = S, + Type, Content, State, Data) -> + try + case CallbackMode of + state_functions -> + erlang:apply(Module, State, [Type,Content,Data]); + handle_event_function -> + Module:handle_event(Type, Content, State, Data) + end + of + Result -> + {ok,Result,S} + catch + Result -> + {ok,Result,S}; + error:badarg -> + case erlang:get_stacktrace() of + [{erlang,apply, + [Module,State,[Type,Content,Data]=Args], + _} + |Stacktrace] + when CallbackMode =:= state_functions -> + %% We get here e.g if apply fails + %% due to State not being an atom + {error, + {undef_state_function,{Module,State,Args}}, + Stacktrace}; + Stacktrace -> + {error,badarg,Stacktrace} + end; + error:undef -> + %% Process undef to check for the simple mistake + %% of calling a nonexistent state function + %% to make the undef more precise + case erlang:get_stacktrace() of + [{Module,State,[Type,Content,Data]=Args,_} + |Stacktrace] + when CallbackMode =:= state_functions -> + {error, + {undef_state_function,{Module,State,Args}}, + Stacktrace}; + [{Module,handle_event,[Type,Content,State,Data]=Args,_} + |Stacktrace] + when CallbackMode =:= handle_event_function -> + {error, + {undef_state_function,{Module,handle_event,Args}}, + Stacktrace}; + Stacktrace -> + {error,undef,Stacktrace} + end; + Class:Reason -> + {Class,Reason,erlang:get_stacktrace()} + end. + + +%% Interpret all callback return variants +parse_event_result( + AllowStateChange, Debug, S, Result, Events, Event, State, Data) -> + case Result of + stop -> + terminate( + exit, normal, ?STACKTRACE(), Debug, S, [Event|Events]); + {stop,Reason} -> + terminate( + exit, Reason, ?STACKTRACE(), Debug, S, [Event|Events]); + {stop,Reason,NewData} -> + terminate( + exit, Reason, ?STACKTRACE(), + Debug, S#{data := NewData}, [Event|Events]); + {stop_and_reply,Reason,Replies} -> + Q = [Event|Events], + reply_then_terminate( + exit, Reason, ?STACKTRACE(), + Debug, S, Q, Replies); + {stop_and_reply,Reason,Replies,NewData} -> + Q = [Event|Events], + reply_then_terminate( + exit, Reason, ?STACKTRACE(), + Debug, S#{data := NewData}, Q, Replies); + {next_state,State,NewData} -> + {NewData,State,[]}; + {next_state,NextState,NewData} when AllowStateChange -> + {NewData,NextState,[]}; + {next_state,State,NewData,Actions} -> + {NewData,State,Actions}; + {next_state,NextState,NewData,Actions} when AllowStateChange -> + {NewData,NextState,Actions}; + {keep_state,NewData} -> + {NewData,State,[]}; + {keep_state,NewData,Actions} -> + {NewData,State,Actions}; + keep_state_and_data -> + {Data,State,[]}; + {keep_state_and_data,Actions} -> + {Data,State,Actions}; + _ -> + terminate( + error, + {bad_return_from_state_function,Result}, + ?STACKTRACE(), + Debug, S, [Event|Events]) + end. + + +parse_enter_actions( + Debug, S, State, Actions, + Hibernate, TimeoutsR) -> + Postpone = forbidden, + NextEventsR = forbidden, + parse_actions( + Debug, S, State, listify(Actions), + Hibernate, TimeoutsR, Postpone, NextEventsR). + +parse_actions(Debug, S, State, Actions) -> + Hibernate = false, + TimeoutsR = [], + Postpone = false, + NextEventsR = [], + parse_actions( + Debug, S, State, listify(Actions), + Hibernate, TimeoutsR, Postpone, NextEventsR). +%% +parse_actions( + Debug, _S, _State, [], + Hibernate, TimeoutsR, Postpone, NextEventsR) -> + {ok,Debug,Hibernate,TimeoutsR,Postpone,NextEventsR}; +parse_actions( + Debug, S, State, [Action|Actions], + Hibernate, TimeoutsR, Postpone, NextEventsR) -> + case Action of + %% Actual actions + {reply,From,Reply} -> + case from(From) of + true -> + NewDebug = do_reply(Debug, S, State, From, Reply), + parse_actions( + NewDebug, S, State, Actions, + Hibernate, TimeoutsR, Postpone, NextEventsR); + false -> + {error, + {bad_action_from_state_function,Action}, + ?STACKTRACE()} + end; + %% Actions that set options + {hibernate,NewHibernate} when is_boolean(NewHibernate) -> + parse_actions( + Debug, S, State, Actions, + NewHibernate, TimeoutsR, Postpone, NextEventsR); + {hibernate,_} -> + {error, + {bad_action_from_state_function,Action}, + ?STACKTRACE()}; + hibernate -> + parse_actions( + Debug, S, State, Actions, + true, TimeoutsR, Postpone, NextEventsR); + {state_timeout,Time,_} = StateTimeout + when is_integer(Time), Time >= 0; + Time =:= infinity -> + parse_actions( + Debug, S, State, Actions, + Hibernate, [StateTimeout|TimeoutsR], Postpone, NextEventsR); + {state_timeout,_,_} -> + {error, + {bad_action_from_state_function,Action}, + ?STACKTRACE()}; + {timeout,infinity,_} -> + %% Ignore - timeout will never happen and already cancelled + parse_actions( + Debug, S, State, Actions, + Hibernate, TimeoutsR, Postpone, NextEventsR); + {timeout,Time,_} = Timeout when is_integer(Time), Time >= 0 -> + parse_actions( + Debug, S, State, Actions, + Hibernate, [Timeout|TimeoutsR], Postpone, NextEventsR); + {timeout,_,_} -> + {error, + {bad_action_from_state_function,Action}, + ?STACKTRACE()}; + infinity -> % Ignore - timeout will never happen + parse_actions( + Debug, S, State, Actions, + Hibernate, TimeoutsR, Postpone, NextEventsR); + Time when is_integer(Time), Time >= 0 -> + Timeout = {timeout,Time,Time}, + parse_actions( + Debug, S, State, Actions, + Hibernate, [Timeout|TimeoutsR], Postpone, NextEventsR); + {postpone,NewPostpone} + when is_boolean(NewPostpone), Postpone =/= forbidden -> + parse_actions( + Debug, S, State, Actions, + Hibernate, TimeoutsR, NewPostpone, NextEventsR); + {postpone,_} -> + {error, + {bad_action_from_state_function,Action}, + ?STACKTRACE()}; + postpone when Postpone =/= forbidden -> + parse_actions( + Debug, S, State, Actions, + Hibernate, TimeoutsR, true, NextEventsR); + {next_event,Type,Content} -> + case event_type(Type) of + true when NextEventsR =/= forbidden -> + NewDebug = + sys_debug(Debug, S, State, {in,{Type,Content}}), + parse_actions( + NewDebug, S, State, Actions, + Hibernate, TimeoutsR, Postpone, + [{Type,Content}|NextEventsR]); + _ -> + {error, + {bad_action_from_state_function,Action}, + ?STACKTRACE()} + end; + _ -> + {error, + {bad_action_from_state_function,Action}, + ?STACKTRACE()} + end. + + +%% Stop and start timers as well as create timeout zero events +%% and pending event timer +%% +%% Stop and start timers non-event timers +parse_timers(TimerRefs, TimerTypes, TimeoutsR) -> + parse_timers(TimerRefs, TimerTypes, TimeoutsR, #{}, []). +%% +parse_timers(TimerRefs, TimerTypes, [], _Seen, TimeoutEvents) -> + {TimerRefs,TimerTypes,TimeoutEvents}; +parse_timers( + TimerRefs, TimerTypes, [Timeout|TimeoutsR], Seen, TimeoutEvents) -> + {TimerType,Time,TimerMsg} = Timeout, + case Seen of + #{TimerType := _} -> + %% Type seen before - ignore + parse_timers( + TimerRefs, TimerTypes, TimeoutsR, Seen, TimeoutEvents); + #{} -> + %% Unseen type - handle + NewSeen = Seen#{TimerType => true}, + %% Cancel any running timer + {NewTimerRefs,NewTimerTypes} = + cancel_timer_by_type(TimerType, TimerRefs, TimerTypes), + if + Time =:= infinity -> + %% Ignore - timer will never fire + parse_timers( + NewTimerRefs, NewTimerTypes, TimeoutsR, + NewSeen, TimeoutEvents); + TimerType =:= timeout -> + %% Handle event timer later + parse_timers( + NewTimerRefs, NewTimerTypes, TimeoutsR, + NewSeen, [Timeout|TimeoutEvents]); + Time =:= 0 -> + %% Handle zero time timeouts later + TimeoutEvent = {TimerType,TimerMsg}, + parse_timers( + NewTimerRefs, NewTimerTypes, TimeoutsR, + NewSeen, [TimeoutEvent|TimeoutEvents]); + true -> + %% Start a new timer + TimerRef = erlang:start_timer(Time, self(), TimerMsg), + parse_timers( + NewTimerRefs#{TimerRef => TimerType}, + NewTimerTypes#{TimerType => TimerRef}, + TimeoutsR, NewSeen, TimeoutEvents) + end + end. + +%% Enqueue immediate timeout events and start event timer +process_timeout_events(TimerRefs, TimerTypes, [], EventsR) -> + {TimerRefs, TimerTypes, EventsR}; +process_timeout_events( + TimerRefs, TimerTypes, + [{timeout,0,TimerMsg}|TimeoutEvents], []) -> + %% No enqueued events - insert a timeout zero event + TimeoutEvent = {timeout,TimerMsg}, + process_timeout_events( + TimerRefs, TimerTypes, + TimeoutEvents, [TimeoutEvent]); +process_timeout_events( + TimerRefs, TimerTypes, + [{timeout,Time,TimerMsg}], []) -> + %% No enqueued events - start event timer + TimerRef = erlang:start_timer(Time, self(), TimerMsg), + process_timeout_events( + TimerRefs#{TimerRef => timeout}, TimerTypes#{timeout => TimerRef}, + [], []); +process_timeout_events( + TimerRefs, TimerTypes, + [{timeout,_Time,_TimerMsg}|TimeoutEvents], EventsR) -> + %% There will be some other event so optimize by not starting + %% an event timer to just have to cancel it again + process_timeout_events( + TimerRefs, TimerTypes, + TimeoutEvents, EventsR); +process_timeout_events( + TimerRefs, TimerTypes, + [{_TimeoutType,_TimeoutMsg} = TimeoutEvent|TimeoutEvents], EventsR) -> + process_timeout_events( + TimerRefs, TimerTypes, + TimeoutEvents, [TimeoutEvent|EventsR]). + + + +%%--------------------------------------------------------------------------- +%% Server helpers + +reply_then_terminate( + Class, Reason, Stacktrace, + Debug, #{state := State} = S, Q, Replies) -> + if + is_list(Replies) -> + do_reply_then_terminate( + Class, Reason, Stacktrace, + Debug, S, Q, Replies, State); + true -> + do_reply_then_terminate( + Class, Reason, Stacktrace, + Debug, S, Q, [Replies], State) + end. +%% +do_reply_then_terminate( + Class, Reason, Stacktrace, Debug, S, Q, [], _State) -> + terminate(Class, Reason, Stacktrace, Debug, S, Q); +do_reply_then_terminate( + Class, Reason, Stacktrace, Debug, S, Q, [R|Rs], State) -> + case R of + {reply,{_To,_Tag}=From,Reply} -> + NewDebug = do_reply(Debug, S, State, From, Reply), + do_reply_then_terminate( + Class, Reason, Stacktrace, NewDebug, S, Q, Rs, State); + _ -> + terminate( + error, + {bad_reply_action_from_state_function,R}, + ?STACKTRACE(), + Debug, S, Q) + end. + +do_reply(Debug, S, State, From, Reply) -> + reply(From, Reply), + sys_debug(Debug, S, State, {out,Reply,From}). + + +terminate( + Class, Reason, Stacktrace, + Debug, + #{module := Module, state := State, data := Data, postponed := P} = S, + Q) -> + try Module:terminate(Reason, State, Data) of + _ -> ok + catch + _ -> ok; + C:R -> + ST = erlang:get_stacktrace(), + error_info( + C, R, ST, S, Q, P, + format_status(terminate, get(), S)), + sys:print_log(Debug), + erlang:raise(C, R, ST) + end, + _ = + case Reason of + normal -> + sys_debug(Debug, S, State, {terminate,Reason}); + shutdown -> + sys_debug(Debug, S, State, {terminate,Reason}); + {shutdown,_} -> + sys_debug(Debug, S, State, {terminate,Reason}); + _ -> + error_info( + Class, Reason, Stacktrace, S, Q, P, + format_status(terminate, get(), S)), + sys:print_log(Debug) + end, + case Stacktrace of + [] -> + erlang:Class(Reason); + _ -> + erlang:raise(Class, Reason, Stacktrace) + end. + +error_info( + Class, Reason, Stacktrace, + #{name := Name, + callback_mode := CallbackMode, + state_enter := StateEnter}, + Q, P, FmtData) -> + {FixedReason,FixedStacktrace} = + case Stacktrace of + [{M,F,Args,_}|ST] + when Class =:= error, Reason =:= undef -> + case code:is_loaded(M) of + false -> + {{'module could not be loaded',M},ST}; + _ -> + Arity = + if + is_list(Args) -> + length(Args); + is_integer(Args) -> + Args + end, + case erlang:function_exported(M, F, Arity) of + true -> + {Reason,Stacktrace}; + false -> + {{'function not exported',{M,F,Arity}}, + ST} + end + end; + _ -> {Reason,Stacktrace} + end, + CBMode = + case StateEnter of + true -> + [CallbackMode,state_enter]; + false -> + CallbackMode + end, + error_logger:format( + "** State machine ~p terminating~n" ++ + case Q of + [] -> ""; + _ -> "** Last event = ~p~n" + end ++ + "** When server state = ~p~n" ++ + "** Reason for termination = ~w:~p~n" ++ + "** Callback mode = ~p~n" ++ + case Q of + [_,_|_] -> "** Queued = ~p~n"; + _ -> "" + end ++ + case P of + [] -> ""; + _ -> "** Postponed = ~p~n" + end ++ + case FixedStacktrace of + [] -> ""; + _ -> "** Stacktrace =~n** ~p~n" + end, + [Name | + case Q of + [] -> []; + [Event|_] -> [Event] + end] ++ + [FmtData, + Class,FixedReason, + CBMode] ++ + case Q of + [_|[_|_] = Events] -> [Events]; + _ -> [] + end ++ + case P of + [] -> []; + _ -> [P] + end ++ + case FixedStacktrace of + [] -> []; + _ -> [FixedStacktrace] + end). + + +%% Call Module:format_status/2 or return a default value +format_status( + Opt, PDict, + #{module := Module, state := State, data := Data}) -> + case erlang:function_exported(Module, format_status, 2) of + true -> + try Module:format_status(Opt, [PDict,State,Data]) + catch + Result -> Result; + _:_ -> + format_status_default( + Opt, State, + atom_to_list(Module) ++ ":format_status/2 crashed") + end; + false -> + format_status_default(Opt, State, Data) + end. + +%% The default Module:format_status/2 +format_status_default(Opt, State, Data) -> + StateData = {State,Data}, + case Opt of + terminate -> + StateData; + _ -> + [{data,[{"State",StateData}]}] + end. + +listify(Item) when is_list(Item) -> + Item; +listify(Item) -> + [Item]. + +%% Cancel timer if running, otherwise no op +cancel_timer_by_type(TimerType, TimerRefs, TimerTypes) -> + case TimerTypes of + #{TimerType := TimerRef} -> + cancel_timer(TimerRef), + {maps:remove(TimerRef, TimerRefs), + maps:remove(TimerType, TimerTypes)}; + #{} -> + {TimerRefs,TimerTypes} + end. + +%%cancel_timer(undefined) -> +%% ok; +cancel_timer(TRef) -> + case erlang:cancel_timer(TRef) of + false -> + %% We have to assume that TRef is the ref of a running timer + %% and if so the timer has expired + %% hence we must wait for the timeout message + receive + {timeout,TRef,_} -> + ok + end; + _TimeLeft -> + ok + end. diff --git a/lib/stdlib/src/io.erl b/lib/stdlib/src/io.erl index 284f2e5a2b..f510f61e9f 100644 --- a/lib/stdlib/src/io.erl +++ b/lib/stdlib/src/io.erl @@ -444,7 +444,7 @@ scan_erl_form(Io, Prompt, Pos0, Options) -> %% Parsing Erlang code. -type parse_ret() :: {'ok', - ExprList :: erl_parse:abstract_expr(), + ExprList :: [erl_parse:abstract_expr()], EndLocation :: location()} | {'eof', EndLocation :: location()} | {'error', @@ -631,41 +631,20 @@ io_requests(Pid, [], [Rs|Cont], Tail) -> io_requests(_Pid, [], [], _Tail) -> {false,[]}. - -bc_req(Pid,{Op,Enc,Param},MaybeConvert) -> - case net_kernel:dflag_unicode_io(Pid) of - true -> - {false,{Op,Enc,Param}}; - false -> - {MaybeConvert,{Op,Param}} - end; -bc_req(Pid,{Op,Enc,P,F},MaybeConvert) -> - case net_kernel:dflag_unicode_io(Pid) of - true -> - {false,{Op,Enc,P,F}}; - false -> - {MaybeConvert,{Op,P,F}} - end; -bc_req(Pid, {Op,Enc,M,F,A},MaybeConvert) -> +bc_req(Pid, Req0, MaybeConvert) -> case net_kernel:dflag_unicode_io(Pid) of true -> - {false,{Op,Enc,M,F,A}}; + %% The most common case. A modern i/o server. + {false,Req0}; false -> - {MaybeConvert,{Op,M,F,A}} - end; -bc_req(Pid, {Op,Enc,P,M,F,A},MaybeConvert) -> - case net_kernel:dflag_unicode_io(Pid) of - true -> - {false,{Op,Enc,P,M,F,A}}; - false -> - {MaybeConvert,{Op,P,M,F,A}} - end; -bc_req(Pid,{Op,Enc},MaybeConvert) -> - case net_kernel:dflag_unicode_io(Pid) of - true -> - {false,{Op, Enc}}; - false -> - {MaybeConvert,Op} + %% Backward compatibility only. Unlikely to ever happen. + case tuple_to_list(Req0) of + [Op,_Enc] -> + {MaybeConvert,Op}; + [Op,_Enc|T] -> + Req = list_to_tuple([Op|T]), + {MaybeConvert,Req} + end end. io_request(Pid, {write,Term}) -> diff --git a/lib/stdlib/src/io_lib.erl b/lib/stdlib/src/io_lib.erl index ef30f16f18..ad98bc0420 100644 --- a/lib/stdlib/src/io_lib.erl +++ b/lib/stdlib/src/io_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -112,14 +112,14 @@ -type format_spec() :: #{ - control_char => char(), - args => [any()], - width => 'none' | integer(), - adjust => 'left' | 'right', - precision => 'none' | integer(), - pad_char => char(), - encoding => 'unicode' | 'latin1', - strings => boolean() + control_char := char(), + args := [any()], + width := 'none' | integer(), + adjust := 'left' | 'right', + precision := 'none' | integer(), + pad_char := char(), + encoding := 'unicode' | 'latin1', + strings := boolean() }. %%---------------------------------------------------------------------- diff --git a/lib/stdlib/src/io_lib_format.erl b/lib/stdlib/src/io_lib_format.erl index 282005da7d..1da866dc88 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-2014. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/lib/stdlib/src/io_lib_fread.erl b/lib/stdlib/src/io_lib_fread.erl index 25555c6f52..6a8f8f728e 100644 --- a/lib/stdlib/src/io_lib_fread.erl +++ b/lib/stdlib/src/io_lib_fread.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/lib/stdlib/src/io_lib_pretty.erl b/lib/stdlib/src/io_lib_pretty.erl index 6309addf57..16ca2f41dc 100644 --- a/lib/stdlib/src/io_lib_pretty.erl +++ b/lib/stdlib/src/io_lib_pretty.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/lib/stdlib/src/lib.erl b/lib/stdlib/src/lib.erl index eb24516c50..56654097d9 100644 --- a/lib/stdlib/src/lib.erl +++ b/lib/stdlib/src/lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -73,7 +73,7 @@ nonl([H|T]) -> [H|nonl(T)]. send(To, Msg) -> To ! Msg. --spec sendw(To, Msg) -> Msg when +-spec sendw(To, Msg) -> term() when To :: pid() | atom() | {atom(), node()}, Msg :: term(). diff --git a/lib/stdlib/src/lists.erl b/lib/stdlib/src/lists.erl index 62b6ca8a21..af9d63ddd6 100644 --- a/lib/stdlib/src/lists.erl +++ b/lib/stdlib/src/lists.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -39,7 +39,8 @@ -export([all/2,any/2,map/2,flatmap/2,foldl/3,foldr/3,filter/2, partition/2,zf/2,filtermap/2, mapfoldl/3,mapfoldr/3,foreach/2,takewhile/2,dropwhile/2,splitwith/2, - split/2]). + split/2, + join/2]). %%% BIFs -export([keyfind/3, keymember/3, keysearch/3, member/2, reverse/2]). @@ -1439,6 +1440,18 @@ split(N, [H|T], R) -> split(_, [], _) -> badarg. +-spec join(Sep, List1) -> List2 when + Sep :: T, + List1 :: [T], + List2 :: [T], + T :: term(). + +join(_Sep, []) -> []; +join(Sep, [H|T]) -> [H|join_prepend(Sep, T)]. + +join_prepend(_Sep, []) -> []; +join_prepend(Sep, [H|T]) -> [Sep,H|join_prepend(Sep,T)]. + %%% ================================================================= %%% Here follows the implementation of the sort functions. %%% @@ -2267,6 +2280,8 @@ ukeysplit_2(I, Y, EY, [Z | L], R) -> ukeysplit_2(_I, Y, _EY, [], R) -> [Y | R]. +-dialyzer({no_improper_lists, ukeymergel/3}). + ukeymergel(I, [T1, [H2 | T2], [H3 | T3] | L], Acc) -> %% The fourth argument, [H2 | H3] (=HdM), may confuse type %% checkers. Its purpose is to ensure that the tests H2 == HdM diff --git a/lib/stdlib/src/log_mf_h.erl b/lib/stdlib/src/log_mf_h.erl index 35723bbc9e..393da9ab27 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-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/lib/stdlib/src/maps.erl b/lib/stdlib/src/maps.erl index 3c798b7a04..5dafdb282a 100644 --- a/lib/stdlib/src/maps.erl +++ b/lib/stdlib/src/maps.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2013. All Rights Reserved. +%% Copyright Ericsson AB 2013-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -20,17 +20,18 @@ -module(maps). --export([get/3,filter/2,fold/3, map/2, - size/1, +-export([get/3, filter/2,fold/3, + map/2, size/1, + update_with/3, update_with/4, without/2, with/2]). - -%%% BIFs +%% BIFs -export([get/2, find/2, from_list/1, is_key/2, keys/1, merge/2, - new/0, put/3, remove/2, + new/0, put/3, remove/2, take/2, to_list/1, update/3, values/1]). +%% Shadowed by erl_bif_types: maps:get/2 -spec get(Key,Map) -> Value when Key :: term(), Map :: map(), @@ -46,7 +47,7 @@ get(_,_) -> erlang:nif_error(undef). find(_,_) -> erlang:nif_error(undef). - +%% Shadowed by erl_bif_types: maps:from_list/1 -spec from_list(List) -> Map when List :: [{Key,Value}], Key :: term(), @@ -56,6 +57,7 @@ find(_,_) -> erlang:nif_error(undef). from_list(_) -> erlang:nif_error(undef). +%% Shadowed by erl_bif_types: maps:is_key/2 -spec is_key(Key,Map) -> boolean() when Key :: term(), Map :: map(). @@ -71,6 +73,7 @@ is_key(_,_) -> erlang:nif_error(undef). keys(_) -> erlang:nif_error(undef). +%% Shadowed by erl_bif_types: maps:merge/2 -spec merge(Map1,Map2) -> Map3 when Map1 :: map(), Map2 :: map(), @@ -86,6 +89,7 @@ merge(_,_) -> erlang:nif_error(undef). new() -> erlang:nif_error(undef). +%% Shadowed by erl_bif_types: maps:put/3 -spec put(Key,Value,Map1) -> Map2 when Key :: term(), Value :: term(), @@ -102,7 +106,15 @@ put(_,_,_) -> erlang:nif_error(undef). remove(_,_) -> erlang:nif_error(undef). +-spec take(Key,Map1) -> {Value,Map2} | error when + Key :: term(), + Map1 :: map(), + Value :: term(), + Map2 :: map(). + +take(_,_) -> erlang:nif_error(undef). +%% Shadowed by erl_bif_types: maps:to_list/1 -spec to_list(Map) -> [{Key,Value}] when Map :: map(), Key :: term(), @@ -111,6 +123,7 @@ remove(_,_) -> erlang:nif_error(undef). to_list(_) -> erlang:nif_error(undef). +%% Shadowed by erl_bif_types: maps:update/3 -spec update(Key,Value,Map1) -> Map2 when Key :: term(), Value :: term(), @@ -127,8 +140,40 @@ update(_,_,_) -> erlang:nif_error(undef). values(_) -> erlang:nif_error(undef). +%% End of BIFs + +-spec update_with(Key,Fun,Map1) -> Map2 when + Key :: term(), + Map1 :: map(), + Map2 :: map(), + Fun :: fun((Value1 :: term()) -> Value2 :: term()). + +update_with(Key,Fun,Map) when is_function(Fun,1), is_map(Map) -> + try maps:get(Key,Map) of + Val -> maps:update(Key,Fun(Val),Map) + catch + error:{badkey,_} -> + erlang:error({badkey,Key},[Key,Fun,Map]) + end; +update_with(Key,Fun,Map) -> + erlang:error(error_type(Map),[Key,Fun,Map]). + + +-spec update_with(Key,Fun,Init,Map1) -> Map2 when + Key :: term(), + Map1 :: Map1, + Map2 :: Map2, + Fun :: fun((Value1 :: term()) -> Value2 :: term()), + Init :: term(). + +update_with(Key,Fun,Init,Map) when is_function(Fun,1), is_map(Map) -> + case maps:find(Key,Map) of + {ok,Val} -> maps:update(Key,Fun(Val),Map); + error -> maps:put(Key,Init,Map) + end; +update_with(Key,Fun,Init,Map) -> + erlang:error(error_type(Map),[Key,Fun,Init,Map]). -%%% End of BIFs -spec get(Key, Map, Default) -> Value | Default when Key :: term(), @@ -205,7 +250,7 @@ size(Val) -> K :: term(). without(Ks,M) when is_list(Ks), is_map(M) -> - maps:from_list([{K,V}||{K,V} <- maps:to_list(M), not lists:member(K, Ks)]); + lists:foldl(fun(K, M1) -> ?MODULE:remove(K, M1) end, M, Ks); without(Ks,M) -> erlang:error(error_type(M),[Ks,M]). @@ -216,8 +261,16 @@ without(Ks,M) -> Map2 :: map(), K :: term(). -with(Ks,M) when is_list(Ks), is_map(M) -> - maps:from_list([{K,V}||{K,V} <- maps:to_list(M), lists:member(K, Ks)]); +with(Ks,Map1) when is_list(Ks), is_map(Map1) -> + Fun = fun(K, List) -> + case ?MODULE:find(K, Map1) of + {ok, V} -> + [{K, V} | List]; + error -> + List + end + end, + ?MODULE:from_list(lists:foldl(Fun, [], Ks)); with(Ks,M) -> erlang:error(error_type(M),[Ks,M]). diff --git a/lib/stdlib/src/math.erl b/lib/stdlib/src/math.erl index 06dfc01bbb..97c965e27a 100644 --- a/lib/stdlib/src/math.erl +++ b/lib/stdlib/src/math.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2012. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/lib/stdlib/src/ms_transform.erl b/lib/stdlib/src/ms_transform.erl index b67b6f75d7..98745b13f3 100644 --- a/lib/stdlib/src/ms_transform.erl +++ b/lib/stdlib/src/ms_transform.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2015. All Rights Reserved. +%% Copyright Ericsson AB 2002-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -224,8 +224,9 @@ transform_from_shell(Dialect, Clauses, BoundEnvironment) -> %% Called when translating during compiling %% --spec parse_transform(Forms, Options) -> Forms when - Forms :: [erl_parse:abstract_form()], +-spec parse_transform(Forms, Options) -> Forms2 when + Forms :: [erl_parse:abstract_form() | erl_parse:form_info()], + Forms2 :: [erl_parse:abstract_form() | erl_parse:form_info()], Options :: term(). parse_transform(Forms, _Options) -> @@ -307,15 +308,18 @@ cleanup_filename({Old,OldRec,OldWarnings}) -> add_record_definition({Name,FieldList}) -> {KeyList,_} = lists:foldl( - fun({record_field,_,{atom,Line0,FieldName}},{L,C}) -> - {[{FieldName,C,{atom,Line0,undefined}}|L],C+1}; - ({record_field,_,{atom,_,FieldName},Def},{L,C}) -> - {[{FieldName,C,Def}|L],C+1} - end, + fun(F, {L,C}) -> {[record_field(F, C)|L],C+1} end, {[],2}, FieldList), put_records([{Name,KeyList}|get_records()]). +record_field({record_field,_,{atom,Line0,FieldName}}, C) -> + {FieldName,C,{atom,Line0,undefined}}; +record_field({record_field,_,{atom,_,FieldName},Def}, C) -> + {FieldName,C,Def}; +record_field({typed_record_field,Field,_Type}, C) -> + record_field(Field, C). + forms([F0|Fs0]) -> F1 = form(F0), Fs1 = forms(Fs0), @@ -447,6 +451,8 @@ check_type(_,[{record,_,_,_}],ets) -> ok; check_type(_,[{cons,_,_,_}],dbg) -> ok; +check_type(_,[{nil,_}],dbg) -> + ok; check_type(Line0,[{match,_,{var,_,_},X}],Any) -> check_type(Line0,[X],Any); check_type(Line0,[{match,_,X,{var,_,_}}],Any) -> diff --git a/lib/stdlib/src/ordsets.erl b/lib/stdlib/src/ordsets.erl index 6010b41006..569407f5ef 100644 --- a/lib/stdlib/src/ordsets.erl +++ b/lib/stdlib/src/ordsets.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl index 2d77888512..3bd338071b 100644 --- a/lib/stdlib/src/otp_internal.erl +++ b/lib/stdlib/src/otp_internal.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2015. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -23,6 +23,8 @@ %%---------------------------------------------------------------------- +-dialyzer({no_match, obsolete/3}). + -type tag() :: 'deprecated' | 'removed'. %% | 'experimental'. -type mfas() :: mfa() | {atom(), atom(), [byte()]}. -type release() :: string(). @@ -33,7 +35,7 @@ obsolete(Module, Name, Arity) -> case obsolete_1(Module, Name, Arity) of {deprecated=Tag,{_,_,_}=Replacement} -> - {Tag,Replacement,"in a future release"}; + {Tag,Replacement,"a future release"}; {_,String}=Ret when is_list(String) -> Ret; {_,_,_}=Ret -> @@ -45,18 +47,6 @@ obsolete(Module, Name, Arity) -> obsolete_1(net, _, _) -> {deprecated, "module 'net' obsolete; use 'net_adm'"}; -obsolete_1(erl_internal, builtins, 0) -> - {deprecated, {erl_internal, bif, 2}}; - -obsolete_1(erl_eval, seq, 2) -> - {deprecated, {erl_eval, exprs, 2}}; -obsolete_1(erl_eval, seq, 3) -> - {deprecated, {erl_eval, exprs, 3}}; -obsolete_1(erl_eval, arg_list, 2) -> - {deprecated, {erl_eval, expr_list, 2}}; -obsolete_1(erl_eval, arg_list, 3) -> - {deprecated, {erl_eval, expr_list, 3}}; - obsolete_1(erlang, hash, 2) -> {deprecated, {erlang, phash2, 2}}; @@ -68,11 +58,12 @@ obsolete_1(erlang, now, 0) -> obsolete_1(calendar, local_time_to_universal_time, 1) -> {deprecated, {calendar, local_time_to_universal_time_dst, 1}}; -obsolete_1(rpc, safe_multi_server_call, A) when A =:= 2; A =:= 3 -> - {deprecated, {rpc, multi_server_call, A}}; +%% *** CRYPTO added in OTP 19 *** +obsolete_1(crypto, rand_bytes, 1) -> + {deprecated, {crypto, strong_rand_bytes, 1}}; -%% *** CRYPTO add in R16B01 *** +%% *** CRYPTO added in R16B01 *** obsolete_1(crypto, md4, 1) -> {deprecated, {crypto, hash, 2}}; @@ -389,106 +380,10 @@ obsolete_1(http, cookie_header, 2) -> {removed,{httpc,cookie_header,2},"R15B" obsolete_1(http, stream_next, 1) -> {removed,{httpc,stream_next,1},"R15B"}; obsolete_1(http, default_profile, 0) -> {removed,{httpc,default_profile,0},"R15B"}; -obsolete_1(httpd, start, 0) -> {removed,{inets,start,[2,3]},"R14B"}; -obsolete_1(httpd, start, 1) -> {removed,{inets,start,[2,3]},"R14B"}; -obsolete_1(httpd, start_link, 0) -> {removed,{inets,start,[2,3]},"R14B"}; -obsolete_1(httpd, start_link, 1) -> {removed,{inets,start,[2,3]},"R14B"}; -obsolete_1(httpd, start_child, 0) -> {removed,{inets,start,[2,3]},"R14B"}; -obsolete_1(httpd, start_child, 1) -> {removed,{inets,start,[2,3]},"R14B"}; -obsolete_1(httpd, stop, 0) -> {removed,{inets,stop,2},"R14B"}; -obsolete_1(httpd, stop, 1) -> {removed,{inets,stop,2},"R14B"}; -obsolete_1(httpd, stop, 2) -> {removed,{inets,stop,2},"R14B"}; -obsolete_1(httpd, stop_child, 0) -> {removed,{inets,stop,2},"R14B"}; -obsolete_1(httpd, stop_child, 1) -> {removed,{inets,stop,2},"R14B"}; -obsolete_1(httpd, stop_child, 2) -> {removed,{inets,stop,2},"R14B"}; -obsolete_1(httpd, restart, 0) -> {removed,{httpd,reload_config,2},"R14B"}; -obsolete_1(httpd, restart, 1) -> {removed,{httpd,reload_config,2},"R14B"}; -obsolete_1(httpd, restart, 2) -> {removed,{httpd,reload_config,2},"R14B"}; -obsolete_1(httpd, block, 0) -> {removed,{httpd,reload_config,2},"R14B"}; -obsolete_1(httpd, block, 1) -> {removed,{httpd,reload_config,2},"R14B"}; -obsolete_1(httpd, block, 2) -> {removed,{httpd,reload_config,2},"R14B"}; -obsolete_1(httpd, block, 3) -> {removed,{httpd,reload_config,2},"R14B"}; -obsolete_1(httpd, block, 4) -> {removed,{httpd,reload_config,2},"R14B"}; -obsolete_1(httpd, unblock, 0) -> {removed,{httpd,reload_config,2},"R14B"}; -obsolete_1(httpd, unblock, 1) -> {removed,{httpd,reload_config,2},"R14B"}; -obsolete_1(httpd, unblock, 2) -> {removed,{httpd,reload_config,2},"R14B"}; -obsolete_1(httpd_util, key1search, 2) -> {removed,{proplists,get_value,2},"R13B"}; -obsolete_1(httpd_util, key1search, 3) -> {removed,{proplists,get_value,3},"R13B"}; -obsolete_1(ftp, open, 3) -> {removed,{inets,start,[2,3]},"R14B"}; -obsolete_1(ftp, force_active, 1) -> {removed,{inets,start,[2,3]},"R14B"}; - -%% Added in R12B-4. -obsolete_1(ssh_cm, connect, A) when 1 =< A, A =< 3 -> - {removed,{ssh,connect,A},"R14B"}; -obsolete_1(ssh_cm, listen, A) when 2 =< A, A =< 4 -> - {removed,{ssh,daemon,A},"R14B"}; -obsolete_1(ssh_cm, stop_listener, 1) -> - {removed,{ssh,stop_listener,[1,2]},"R14B"}; -obsolete_1(ssh_cm, session_open, A) when A =:= 2; A =:= 4 -> - {removed,{ssh_connection,session_channel,A},"R14B"}; -obsolete_1(ssh_cm, direct_tcpip, A) when A =:= 6; A =:= 8 -> - {removed,{ssh_connection,direct_tcpip,A},"R14B"}; -obsolete_1(ssh_cm, tcpip_forward, 3) -> - {removed,{ssh_connection,tcpip_forward,3},"R14B"}; -obsolete_1(ssh_cm, cancel_tcpip_forward, 3) -> - {removed,{ssh_connection,cancel_tcpip_forward,3},"R14B"}; -obsolete_1(ssh_cm, open_pty, A) when A =:= 3; A =:= 7; A =:= 9 -> - {removed,{ssh_connection,open_pty,A},"R14B"}; -obsolete_1(ssh_cm, setenv, 5) -> - {removed,{ssh_connection,setenv,5},"R14B"}; -obsolete_1(ssh_cm, shell, 2) -> - {removed,{ssh_connection,shell,2},"R14B"}; -obsolete_1(ssh_cm, exec, 4) -> - {removed,{ssh_connection,exec,4},"R14B"}; -obsolete_1(ssh_cm, subsystem, 4) -> - {removed,{ssh_connection,subsystem,4},"R14B"}; -obsolete_1(ssh_cm, winch, A) when A =:= 4; A =:= 6 -> - {removed,{ssh_connection,window_change,A},"R14B"}; -obsolete_1(ssh_cm, signal, 3) -> - {removed,{ssh_connection,signal,3},"R14B"}; -obsolete_1(ssh_cm, attach, A) when A =:= 2; A =:= 3 -> - {removed,"no longer useful; removed in R14B"}; -obsolete_1(ssh_cm, detach, 2) -> - {removed,"no longer useful; removed in R14B"}; -obsolete_1(ssh_cm, set_user_ack, 4) -> - {removed,"no longer useful; removed in R14B"}; -obsolete_1(ssh_cm, adjust_window, 3) -> - {removed,{ssh_connection,adjust_window,3},"R14B"}; -obsolete_1(ssh_cm, close, 2) -> - {removed,{ssh_connection,close,2},"R14B"}; -obsolete_1(ssh_cm, stop, 1) -> - {removed,{ssh,close,1},"R14B"}; -obsolete_1(ssh_cm, send_eof, 2) -> - {removed,{ssh_connection,send_eof,2},"R14B"}; -obsolete_1(ssh_cm, send, A) when A =:= 3; A =:= 4 -> - {removed,{ssh_connection,send,A},"R14B"}; -obsolete_1(ssh_cm, send_ack, A) when 3 =< A, A =< 5 -> - {removed,{ssh_connection,send,[3,4]},"R14B"}; -obsolete_1(ssh_ssh, connect, A) when 1 =< A, A =< 3 -> - {removed,{ssh,shell,A},"R14B"}; -obsolete_1(ssh_sshd, listen, A) when 0 =< A, A =< 3 -> - {removed,{ssh,daemon,[1,2,3]},"R14B"}; -obsolete_1(ssh_sshd, stop, 1) -> - {removed,{ssh,stop_listener,1},"R14B"}; - %% Added in R13A. obsolete_1(regexp, _, _) -> {removed, "removed in R15; use the re module instead"}; -obsolete_1(lists, flat_length, 1) -> - {removed,{lists,flatlength,1},"R14"}; - -obsolete_1(ssh_sftp, connect, A) when 1 =< A, A =< 3 -> - {removed,{ssh_sftp,start_channel,A},"R14B"}; -obsolete_1(ssh_sftp, stop, 1) -> - {removed,{ssh_sftp,stop_channel,1},"R14B"}; - -%% Added in R13B01. -obsolete_1(ssl_pkix, decode_cert_file, A) when A =:= 1; A =:= 2 -> - {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 -> - {removed,{public_key,pkix_decode_cert,2},"R14A"}; - %% Added in R13B04. obsolete_1(erlang, concat_binary, 1) -> {removed,{erlang,list_to_binary,1},"R15B"}; @@ -586,49 +481,40 @@ obsolete_1(asn1rt, utf8_list_to_binary, 1) -> %% Added in OTP 18. obsolete_1(core_lib, get_anno, 1) -> - {deprecated,{cerl,get_ann,1}}; + {removed,{cerl,get_ann,1},"19"}; obsolete_1(core_lib, set_anno, 2) -> - {deprecated,{cerl,set_ann,2}}; + {removed,{cerl,set_ann,2},"19"}; obsolete_1(core_lib, is_literal, 1) -> - {deprecated,{cerl,is_literal,1}}; + {removed,{cerl,is_literal,1},"19"}; obsolete_1(core_lib, is_literal_list, 1) -> - {deprecated,"deprecated; use lists:all(fun cerl:is_literal/1, L)" + {removed,"removed; use lists:all(fun cerl:is_literal/1, L)" " instead"}; obsolete_1(core_lib, literal_value, 1) -> - {deprecated,{core_lib,concrete,1}}; + {removed,{core_lib,concrete,1},"19"}; obsolete_1(erl_scan, set_attribute, 3) -> - {deprecated, - "deprecated (will be removed in OTP 19); use erl_anno:set_line/2 instead"}; + {removed,{erl_anno,set_line,2},"19.0"}; obsolete_1(erl_scan, attributes_info, 1) -> - {deprecated, - "deprecated (will be removed in OTP 19); use " + {removed,"removed in 19.0; use " "erl_anno:{column,line,location,text}/1 instead"}; obsolete_1(erl_scan, attributes_info, 2) -> - {deprecated, - "deprecated (will be removed in OTP 19); use " + {removed,"removed in 19.0; use " "erl_anno:{column,line,location,text}/1 instead"}; obsolete_1(erl_scan, token_info, 1) -> - {deprecated, - "deprecated (will be removed in OTP 19); use " + {removed,"removed in 19.0; use " "erl_scan:{category,column,line,location,symbol,text}/1 instead"}; obsolete_1(erl_scan, token_info, 2) -> - {deprecated, - "deprecated (will be removed in OTP 19); use " + {removed,"removed in 19.0; use " "erl_scan:{category,column,line,location,symbol,text}/1 instead"}; obsolete_1(erl_parse, set_line, 2) -> - {deprecated, - "deprecated (will be removed in OTP 19); use erl_anno:set_line/2 instead"}; + {removed,{erl_anno,set_line,2},"19.0"}; obsolete_1(erl_parse, get_attributes, 1) -> - {deprecated, - "deprecated (will be removed in OTP 19); use " + {removed,"removed in 19.0; use " "erl_anno:{column,line,location,text}/1 instead"}; obsolete_1(erl_parse, get_attribute, 2) -> - {deprecated, - "deprecated (will be removed in OTP 19); use " + {removed,"removed in 19.0; use " "erl_anno:{column,line,location,text}/1 instead"}; obsolete_1(erl_lint, modify_line, 2) -> - {deprecated, - "deprecated (will be removed in OTP 19); use erl_parse:map_anno/2 instead"}; + {removed,{erl_parse,map_anno,2},"19.0"}; obsolete_1(ssl, negotiated_next_protocol, 1) -> {deprecated,{ssl,negotiated_protocol,1}}; @@ -648,6 +534,23 @@ obsolete_1(httpd_conf, is_file, 1) -> obsolete_1(httpd_conf, make_integer, 1) -> {deprecated, "deprecated; use erlang:list_to_integer/1 instead"}; +%% Added in OTP 19. + +obsolete_1(random, _, _) -> + {deprecated, "the 'random' module is deprecated; " + "use the 'rand' module instead"}; +obsolete_1(code, rehash, 0) -> + {deprecated, "deprecated because the code path cache feature has been removed"}; +obsolete_1(queue, lait, 1) -> + {deprecated, {queue,liat,1}}; + +%% Removed in OTP 19. + +obsolete_1(overload, _, _) -> + {removed, "removed in OTP 19"}; +obsolete_1(rpc, safe_multi_server_call, A) when A =:= 2; A =:= 3 -> + {removed, {rpc, multi_server_call, A}}; + obsolete_1(_, _, _) -> no. @@ -695,29 +598,29 @@ is_snmp_agent_function(del_agent_caps, 1) -> true; is_snmp_agent_function(get_agent_caps, 0) -> true; is_snmp_agent_function(_, _) -> false. +-dialyzer({no_match, obsolete_type/3}). + -spec obsolete_type(module(), atom(), arity()) -> 'no' | {tag(), string()} | {tag(), mfas(), release()}. +-dialyzer({no_match, obsolete_type/3}). obsolete_type(Module, Name, NumberOfVariables) -> case obsolete_type_1(Module, Name, NumberOfVariables) of -%% {deprecated=Tag,{_,_,_}=Replacement} -> -%% {Tag,Replacement,"in a future release"}; + {deprecated=Tag,{_,_,_}=Replacement} -> + {Tag,Replacement,"in a future release"}; {_,String}=Ret when is_list(String) -> Ret; -%% {_,_,_}=Ret -> -%% Ret; + {_,_,_}=Ret -> + Ret; no -> no end. obsolete_type_1(erl_scan,column,0) -> - {deprecated, - "deprecated (will be removed in OTP 19); use erl_anno:column() instead"}; + {removed,{erl_anno,column,0},"19.0"}; obsolete_type_1(erl_scan,line,0) -> - {deprecated, - "deprecated (will be removed in OTP 19); use erl_anno:line() instead"}; + {removed,{erl_anno,line,0},"19.0"}; obsolete_type_1(erl_scan,location,0) -> - {deprecated, - "deprecated (will be removed in OTP 19); use erl_anno:location() instead"}; + {removed,{erl_anno,location,0},"19.0"}; obsolete_type_1(_,_,_) -> no. diff --git a/lib/stdlib/src/pool.erl b/lib/stdlib/src/pool.erl index 2112337f65..05950a1d7c 100644 --- a/lib/stdlib/src/pool.erl +++ b/lib/stdlib/src/pool.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/lib/stdlib/src/proc_lib.erl b/lib/stdlib/src/proc_lib.erl index bbf4f573f5..3dc1848550 100644 --- a/lib/stdlib/src/proc_lib.erl +++ b/lib/stdlib/src/proc_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -30,7 +30,8 @@ start/3, start/4, start/5, start_link/3, start_link/4, start_link/5, hibernate/3, init_ack/1, init_ack/2, - init_p/3,init_p/5,format/1,format/2,initial_call/1, + init_p/3,init_p/5,format/1,format/2,format/3, + initial_call/1, translate_initial_call/1, stop/1, stop/3]). @@ -42,12 +43,19 @@ %%----------------------------------------------------------------------------- -type priority_level() :: 'high' | 'low' | 'max' | 'normal'. +-type max_heap_size() :: non_neg_integer() | + #{ size => non_neg_integer(), + kill => true, + error_logger => true}. -type spawn_option() :: 'link' | 'monitor' | {'priority', priority_level()} + | {'max_heap_size', max_heap_size()} | {'min_heap_size', non_neg_integer()} | {'min_bin_vheap_size', non_neg_integer()} - | {'fullsweep_after', non_neg_integer()}. + | {'fullsweep_after', non_neg_integer()} + | {'message_queue_data', + 'off_heap' | 'on_heap' | 'mixed' }. -type dict_or_pid() :: pid() | (ProcInfo :: [_]) @@ -471,16 +479,12 @@ trans_init(gen,init_it,[gen_server,_,_,supervisor_bridge,[Module|_],_]) -> {supervisor_bridge,Module,1}; trans_init(gen,init_it,[gen_server,_,_,_,supervisor_bridge,[Module|_],_]) -> {supervisor_bridge,Module,1}; -trans_init(gen,init_it,[gen_server,_,_,Module,_,_]) -> - {Module,init,1}; -trans_init(gen,init_it,[gen_server,_,_,_,Module|_]) -> - {Module,init,1}; -trans_init(gen,init_it,[gen_fsm,_,_,Module,_,_]) -> - {Module,init,1}; -trans_init(gen,init_it,[gen_fsm,_,_,_,Module|_]) -> - {Module,init,1}; trans_init(gen,init_it,[gen_event|_]) -> {gen_event,init_it,6}; +trans_init(gen,init_it,[_GenMod,_,_,Module,_,_]) when is_atom(Module) -> + {Module,init,1}; +trans_init(gen,init_it,[_GenMod,_,_,_,Module|_]) when is_atom(Module) -> + {Module,init,1}; trans_init(M, F, A) when is_atom(M), is_atom(F) -> {M,F,length(A)}. @@ -700,53 +704,71 @@ format(CrashReport) -> CrashReport :: [term()], Encoding :: latin1 | unicode | utf8. -format([OwnReport,LinkReport], Encoding) -> - OwnFormat = format_report(OwnReport, Encoding), - LinkFormat = format_report(LinkReport, Encoding), +format(CrashReport, Encoding) -> + format(CrashReport, Encoding, unlimited). + +-spec format(CrashReport, Encoding, Depth) -> string() when + CrashReport :: [term()], + Encoding :: latin1 | unicode | utf8, + Depth :: unlimited | pos_integer(). + +format([OwnReport,LinkReport], Encoding, Depth) -> + Extra = {Encoding,Depth}, + OwnFormat = format_report(OwnReport, Extra), + LinkFormat = format_report(LinkReport, Extra), Str = io_lib:format(" crasher:~n~ts neighbours:~n~ts", [OwnFormat, LinkFormat]), lists:flatten(Str). -format_report(Rep, Enc) when is_list(Rep) -> - format_rep(Rep,Enc); -format_report(Rep, Enc) -> +format_report(Rep, Extra) when is_list(Rep) -> + format_rep(Rep, Extra); +format_report(Rep, {Enc,_}) -> io_lib:format("~"++modifier(Enc)++"p~n", [Rep]). -format_rep([{initial_call,InitialCall}|Rep], Enc) -> - [format_mfa(InitialCall)|format_rep(Rep, Enc)]; -format_rep([{error_info,{Class,Reason,StackTrace}}|Rep], Enc) -> - [format_exception(Class, Reason, StackTrace, Enc)|format_rep(Rep, Enc)]; -format_rep([{Tag,Data}|Rep], Enc) -> - [format_tag(Tag, Data)|format_rep(Rep, Enc)]; -format_rep(_, _Enc) -> +format_rep([{initial_call,InitialCall}|Rep], {_Enc,Depth}=Extra) -> + [format_mfa(InitialCall, Depth)|format_rep(Rep, Extra)]; +format_rep([{error_info,{Class,Reason,StackTrace}}|Rep], Extra) -> + [format_exception(Class, Reason, StackTrace, Extra)|format_rep(Rep, Extra)]; +format_rep([{Tag,Data}|Rep], Extra) -> + [format_tag(Tag, Data, Extra)|format_rep(Rep, Extra)]; +format_rep(_, _Extra) -> []. -format_exception(Class, Reason, StackTrace, Enc) -> - PF = pp_fun(Enc), +format_exception(Class, Reason, StackTrace, {Enc,_}=Extra) -> + PF = pp_fun(Extra), StackFun = fun(M, _F, _A) -> (M =:= erl_eval) or (M =:= ?MODULE) end, %% EI = " exception: ", EI = " ", [EI, lib:format_exception(1+length(EI), Class, Reason, StackTrace, StackFun, PF, Enc), "\n"]. -format_mfa({M,F,Args}=StartF) -> +format_mfa({M,F,Args}=StartF, Depth) -> try A = length(Args), [" initial call: ",atom_to_list(M),$:,atom_to_list(F),$/, integer_to_list(A),"\n"] catch error:_ -> - format_tag(initial_call, StartF) + format_tag(initial_call, StartF, Depth) end. -pp_fun(Enc) -> - P = modifier(Enc) ++ "p", +pp_fun({Enc,Depth}) -> + {Letter,Tl} = case Depth of + unlimited -> {"p",[]}; + _ -> {"P",[Depth]} + end, + P = modifier(Enc) ++ Letter, fun(Term, I) -> - io_lib:format("~." ++ integer_to_list(I) ++ P, [Term]) + io_lib:format("~." ++ integer_to_list(I) ++ P, [Term|Tl]) end. -format_tag(Tag, Data) -> - io_lib:format(" ~p: ~80.18p~n", [Tag, Data]). +format_tag(Tag, Data, {_Enc,Depth}) -> + case Depth of + unlimited -> + io_lib:format(" ~p: ~80.18p~n", [Tag, Data]); + _ -> + io_lib:format(" ~p: ~80.18P~n", [Tag, Data, Depth]) + end. modifier(latin1) -> ""; modifier(_) -> "t". diff --git a/lib/stdlib/src/proplists.erl b/lib/stdlib/src/proplists.erl index 1840fa5cc0..5356467b19 100644 --- a/lib/stdlib/src/proplists.erl +++ b/lib/stdlib/src/proplists.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2013. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -438,8 +438,9 @@ substitute_aliases_1([], P) -> %% @see normalize/2 -spec substitute_negations(Negations, ListIn) -> ListOut when - Negations :: [{Key, Key}], - Key :: term(), + Negations :: [{Key1, Key2}], + Key1 :: term(), + Key2 :: term(), ListIn :: [term()], ListOut :: [term()]. diff --git a/lib/stdlib/src/qlc.erl b/lib/stdlib/src/qlc.erl index 3ba3a88038..f3665824f2 100644 --- a/lib/stdlib/src/qlc.erl +++ b/lib/stdlib/src/qlc.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2015. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -51,6 +51,8 @@ -export([template_state/0, aux_name/3, name_suffix/2, vars/1, var_ufold/2, var_fold/3, all_selections/1]). +-dialyzer(no_improper_lists). + %% When cache=list lists bigger than ?MAX_LIST_SIZE bytes are put on %% file. Also used when merge join finds big equivalence classes. -define(MAX_LIST_SIZE, 512*1024). @@ -732,10 +734,11 @@ table(TraverseFun, Options) when is_function(TraverseFun) -> table(T1, T2) -> erlang:error(badarg, [T1, T2]). --spec(transform_from_evaluator(LC, Bs) -> Expr when +-spec(transform_from_evaluator(LC, Bs) -> Return when LC :: abstract_expr(), - Expr :: abstract_expr(), - Bs :: erl_eval:binding_struct()). + Bs :: erl_eval:binding_struct(), + Return :: {ok, abstract_expr()} + | {not_ok, {error, module(), Reason :: term()}}). transform_from_evaluator(LC, Bs0) -> qlc_pt:transform_from_evaluator(LC, Bs0). @@ -808,21 +811,21 @@ options(Options0, [Key | Keys], L) when is_list(Options0) -> {ok, U}; {pre_fun, U=undefined} -> {ok, U}; - {info_fun, Fun} when is_function(Fun), is_function(Fun, 1) -> + {info_fun, Fun} when is_function(Fun, 1) -> {ok, Fun}; - {pre_fun, Fun} when is_function(Fun), is_function(Fun, 1) -> + {pre_fun, Fun} when is_function(Fun, 1) -> {ok, Fun}; - {post_fun, Fun} when is_function(Fun), is_function(Fun, 0) -> + {post_fun, Fun} when is_function(Fun, 0) -> {ok, Fun}; - {lookup_fun, Fun} when is_function(Fun), is_function(Fun, 2) -> + {lookup_fun, Fun} when is_function(Fun, 2) -> {ok, Fun}; {max_lookup, Max} when is_integer(Max), Max >= 0 -> {ok, Max}; {max_lookup, infinity} -> {ok, -1}; - {format_fun, Fun} when is_function(Fun), is_function(Fun, 1) -> + {format_fun, Fun} when is_function(Fun, 1) -> {ok, Fun}; - {parent_fun, Fun} when is_function(Fun), is_function(Fun, 0) -> + {parent_fun, Fun} when is_function(Fun, 0) -> {ok, Fun}; {key_equality, KE='=='} -> {ok, KE}; @@ -885,7 +888,7 @@ options(Options0, [Key | Keys], L) when is_list(Options0) -> {depth, Depth} when Depth =:= infinity; is_integer(Depth), Depth >= 0 -> {ok, Depth}; - {order, Order} when is_function(Order), is_function(Order, 2); + {order, Order} when is_function(Order, 2); (Order =:= ascending); (Order =:= descending) -> {ok, Order}; diff --git a/lib/stdlib/src/qlc_pt.erl b/lib/stdlib/src/qlc_pt.erl index 4e81e2c2dd..0db63b81f4 100644 --- a/lib/stdlib/src/qlc_pt.erl +++ b/lib/stdlib/src/qlc_pt.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2015. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -67,8 +67,8 @@ %%% -spec(parse_transform(Forms, Options) -> Forms2 when - Forms :: [erl_parse:abstract_form()], - Forms2 :: [erl_parse:abstract_form()], + Forms :: [erl_parse:abstract_form() | erl_parse:form_info()], + Forms2 :: [erl_parse:abstract_form() | erl_parse:form_info()], Options :: [Option], Option :: type_checker | compile:option()). @@ -117,19 +117,21 @@ parse_transform(Forms0, Options) -> true = ets:delete(NodeInfo) end. --spec(transform_from_evaluator(LC, Bs) -> Expr when +-spec(transform_from_evaluator(LC, Bs) -> Return when LC :: erl_parse:abstract_expr(), - Expr :: erl_parse:abstract_expr(), - Bs :: erl_eval:binding_struct()). + Bs :: erl_eval:binding_struct(), + Return :: {ok, erl_parse:abstract_expr()} + | {not_ok, {error, module(), Reason :: term()}}). transform_from_evaluator(LC, Bindings) -> ?DEBUG("qlc Parse Transform (Evaluator Version)~n", []), transform_expression(LC, Bindings, false). --spec(transform_expression(LC, Bs) -> Expr when +-spec(transform_expression(LC, Bs) -> Return when LC :: erl_parse:abstract_expr(), - Expr :: erl_parse:abstract_expr(), - Bs :: erl_eval:binding_struct()). + Bs :: erl_eval:binding_struct(), + Return :: {ok, erl_parse:abstract_expr()} + | {not_ok, [{error, Reason :: term()}]}). transform_expression(LC, Bindings) -> transform_expression(LC, Bindings, true). @@ -200,7 +202,7 @@ exclude_integers_from_unique_line_numbers(Forms, NodeInfo) -> find_integers(Forms) -> F = fun(A) -> - Fs1 = erl_parse:map_anno(fun(_) -> A end, Forms), + Fs1 = map_anno(fun(_) -> A end, Forms), ordsets:from_list(integers(Fs1, [])) end, ordsets:to_list(ordsets:intersection(F(anno0()), F(anno1()))). @@ -319,13 +321,13 @@ badarg(Forms, State) -> E0. lc_nodes(E, NodeInfo) -> - erl_parse:map_anno(fun(Anno) -> - N = erl_anno:line(Anno), - [{N, Data}] = ets:lookup(NodeInfo, N), - NData = Data#{inside_lc => true}, - true = ets:insert(NodeInfo, {N, NData}), - Anno - end, E). + map_anno(fun(Anno) -> + N = erl_anno:line(Anno), + [{N, Data}] = ets:lookup(NodeInfo, N), + NData = Data#{inside_lc => true}, + true = ets:insert(NodeInfo, {N, NData}), + Anno + end, E). used_genvar_messages(MsL, S) -> [{File,[{Loc,?APIMOD,{used_generator_variable,V}}]} @@ -416,7 +418,7 @@ intro_anno(LC, Where, QId, NodeInfo) -> true = ets:insert(NodeInfo, {Location,Data}), Anno end, - erl_parse:map_anno(Fun, save_anno(LC, NodeInfo)). + map_anno(Fun, save_anno(LC, NodeInfo)). compile_errors(FormsNoShadows) -> case compile_forms(FormsNoShadows, []) of @@ -428,7 +430,13 @@ compile_errors(FormsNoShadows) -> end. compile_forms(Forms0, Options) -> - Forms = [F || F <- Forms0, element(1, F) =/= eof] ++ [{eof,anno0()}], + Exclude = fun(eof) -> true; + (warning) -> true; + (error) -> true; + (_) -> false + end, + Forms = ([F || F <- Forms0, not Exclude(element(1, F))] + ++ [{eof,anno0()}]), try case compile:noenv_forms(Forms, compile_options(Options)) of {ok, _ModName, Ws0} -> @@ -1644,7 +1652,7 @@ reset_anno(T) -> set_anno(T, anno0()). set_anno(T, A) -> - erl_parse:map_anno(fun(_L) -> A end, T). + map_anno(fun(_L) -> A end, T). -record(fstate, {state, bind_fun, imported}). @@ -1908,9 +1916,9 @@ expand_pattern_records(P, State) -> expand_expr_records(E, State) -> RecordDefs = State#state.records, A = anno1(), - Forms = RecordDefs ++ [{function,A,foo,0,[{clause,A,[],[],[pe(E)]}]}], - [{function,_,foo,0,[{clause,_,[],[],[NE]}]}] = - erl_expand_records:module(Forms, [no_strict_record_tests]), + Forms0 = RecordDefs ++ [{function,A,foo,0,[{clause,A,[],[],[pe(E)]}]}], + Forms = erl_expand_records:module(Forms0, [no_strict_record_tests]), + {function,_,foo,0,[{clause,_,[],[],[NE]}]} = lists:last(Forms), NE. %% Partial evaluation. @@ -2603,7 +2611,7 @@ save_anno(Abstr, NodeInfo) -> true = ets:insert(NodeInfo, Data), erl_anno:new(N) end, - erl_parse:map_anno(F, Abstr). + map_anno(F, Abstr). next_slot(T) -> I = ets:update_counter(T, var_n, 1), @@ -2627,7 +2635,7 @@ restore_anno(Abstr, NodeInfo) -> Anno end end, - erl_parse:map_anno(F, Abstr). + map_anno(F, Abstr). restore_loc(Location, #state{node_info = NodeInfo}) -> case ets:lookup(NodeInfo, Location) of @@ -2866,6 +2874,14 @@ var_mapfold(F, A0, [E0 | Es0]) -> var_mapfold(_F, A, E) -> {E, A}. +map_anno(F, AbstrList) when is_list(AbstrList) -> + [map_anno1(F, Abstr) || Abstr <- AbstrList]; +map_anno(F, Abstr) -> + map_anno1(F, Abstr). + +map_anno1(F, Abstr) -> + erl_parse:map_anno(F, Abstr). + family_list(L) -> sofs:to_external(family(L)). diff --git a/lib/stdlib/src/queue.erl b/lib/stdlib/src/queue.erl index 2e65759d2a..11c0aa8d2b 100644 --- a/lib/stdlib/src/queue.erl +++ b/lib/stdlib/src/queue.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -31,10 +31,14 @@ %% Okasaki API from klacke -export([cons/2,head/1,tail/1, - snoc/2,last/1,daeh/1,init/1,liat/1,lait/1]). + snoc/2,last/1,daeh/1,init/1,liat/1]). -export_type([queue/0, queue/1]). +%% Mis-spelled, deprecated. +-export([lait/1]). +-deprecated([lait/1]). + %%-------------------------------------------------------------------------- %% Efficient implementation of double ended fifo queues %% diff --git a/lib/stdlib/src/rand.erl b/lib/stdlib/src/rand.erl index 8e8d0bc801..93409d95df 100644 --- a/lib/stdlib/src/rand.erl +++ b/lib/stdlib/src/rand.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2015. All Rights Reserved. +%% Copyright Ericsson AB 2015-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -44,11 +44,11 @@ %% This depends on the algorithm handler function -type alg_seed() :: exs64_state() | exsplus_state() | exs1024_state(). %% This is the algorithm handler function within this module --type alg_handler() :: #{type => alg(), - max => integer(), - next => fun(), - uniform => fun(), - uniform_n => fun()}. +-type alg_handler() :: #{type := alg(), + max := integer(), + next := fun(), + uniform := fun(), + uniform_n := fun()}. %% Internal state -opaque state() :: {alg_handler(), alg_seed()}. @@ -63,7 +63,7 @@ %% Return algorithm and seed so that RNG state can be recreated with seed/1 -spec export_seed() -> undefined | export_state(). export_seed() -> - case seed_get() of + case get(?SEED_DICT) of {#{type:=Alg}, Seed} -> {Alg, Seed}; _ -> undefined end. @@ -256,6 +256,8 @@ exs64_uniform(Max, {Alg, R}) -> %% ===================================================================== -type exsplus_state() :: nonempty_improper_list(uint58(), uint58()). +-dialyzer({no_improper_lists, exsplus_seed/1}). + exsplus_seed({A1, A2, A3}) -> {_, R1} = exsplus_next([(((A1 * 4294967197) + 1) band ?UINT58MASK)| (((A2 * 4294967231) + 1) band ?UINT58MASK)]), @@ -263,6 +265,8 @@ exsplus_seed({A1, A2, A3}) -> tl(R1)]), R2. +-dialyzer({no_improper_lists, exsplus_next/1}). + %% Advance xorshift116+ state for one step and generate 58bit unsigned integer -spec exsplus_next(exsplus_state()) -> {uint58(), exsplus_state()}. exsplus_next([S1|S0]) -> diff --git a/lib/stdlib/src/random.erl b/lib/stdlib/src/random.erl index 8b67cde56c..46dabb4323 100644 --- a/lib/stdlib/src/random.erl +++ b/lib/stdlib/src/random.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -18,6 +18,7 @@ %% %CopyrightEnd% %% -module(random). +-deprecated(module). %% Reasonable random number generator. %% The method is attributed to B. A. Wichmann and I. D. Hill diff --git a/lib/stdlib/src/re.erl b/lib/stdlib/src/re.erl index e5d9fc51d2..52d3c35608 100644 --- a/lib/stdlib/src/re.erl +++ b/lib/stdlib/src/re.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2014. All Rights Reserved. +%% Copyright Ericsson AB 2008-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -132,8 +132,9 @@ split(Subject,RE) -> split(Subject,RE,Options) -> try - {NewOpt,Convert,Unicode,Limit,Strip,Group} = - process_split_params(Options,iodata,false,-1,false,false), + {NewOpt,Convert,Limit,Strip,Group} = + process_split_params(Options,iodata,-1,false,false), + Unicode = check_for_unicode(RE, Options), FlatSubject = to_binary(Subject, Unicode), case compile_split(RE,NewOpt) of {error,_Err} -> @@ -324,8 +325,8 @@ replace(Subject,RE,Replacement) -> replace(Subject,RE,Replacement,Options) -> try - {NewOpt,Convert,Unicode} = - process_repl_params(Options,iodata,false), + {NewOpt,Convert} = process_repl_params(Options,iodata), + Unicode = check_for_unicode(RE, Options), FlatSubject = to_binary(Subject, Unicode), FlatReplacement = to_binary(Replacement, Unicode), IoList = do_replace(FlatSubject,Subject,RE,FlatReplacement,NewOpt), @@ -367,65 +368,59 @@ do_replace(FlatSubject,Subject,RE,Replacement,Options) -> apply_mlist(FlatSubject,Replacement,[Slist]) end. -process_repl_params([],Convert,Unicode) -> - {[],Convert,Unicode}; -process_repl_params([unicode|T],C,_U) -> - {NT,NC,NU} = process_repl_params(T,C,true), - {[unicode|NT],NC,NU}; -process_repl_params([report_errors|_],_,_) -> +process_repl_params([],Convert) -> + {[],Convert}; +process_repl_params([report_errors|_],_) -> throw(badopt); -process_repl_params([{capture,_,_}|_],_,_) -> +process_repl_params([{capture,_,_}|_],_) -> throw(badopt); -process_repl_params([{capture,_}|_],_,_) -> +process_repl_params([{capture,_}|_],_) -> throw(badopt); -process_repl_params([{return,iodata}|T],_C,U) -> - process_repl_params(T,iodata,U); -process_repl_params([{return,list}|T],_C,U) -> - process_repl_params(T,list,U); -process_repl_params([{return,binary}|T],_C,U) -> - process_repl_params(T,binary,U); -process_repl_params([{return,_}|_],_,_) -> +process_repl_params([{return,iodata}|T],_C) -> + process_repl_params(T,iodata); +process_repl_params([{return,list}|T],_C) -> + process_repl_params(T,list); +process_repl_params([{return,binary}|T],_C) -> + process_repl_params(T,binary); +process_repl_params([{return,_}|_],_) -> throw(badopt); -process_repl_params([H|T],C,U) -> - {NT,NC,NU} = process_repl_params(T,C,U), - {[H|NT],NC,NU}. - -process_split_params([],Convert,Unicode,Limit,Strip,Group) -> - {[],Convert,Unicode,Limit,Strip,Group}; -process_split_params([unicode|T],C,_U,L,S,G) -> - {NT,NC,NU,NL,NS,NG} = process_split_params(T,C,true,L,S,G), - {[unicode|NT],NC,NU,NL,NS,NG}; -process_split_params([trim|T],C,U,_L,_S,G) -> - process_split_params(T,C,U,-1,true,G); -process_split_params([{parts,0}|T],C,U,_L,_S,G) -> - process_split_params(T,C,U,-1,true,G); -process_split_params([{parts,N}|T],C,U,_L,_S,G) when is_integer(N), N >= 1 -> - process_split_params(T,C,U,N-1,false,G); -process_split_params([{parts,infinity}|T],C,U,_L,_S,G) -> - process_split_params(T,C,U,-1,false,G); -process_split_params([{parts,_}|_],_,_,_,_,_) -> +process_repl_params([H|T],C) -> + {NT,NC} = process_repl_params(T,C), + {[H|NT],NC}. + +process_split_params([],Convert,Limit,Strip,Group) -> + {[],Convert,Limit,Strip,Group}; +process_split_params([trim|T],C,_L,_S,G) -> + process_split_params(T,C,-1,true,G); +process_split_params([{parts,0}|T],C,_L,_S,G) -> + process_split_params(T,C,-1,true,G); +process_split_params([{parts,N}|T],C,_L,_S,G) when is_integer(N), N >= 1 -> + process_split_params(T,C,N-1,false,G); +process_split_params([{parts,infinity}|T],C,_L,_S,G) -> + process_split_params(T,C,-1,false,G); +process_split_params([{parts,_}|_],_,_,_,_) -> throw(badopt); -process_split_params([group|T],C,U,L,S,_G) -> - process_split_params(T,C,U,L,S,true); -process_split_params([global|_],_,_,_,_,_) -> +process_split_params([group|T],C,L,S,_G) -> + process_split_params(T,C,L,S,true); +process_split_params([global|_],_,_,_,_) -> throw(badopt); -process_split_params([report_errors|_],_,_,_,_,_) -> +process_split_params([report_errors|_],_,_,_,_) -> throw(badopt); -process_split_params([{capture,_,_}|_],_,_,_,_,_) -> +process_split_params([{capture,_,_}|_],_,_,_,_) -> throw(badopt); -process_split_params([{capture,_}|_],_,_,_,_,_) -> +process_split_params([{capture,_}|_],_,_,_,_) -> throw(badopt); -process_split_params([{return,iodata}|T],_C,U,L,S,G) -> - process_split_params(T,iodata,U,L,S,G); -process_split_params([{return,list}|T],_C,U,L,S,G) -> - process_split_params(T,list,U,L,S,G); -process_split_params([{return,binary}|T],_C,U,L,S,G) -> - process_split_params(T,binary,U,L,S,G); -process_split_params([{return,_}|_],_,_,_,_,_) -> +process_split_params([{return,iodata}|T],_C,L,S,G) -> + process_split_params(T,iodata,L,S,G); +process_split_params([{return,list}|T],_C,L,S,G) -> + process_split_params(T,list,L,S,G); +process_split_params([{return,binary}|T],_C,L,S,G) -> + process_split_params(T,binary,L,S,G); +process_split_params([{return,_}|_],_,_,_,_) -> throw(badopt); -process_split_params([H|T],C,U,L,S,G) -> - {NT,NC,NU,NL,NS,NG} = process_split_params(T,C,U,L,S,G), - {[H|NT],NC,NU,NL,NS,NG}. +process_split_params([H|T],C,L,S,G) -> + {NT,NC,NL,NS,NG} = process_split_params(T,C,L,S,G), + {[H|NT],NC,NL,NS,NG}. apply_mlist(Subject,Replacement,Mlist) -> do_mlist(Subject,Subject,0,precomp_repl(Replacement), Mlist). diff --git a/lib/stdlib/src/sets.erl b/lib/stdlib/src/sets.erl index cd435ff49c..3e70450320 100644 --- a/lib/stdlib/src/sets.erl +++ b/lib/stdlib/src/sets.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2014. All Rights Reserved. +%% Copyright Ericsson AB 2000-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/lib/stdlib/src/shell.erl b/lib/stdlib/src/shell.erl index c64123a207..28f37ef8bf 100644 --- a/lib/stdlib/src/shell.erl +++ b/lib/stdlib/src/shell.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2015. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -23,7 +23,7 @@ -export([whereis_evaluator/0, whereis_evaluator/1]). -export([start_restricted/1, stop_restricted/0]). -export([local_allowed/3, non_local_allowed/3]). --export([prompt_func/1, strings/1]). +-export([catch_exception/1, prompt_func/1, strings/1]). -define(LINEMAX, 30). -define(CHAR_MAX, 60). @@ -768,6 +768,8 @@ used_records({call,_,{atom,_,record_info},[A,{atom,_,Name}]}) -> {name, Name, A}; used_records({call,Line,{tuple,_,[M,F]},As}) -> used_records({call,Line,{remote,Line,M,F},As}); +used_records({type,_,record,[{atom,_,Name}|Fs]}) -> + {name, Name, Fs}; used_records(T) when is_tuple(T) -> {expr, tuple_to_list(T)}; used_records(E) -> @@ -917,9 +919,9 @@ expand_records(UsedRecords, E0) -> RecordDefs = [Def || {_Name,Def} <- UsedRecords], L = erl_anno:new(1), E = prep_rec(E0), - Forms = RecordDefs ++ [{function,L,foo,0,[{clause,L,[],[],[E]}]}], - [{function,L,foo,0,[{clause,L,[],[],[NE]}]}] = - erl_expand_records:module(Forms, [strict_record_tests]), + Forms0 = RecordDefs ++ [{function,L,foo,0,[{clause,L,[],[],[E]}]}], + Forms = erl_expand_records:module(Forms0, [strict_record_tests]), + {function,L,foo,0,[{clause,L,[],[],[NE]}]} = lists:last(Forms), prep_rec(NE). prep_rec({value,_CommandN,_V}=Value) -> @@ -999,12 +1001,7 @@ local_func(rl, [A], Bs0, _Shell, RT, Lf, Ef) -> {value,list_records(record_defs(RT, listify(Recs))),Bs}; local_func(rp, [A], Bs0, _Shell, RT, Lf, Ef) -> {[V],Bs} = expr_list([A], Bs0, Lf, Ef), - Cs = io_lib_pretty:print(V, ([{column, 1}, - {line_length, columns()}, - {depth, -1}, - {max_chars, ?CHAR_MAX}, - {record_print_fun, record_print_fun(RT)}] - ++ enc())), + Cs = pp(V, _Column=1, _Depth=-1, RT), io:requests([{put_chars, unicode, Cs}, nl]), {value,ok,Bs}; local_func(rr, [A], Bs0, _Shell, RT, Lf, Ef) -> @@ -1086,6 +1083,8 @@ record_fields([{record_field,_,{atom,_,Field}} | Fs]) -> [Field | record_fields(Fs)]; record_fields([{record_field,_,{atom,_,Field},_} | Fs]) -> [Field | record_fields(Fs)]; +record_fields([{typed_record_field,Field,_Type} | Fs]) -> + record_fields([Field | Fs]); record_fields([]) -> []. @@ -1397,9 +1396,9 @@ get_history_and_results() -> {History, erlang:min(Results, History)}. pp(V, I, RT) -> - pp(V, I, RT, enc()). + pp(V, I, _Depth=?LINEMAX, RT). -pp(V, I, RT, Enc) -> +pp(V, I, D, RT) -> Strings = case application:get_env(stdlib, shell_strings) of {ok, false} -> @@ -1408,10 +1407,10 @@ pp(V, I, RT, Enc) -> true end, io_lib_pretty:print(V, ([{column, I}, {line_length, columns()}, - {depth, ?LINEMAX}, {max_chars, ?CHAR_MAX}, + {depth, D}, {max_chars, ?CHAR_MAX}, {strings, Strings}, {record_print_fun, record_print_fun(RT)}] - ++ Enc)). + ++ enc())). columns() -> case io:columns() of diff --git a/lib/stdlib/src/shell_default.erl b/lib/stdlib/src/shell_default.erl index 4ef5e14db1..6947cf181b 100644 --- a/lib/stdlib/src/shell_default.erl +++ b/lib/stdlib/src/shell_default.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/lib/stdlib/src/slave.erl b/lib/stdlib/src/slave.erl index 24fc8ce204..5b5c328c0c 100644 --- a/lib/stdlib/src/slave.erl +++ b/lib/stdlib/src/slave.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -289,10 +289,7 @@ register_unique_name(Number) -> %% no need to use rsh. mk_cmd(Host, Name, Args, Waiter, Prog0) -> - Prog = case os:type() of - {ose,_} -> mk_ose_prog(Prog0); - _ -> quote_progname(Prog0) - end, + Prog = quote_progname(Prog0), BasicCmd = lists:concat([Prog, " -detached -noinput -master ", node(), " ", long_or_short(), Name, "@", Host, @@ -312,24 +309,6 @@ mk_cmd(Host, Name, Args, Waiter, Prog0) -> end end. -%% On OSE we have to pass the beam arguments directory to the slave -%% process. To find out what arguments that should be passed on we -%% make an assumption. All arguments after the last "--" should be -%% skipped. So given these arguments: -%% -Muycs256 -A 1 -- -root /mst/ -progname beam.debug.smp -- -home /mst/ -- -kernel inetrc '"/mst/inetrc.conf"' -- -name test@localhost -%% we send -%% -Muycs256 -A 1 -- -root /mst/ -progname beam.debug.smp -- -home /mst/ -- -kernel inetrc '"/mst/inetrc.conf"' -- -%% to the slave with whatever other args that are added in mk_cmd. -mk_ose_prog(Prog) -> - SkipTail = fun("--",[]) -> - ["--"]; - (_,[]) -> - []; - (Arg,Args) -> - [Arg," "|Args] - end, - [Prog,tl(lists:foldr(SkipTail,[],erlang:system_info(emu_args)))]. - %% This is an attempt to distinguish between spaces in the program %% path and spaces that separate arguments. The program is quoted to %% allow spaces in the path. diff --git a/lib/stdlib/src/sofs.erl b/lib/stdlib/src/sofs.erl index bcd1fc11e2..c244e06ca4 100644 --- a/lib/stdlib/src/sofs.erl +++ b/lib/stdlib/src/sofs.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2014. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -621,6 +621,9 @@ canonical_relation(Sets) when ?IS_SET(Sets) -> %%% Functions on binary relations only. %%% +-spec(rel2fam(BinRel) -> Family when + Family :: family(), + BinRel :: binary_relation()). rel2fam(R) -> relation_to_family(R). diff --git a/lib/stdlib/src/stdlib.app.src b/lib/stdlib/src/stdlib.app.src index 4400956943..09176d2ca0 100644 --- a/lib/stdlib/src/stdlib.app.src +++ b/lib/stdlib/src/stdlib.app.src @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2015. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -65,6 +65,7 @@ gen_event, gen_fsm, gen_server, + gen_statem, io, io_lib, io_lib_format, @@ -105,7 +106,7 @@ dets]}, {applications, [kernel]}, {env, []}, - {runtime_dependencies, ["sasl-2.4","kernel-4.0","erts-7.0","crypto-3.3", + {runtime_dependencies, ["sasl-3.0","kernel-5.0","erts-8.0","crypto-3.3", "compiler-5.0"]} ]}. diff --git a/lib/stdlib/src/stdlib.appup.src b/lib/stdlib/src/stdlib.appup.src index 828e1d9aa4..e917b7ea1f 100644 --- a/lib/stdlib/src/stdlib.appup.src +++ b/lib/stdlib/src/stdlib.appup.src @@ -1,7 +1,7 @@ %% -*- erlang -*- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2015. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -18,7 +18,9 @@ %% %CopyrightEnd% {"%VSN%", %% Up from - max one major revision back - [{<<"2\\.[0-4](\\.[0-9]+)*">>,[restart_new_emulator]}], %% 17.0-17.5 + [{<<"3\\.[0-1](\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-19.* + {<<"2\\.[5-8](\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-18.* %% Down to - max one major revision back - [{<<"2\\.[0-4](\\.[0-9]+)*">>,[restart_new_emulator]}] %% 17.0-17.5 + [{<<"3\\.[0-1](\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-19.* + {<<"2\\.[5-8](\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-18.* }. diff --git a/lib/stdlib/src/string.erl b/lib/stdlib/src/string.erl index 07659ed812..c659db78bd 100644 --- a/lib/stdlib/src/string.erl +++ b/lib/stdlib/src/string.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/lib/stdlib/src/supervisor.erl b/lib/stdlib/src/supervisor.erl index 3c77501c0f..1cd65fbf18 100644 --- a/lib/stdlib/src/supervisor.erl +++ b/lib/stdlib/src/supervisor.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -30,9 +30,12 @@ %% Internal exports -export([init/1, handle_call/3, handle_cast/2, handle_info/2, - terminate/2, code_change/3]). + terminate/2, code_change/3, format_status/2]). -export([try_again_restart/2]). +%% For release_handler only +-export([get_callback_module/1]). + %%-------------------------------------------------------------------------- -export_type([sup_flags/0, child_spec/0, startchild_ret/0, strategy/0]). @@ -54,8 +57,8 @@ | {'global', Name :: atom()} | {'via', Module :: module(), Name :: any()} | pid(). --type child_spec() :: #{id => child_id(), % mandatory - start => mfargs(), % mandatory +-type child_spec() :: #{id := child_id(), % mandatory + start := mfargs(), % mandatory restart => restart(), % optional shutdown => shutdown(), % optional type => worker(), % optional @@ -107,12 +110,15 @@ -define(SET, sets:set). -record(state, {name, - strategy :: strategy(), + strategy :: strategy() | 'undefined', children = [] :: [child_rec()], - dynamics :: ?DICT(pid(), list()) | ?SET(pid()), - intensity :: non_neg_integer(), - period :: pos_integer(), + dynamics :: {'dict', ?DICT(pid(), list())} + | {'set', ?SET(pid())} + | 'undefined', + intensity :: non_neg_integer() | 'undefined', + period :: pos_integer() | 'undefined', restarts = [], + dynamic_restarts = 0 :: non_neg_integer(), module, args}). -type state() :: #state{}. @@ -240,7 +246,7 @@ check_childspecs(ChildSpecs) when is_list(ChildSpecs) -> check_childspecs(X) -> {error, {badarg, X}}. %%%----------------------------------------------------------------- -%%% Called by timer:apply_after from restart/2 +%%% Called by restart/2 -spec try_again_restart(SupRef, Child) -> ok when SupRef :: sup_ref(), Child :: child_id() | pid(). @@ -250,6 +256,22 @@ try_again_restart(Supervisor, Child) -> cast(Supervisor, Req) -> gen_server:cast(Supervisor, Req). +%%%----------------------------------------------------------------- +%%% Called by release_handler during upgrade +-spec get_callback_module(Pid) -> Module when + Pid :: pid(), + Module :: atom(). +get_callback_module(Pid) -> + {status, _Pid, {module, _Mod}, + [_PDict, _SysState, _Parent, _Dbg, Misc]} = sys:get_status(Pid), + case lists:keyfind(supervisor, 1, Misc) of + {supervisor, [{"Callback", Mod}]} -> + Mod; + _ -> + [_Header, _Data, {data, [{"State", State}]} | _] = Misc, + State#state.module + end. + %%% --------------------------------------------------- %%% %%% Initialize the supervisor. @@ -504,39 +526,26 @@ handle_call(which_children, _From, State) -> handle_call(count_children, _From, #state{children = [#child{restart_type = temporary, child_type = CT}]} = State) when ?is_simple(State) -> - {Active, Count} = - ?SETS:fold(fun(Pid, {Alive, Tot}) -> - case is_pid(Pid) andalso is_process_alive(Pid) of - true ->{Alive+1, Tot +1}; - false -> - {Alive, Tot + 1} - end - end, {0, 0}, dynamics_db(temporary, State#state.dynamics)), + Sz = ?SETS:size(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}] + supervisor -> [{specs, 1}, {active, Sz}, + {supervisors, Sz}, {workers, 0}]; + worker -> [{specs, 1}, {active, Sz}, + {supervisors, 0}, {workers, Sz}] end, {reply, Reply, State}; -handle_call(count_children, _From, #state{children = [#child{restart_type = RType, +handle_call(count_children, _From, #state{dynamic_restarts = Restarts, + children = [#child{restart_type = RType, child_type = CT}]} = State) when ?is_simple(State) -> - {Active, Count} = - ?DICTS:fold(fun(Pid, _Val, {Alive, Tot}) -> - case is_pid(Pid) andalso is_process_alive(Pid) of - true -> - {Alive+1, Tot +1}; - false -> - {Alive, Tot + 1} - end - end, {0, 0}, dynamics_db(RType, State#state.dynamics)), + Sz = ?DICTS:size(dynamics_db(RType, State#state.dynamics)), + Active = Sz - Restarts, Reply = case CT of supervisor -> [{specs, 1}, {active, Active}, - {supervisors, Count}, {workers, 0}]; + {supervisors, Sz}, {workers, 0}]; worker -> [{specs, 1}, {active, Active}, - {supervisors, 0}, {workers, Count}] + {supervisors, 0}, {workers, Sz}] end, {reply, Reply, State}; @@ -567,8 +576,8 @@ count_child(#child{pid = Pid, child_type = supervisor}, end. -%%% If a restart attempt failed, this message is sent via -%%% timer:apply_after(0,...) in order to give gen_server the chance to +%%% If a restart attempt failed, this message is cast +%%% from restart/2 in order to give gen_server the chance to %%% check it's inbox before trying again. -spec handle_cast({try_again_restart, child_id() | pid()}, state()) -> {'noreply', state()} | {stop, shutdown, state()}. @@ -577,7 +586,7 @@ handle_cast({try_again_restart,Pid}, #state{children=[Child]}=State) when ?is_simple(State) -> RT = Child#child.restart_type, RPid = restarting(Pid), - case dynamic_child_args(RPid, dynamics_db(RT, State#state.dynamics)) of + case dynamic_child_args(RPid, RT, State#state.dynamics) of {ok, Args} -> {M, F, _} = Child#child.mfargs, NChild = Child#child{pid = RPid, mfargs = {M, F, Args}}, @@ -735,7 +744,7 @@ handle_start_child(Child, State) -> 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 + case dynamic_child_args(Pid, RestartType, State#state.dynamics) of {ok, Args} -> {M, F, _} = Child#child.mfargs, NChild = Child#child{pid = Pid, mfargs = {M, F, Args}}, @@ -786,16 +795,10 @@ restart(Child, State) -> Id = if ?is_simple(State) -> Child#child.pid; true -> Child#child.name end, - {ok, _TRef} = timer:apply_after(0, - ?MODULE, - try_again_restart, - [self(),Id]), + ok = try_again_restart(self(), Id), {ok,NState2}; {try_again, NState2, #child{name=ChName}} -> - {ok, _TRef} = timer:apply_after(0, - ?MODULE, - try_again_restart, - [self(),ChName]), + ok = try_again_restart(self(), ChName), {ok,NState2}; Other -> Other @@ -806,20 +809,31 @@ restart(Child, State) -> {shutdown, remove_child(Child, NState)} end. -restart(simple_one_for_one, Child, State) -> +restart(simple_one_for_one, Child, State0) -> #child{pid = OldPid, mfargs = {M, F, A}} = Child, + State = case OldPid of + ?restarting(_) -> + NRes = State0#state.dynamic_restarts - 1, + State0#state{dynamic_restarts = NRes}; + _ -> + State0 + end, Dynamics = ?DICTS:erase(OldPid, dynamics_db(Child#child.restart_type, State#state.dynamics)), case do_start_child_i(M, F, A) of {ok, Pid} -> - NState = State#state{dynamics = ?DICTS:store(Pid, A, Dynamics)}, + DynamicsDb = {dict, ?DICTS:store(Pid, A, Dynamics)}, + NState = State#state{dynamics = DynamicsDb}, {ok, NState}; {ok, Pid, _Extra} -> - NState = State#state{dynamics = ?DICTS:store(Pid, A, Dynamics)}, + DynamicsDb = {dict, ?DICTS:store(Pid, A, Dynamics)}, + NState = State#state{dynamics = DynamicsDb}, {ok, NState}; {error, Error} -> - NState = State#state{dynamics = ?DICTS:store(restarting(OldPid), A, - Dynamics)}, + NRestarts = State#state.dynamic_restarts + 1, + DynamicsDb = {dict, ?DICTS:store(restarting(OldPid), A, Dynamics)}, + NState = State#state{dynamic_restarts = NRestarts, + dynamics = DynamicsDb}, report_error(start_error, Error, Child, State#state.name), {try_again, NState} end; @@ -1073,6 +1087,10 @@ wait_dynamic_children(#child{restart_type=RType} = Child, Pids, Sz, wait_dynamic_children(Child, ?SETS:del_element(Pid, Pids), Sz-1, TRef, EStack); + {'DOWN', _MRef, process, Pid, {shutdown, _}} -> + wait_dynamic_children(Child, ?SETS:del_element(Pid, Pids), Sz-1, + TRef, EStack); + {'DOWN', _MRef, process, Pid, normal} when RType =/= permanent -> wait_dynamic_children(Child, ?SETS:del_element(Pid, Pids), Sz-1, TRef, EStack); @@ -1083,7 +1101,7 @@ wait_dynamic_children(#child{restart_type=RType} = Child, Pids, Sz, {timeout, TRef, kill} -> ?SETS:fold(fun(P, _) -> exit(P, kill) end, ok, Pids), - wait_dynamic_children(Child, Pids, Sz-1, undefined, EStack) + wait_dynamic_children(Child, Pids, Sz, undefined, EStack) end. %%----------------------------------------------------------------- @@ -1102,31 +1120,32 @@ save_child(Child, #state{children = Children} = State) -> State#state{children = [Child |Children]}. save_dynamic_child(temporary, Pid, _, #state{dynamics = Dynamics} = State) -> - State#state{dynamics = ?SETS:add_element(Pid, dynamics_db(temporary, Dynamics))}; + DynamicsDb = dynamics_db(temporary, Dynamics), + State#state{dynamics = {set, ?SETS:add_element(Pid, DynamicsDb)}}; save_dynamic_child(RestartType, Pid, Args, #state{dynamics = Dynamics} = State) -> - State#state{dynamics = ?DICTS:store(Pid, Args, dynamics_db(RestartType, Dynamics))}. + DynamicsDb = dynamics_db(RestartType, Dynamics), + State#state{dynamics = {dict, ?DICTS:store(Pid, Args, DynamicsDb)}}. dynamics_db(temporary, undefined) -> ?SETS:new(); dynamics_db(_, undefined) -> ?DICTS:new(); -dynamics_db(_,Dynamics) -> - Dynamics. - -dynamic_child_args(Pid, Dynamics) -> - case ?SETS:is_set(Dynamics) of - true -> - {ok, undefined}; - false -> - ?DICTS:find(Pid, Dynamics) - end. +dynamics_db(_, {_Tag, DynamicsDb}) -> + DynamicsDb. + +dynamic_child_args(_Pid, temporary, _DynamicsDb) -> + {ok, undefined}; +dynamic_child_args(Pid, _RT, {dict, DynamicsDb}) -> + ?DICTS:find(Pid, DynamicsDb); +dynamic_child_args(_Pid, _RT, undefined) -> + error. state_del_child(#child{pid = Pid, restart_type = temporary}, State) when ?is_simple(State) -> NDynamics = ?SETS:del_element(Pid, dynamics_db(temporary, State#state.dynamics)), - State#state{dynamics = NDynamics}; + State#state{dynamics = {set, NDynamics}}; state_del_child(#child{pid = Pid, restart_type = RType}, State) when ?is_simple(State) -> NDynamics = ?DICTS:erase(Pid, dynamics_db(RType, State#state.dynamics)), - State#state{dynamics = NDynamics}; + State#state{dynamics = {dict, NDynamics}}; state_del_child(Child, State) -> NChildren = del_child(Child#child.name, State#state.children), State#state{children = NChildren}. @@ -1160,19 +1179,19 @@ split_child(_, [], After) -> get_child(Name, State) -> get_child(Name, State, false). + get_child(Pid, State, AllowPid) when AllowPid, is_pid(Pid) -> get_dynamic_child(Pid, State); get_child(Name, State, _) -> lists:keysearch(Name, #child.name, State#state.children). get_dynamic_child(Pid, #state{children=[Child], dynamics=Dynamics}) -> - DynamicsDb = dynamics_db(Child#child.restart_type, Dynamics), - case is_dynamic_pid(Pid, DynamicsDb) of + case is_dynamic_pid(Pid, Dynamics) of true -> {value, Child#child{pid=Pid}}; false -> RPid = restarting(Pid), - case is_dynamic_pid(RPid, DynamicsDb) of + case is_dynamic_pid(RPid, Dynamics) of true -> {value, Child#child{pid=RPid}}; false -> @@ -1183,13 +1202,12 @@ get_dynamic_child(Pid, #state{children=[Child], dynamics=Dynamics}) -> end end. -is_dynamic_pid(Pid, Dynamics) -> - case ?SETS:is_set(Dynamics) of - true -> - ?SETS:is_element(Pid, Dynamics); - false -> - ?DICTS:is_key(Pid, Dynamics) - end. +is_dynamic_pid(Pid, {dict, Dynamics}) -> + ?DICTS:is_key(Pid, Dynamics); +is_dynamic_pid(Pid, {set, Dynamics}) -> + ?SETS:is_element(Pid, Dynamics); +is_dynamic_pid(_Pid, undefined) -> + false. replace_child(Child, State) -> Chs = do_replace_child(Child, State#state.children), @@ -1441,3 +1459,9 @@ report_progress(Child, SupName) -> Progress = [{supervisor, SupName}, {started, extract_child(Child)}], error_logger:info_report(progress, Progress). + +format_status(terminate, [_PDict, State]) -> + State; +format_status(_, [_PDict, State]) -> + [{data, [{"State", State}]}, + {supervisor, [{"Callback", State#state.module}]}]. diff --git a/lib/stdlib/src/supervisor_bridge.erl b/lib/stdlib/src/supervisor_bridge.erl index 18218b71ad..af1e046d30 100644 --- a/lib/stdlib/src/supervisor_bridge.erl +++ b/lib/stdlib/src/supervisor_bridge.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/lib/stdlib/src/sys.erl b/lib/stdlib/src/sys.erl index a7debb00f5..a6ecf03716 100644 --- a/lib/stdlib/src/sys.erl +++ b/lib/stdlib/src/sys.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/lib/stdlib/src/timer.erl b/lib/stdlib/src/timer.erl index f7530447bb..ca868627a9 100644 --- a/lib/stdlib/src/timer.erl +++ b/lib/stdlib/src/timer.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/lib/stdlib/src/unicode.erl b/lib/stdlib/src/unicode.erl index 3e8e6f5101..617da11ba8 100644 --- a/lib/stdlib/src/unicode.erl +++ b/lib/stdlib/src/unicode.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2013. All Rights Reserved. +%% Copyright Ericsson AB 2008-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -561,6 +561,8 @@ do_o_binary(F,L) -> erlang:iolist_to_binary(List) end. +-dialyzer({no_improper_lists, do_o_binary2/2}). + do_o_binary2(_F,[]) -> <<>>; do_o_binary2(F,[H|T]) -> diff --git a/lib/stdlib/src/win32reg.erl b/lib/stdlib/src/win32reg.erl index 8074b2efda..8e82a79cbf 100644 --- a/lib/stdlib/src/win32reg.erl +++ b/lib/stdlib/src/win32reg.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2012. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/lib/stdlib/src/zip.erl b/lib/stdlib/src/zip.erl index d6031dabbc..340cc21390 100644 --- a/lib/stdlib/src/zip.erl +++ b/lib/stdlib/src/zip.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2013. All Rights Reserved. +%% Copyright Ericsson AB 2006-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -279,7 +279,8 @@ do_openzip_get(F, #openzip{files = Files, in = In0, input = Input, case file_name_search(F, Files) of {#zip_file{offset = Offset},_}=ZFile -> In1 = Input({seek, bof, Offset}, In0), - case get_z_file(In1, Z, Input, Output, [], fun silent/1, CWD, ZFile) of + case get_z_file(In1, Z, Input, Output, [], fun silent/1, + CWD, ZFile, fun all/1) of {file, R, _In2} -> {ok, R}; _ -> throw(file_not_found) end; @@ -1403,9 +1404,10 @@ get_z_files([{#zip_file{offset = Offset},_} = ZFile | Rest], Z, In0, true -> In1 = Input({seek, bof, Offset}, In0), {In2, Acc1} = - case get_z_file(In1, Z, Input, Output, OpO, FB, CWD, ZFile) of + case get_z_file(In1, Z, Input, Output, OpO, FB, + CWD, ZFile, Filter) of {file, GZD, Inx} -> {Inx, [GZD | Acc0]}; - {dir, Inx} -> {Inx, Acc0} + {_, Inx} -> {Inx, Acc0} end, get_z_files(Rest, Z, In2, Opts, Acc1); _ -> @@ -1413,7 +1415,8 @@ get_z_files([{#zip_file{offset = Offset},_} = ZFile | Rest], Z, In0, end. %% get a file from the archive, reading chunks -get_z_file(In0, Z, Input, Output, OpO, FB, CWD, {ZipFile,Extra}) -> +get_z_file(In0, Z, Input, Output, OpO, FB, + CWD, {ZipFile,Extra}, Filter) -> case Input({read, ?LOCAL_FILE_HEADER_SZ}, In0) of {eof, In1} -> {eof, In1}; @@ -1433,29 +1436,64 @@ get_z_file(In0, Z, Input, Output, OpO, FB, CWD, {ZipFile,Extra}) -> end, {BFileN, In3} = Input({read, FileNameLen + ExtraLen}, In1), {FileName, _} = get_file_name_extra(FileNameLen, ExtraLen, BFileN), - FileName1 = add_cwd(CWD, FileName), - case lists:last(FileName) of - $/ -> - %% perhaps this should always be done? - Output({ensure_dir,FileName1},[]), - {dir, In3}; - _ -> - %% FileInfo = local_file_header_to_file_info(LH) - %%{Out, In4, CRC, UncompSize} = - {Out, In4, CRC, _UncompSize} = - get_z_data(CompMethod, In3, FileName1, - CompSize, Input, Output, OpO, Z), - In5 = skip_z_data_descriptor(GPFlag, Input, In4), - %% TODO This should be fixed some day: - %% In5 = Input({set_file_info, FileName, FileInfo#file_info{size=UncompSize}}, In4), - FB(FileName), - CRC =:= CRC32 orelse throw({bad_crc, FileName}), - {file, Out, In5} + ReadAndWrite = + case check_valid_location(CWD, FileName) of + {true,FileName1} -> + true; + {false,FileName1} -> + Filter({ZipFile#zip_file{name = FileName1},Extra}) + end, + case ReadAndWrite of + true -> + case lists:last(FileName) of + $/ -> + %% perhaps this should always be done? + Output({ensure_dir,FileName1},[]), + {dir, In3}; + _ -> + %% FileInfo = local_file_header_to_file_info(LH) + %%{Out, In4, CRC, UncompSize} = + {Out, In4, CRC, _UncompSize} = + get_z_data(CompMethod, In3, FileName1, + CompSize, Input, Output, OpO, Z), + In5 = skip_z_data_descriptor(GPFlag, Input, In4), + %% TODO This should be fixed some day: + %% In5 = Input({set_file_info, FileName, + %% FileInfo#file_info{size=UncompSize}}, In4), + FB(FileName), + CRC =:= CRC32 orelse throw({bad_crc, FileName}), + {file, Out, In5} + end; + false -> + {ignore, In3} end; _ -> throw(bad_local_file_header) end. +%% make sure FileName doesn't have relative path that points over CWD +check_valid_location(CWD, FileName) -> + %% check for directory traversal exploit + case check_dir_level(filename:split(FileName), 0) of + {FileOrDir,Level} when Level < 0 -> + CWD1 = if CWD == "" -> "./"; + true -> CWD + end, + error_logger:format("Illegal path: ~ts, extracting in ~ts~n", + [add_cwd(CWD,FileName),CWD1]), + {false,add_cwd(CWD, FileOrDir)}; + _ -> + {true,add_cwd(CWD, FileName)} + end. + +check_dir_level([FileOrDir], Level) -> + {FileOrDir,Level}; +check_dir_level(["." | Parts], Level) -> + check_dir_level(Parts, Level); +check_dir_level([".." | Parts], Level) -> + check_dir_level(Parts, Level-1); +check_dir_level([_Dir | Parts], Level) -> + check_dir_level(Parts, Level+1). get_file_name_extra(FileNameLen, ExtraLen, B) -> case B of @@ -1550,57 +1588,35 @@ unix_extra_field_and_var_from_bin(_) -> %% A pwrite-like function for iolists (used by memory-option) -split_iolist(B, Pos) when is_binary(B) -> - split_binary(B, Pos); -split_iolist(L, Pos) when is_list(L) -> - splitter([], L, Pos). +pwrite_binary(B, Pos, Bin) when byte_size(B) =:= Pos -> + append_bins(Bin, B); +pwrite_binary(B, Pos, Bin) -> + erlang:iolist_to_binary(pwrite_iolist(B, Pos, Bin)). -splitter(Left, Right, 0) -> - {Left, Right}; -splitter(Left, [A | Right], RelPos) when is_list(A) or is_binary(A) -> - Sz = erlang:iolist_size(A), - case Sz > RelPos of - true -> - {Leftx, Rightx} = split_iolist(A, RelPos), - {[Left | Leftx], [Rightx, Right]}; - _ -> - splitter([Left | A], Right, RelPos - Sz) - end; -splitter(Left, [A | Right], RelPos) when is_integer(A) -> - splitter([Left, A], Right, RelPos - 1); -splitter(Left, Right, RelPos) when is_binary(Right) -> - splitter(Left, [Right], RelPos). +append_bins([Bin|Bins], B) when is_binary(Bin) -> + append_bins(Bins, <<B/binary, Bin/binary>>); +append_bins([List|Bins], B) when is_list(List) -> + append_bins(Bins, append_bins(List, B)); +append_bins(Bin, B) when is_binary(Bin) -> + <<B/binary, Bin/binary>>; +append_bins([_|_]=List, B) -> + <<B/binary, (iolist_to_binary(List))/binary>>; +append_bins([], B) -> + B. -skip_iolist(B, Pos) when is_binary(B) -> - case B of - <<_:Pos/binary, Bin/binary>> -> Bin; - _ -> <<>> - end; -skip_iolist(L, Pos) when is_list(L) -> - skipper(L, Pos). - -skipper(Right, 0) -> - Right; -skipper([A | Right], RelPos) when is_list(A) or is_binary(A) -> - Sz = erlang:iolist_size(A), - case Sz > RelPos of - true -> - Rightx = skip_iolist(A, RelPos), - [Rightx, Right]; - _ -> - skip_iolist(Right, RelPos - Sz) - end; -skipper([A | Right], RelPos) when is_integer(A) -> - skip_iolist(Right, RelPos - 1). +-dialyzer({no_improper_lists, pwrite_iolist/3}). -pwrite_iolist(Iolist, Pos, Bin) -> - {Left, Right} = split_iolist(Iolist, Pos), +pwrite_iolist(B, Pos, Bin) -> + {Left, Right} = split_binary(B, Pos), Sz = erlang:iolist_size(Bin), - R = skip_iolist(Right, Sz), + R = skip_bin(Right, Sz), [Left, Bin | R]. -pwrite_binary(B, Pos, Bin) -> - erlang:iolist_to_binary(pwrite_iolist(B, Pos, Bin)). +skip_bin(B, Pos) when is_binary(B) -> + case B of + <<_:Pos/binary, Bin/binary>> -> Bin; + _ -> <<>> + end. %% ZIP header manipulations |