diff options
Diffstat (limited to 'lib/stdlib/src')
31 files changed, 630 insertions, 959 deletions
diff --git a/lib/stdlib/src/Makefile b/lib/stdlib/src/Makefile index 600303d7e1..54186a3ba7 100644 --- a/lib/stdlib/src/Makefile +++ b/lib/stdlib/src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1996-2010. All Rights Reserved. +# Copyright Ericsson AB 1996-2011. All Rights Reserved. # # The contents of this file are subject to the Erlang Public License, # Version 1.1, (the "License"); you may not use this file except in @@ -105,7 +105,6 @@ MODULES= \ qlc_pt \ queue \ random \ - regexp \ sets \ shell \ shell_default \ @@ -168,6 +167,7 @@ docs: # This is a trick so that the preloaded files will get the correct type # specifications. primary_bootstrap_compiler: \ + $(BOOTSTRAP_COMPILER)/ebin/epp.beam \ $(BOOTSTRAP_COMPILER)/ebin/erl_scan.beam \ $(BOOTSTRAP_COMPILER)/ebin/erl_parse.beam \ $(BOOTSTRAP_COMPILER)/ebin/erl_lint.beam \ @@ -199,13 +199,13 @@ $(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk include $(ERL_TOP)/make/otp_release_targets.mk release_spec: opt - $(INSTALL_DIR) $(RELSYSDIR)/src - $(INSTALL_DATA) $(ERL_FILES) erl_parse.yrl $(RELSYSDIR)/src - $(INSTALL_DATA) $(INTERNAL_HRL_FILES) $(RELSYSDIR)/src - $(INSTALL_DIR) $(RELSYSDIR)/include - $(INSTALL_DATA) $(HRL_FILES) $(RELSYSDIR)/include - $(INSTALL_DIR) $(RELSYSDIR)/ebin - $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin + $(INSTALL_DIR) "$(RELSYSDIR)/src" + $(INSTALL_DATA) $(ERL_FILES) erl_parse.yrl "$(RELSYSDIR)/src" + $(INSTALL_DATA) $(INTERNAL_HRL_FILES) "$(RELSYSDIR)/src" + $(INSTALL_DIR) "$(RELSYSDIR)/include" + $(INSTALL_DATA) $(HRL_FILES) "$(RELSYSDIR)/include" + $(INSTALL_DIR) "$(RELSYSDIR)/ebin" + $(INSTALL_DATA) $(TARGET_FILES) "$(RELSYSDIR)/ebin" release_docs_spec: diff --git a/lib/stdlib/src/digraph_utils.erl b/lib/stdlib/src/digraph_utils.erl index e221be15a1..807b5c12a1 100644 --- a/lib/stdlib/src/digraph_utils.erl +++ b/lib/stdlib/src/digraph_utils.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2011. All Rights Reserved. +%% Copyright Ericsson AB 1999-2012. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -370,5 +370,5 @@ condense('$end_of_table', _T, _SC, _G, _SCG, _I2C) -> condense(I, T, SC, G, SCG, I2C) -> [{_,C}] = ets:lookup(I2C, I), digraph:add_vertex(SCG, C), - digraph:add_edge(SCG, SC, C), + [digraph:add_edge(SCG, SC, C) || C =/= SC], condense(ets:next(T, I), T, SC, G, SCG, I2C). diff --git a/lib/stdlib/src/epp.erl b/lib/stdlib/src/epp.erl index 230a4a0612..ccc14610d7 100644 --- a/lib/stdlib/src/epp.erl +++ b/lib/stdlib/src/epp.erl @@ -267,8 +267,10 @@ init_server(Pid, Name, File, AtLocation, Path, Pdm, Pre) -> case user_predef(Pdm, Ms0) of {ok,Ms1} -> epp_reply(Pid, {ok,self()}), + %% ensure directory of current source file is first in path + Path1 = [filename:dirname(Name) | Path], St = #epp{file=File, location=AtLocation, delta=0, name=Name, - name2=Name, path=Path, macs=Ms1, pre_opened = Pre}, + name2=Name, path=Path1, macs=Ms1, pre_opened = Pre}, From = wait_request(St), enter_file_reply(From, Name, AtLocation, AtLocation), wait_req_scan(St); @@ -360,18 +362,18 @@ wait_req_skip(St, Sis) -> From = wait_request(St), skip_toks(From, St, Sis). -%% enter_file(Path, FileName, IncludeToken, From, EppState) +%% enter_file(FileName, IncludeToken, From, EppState) %% leave_file(From, EppState) %% Handle entering and leaving included files. Notify caller when the %% current file is changed. Note it is an error to exit a file if we are %% in a conditional. These functions never return. -enter_file(_Path, _NewName, Inc, From, St) +enter_file(_NewName, Inc, From, St) when length(St#epp.sstk) >= 8 -> epp_reply(From, {error,{abs_loc(Inc),epp,{depth,"include"}}}), wait_req_scan(St); -enter_file(Path, NewName, Inc, From, St) -> - case file:path_open(Path, NewName, [read]) of +enter_file(NewName, Inc, From, St) -> + case file:path_open(St#epp.path, NewName, [read]) of {ok,NewF,Pname} -> Loc = start_loc(St#epp.location), wait_req_scan(enter_file2(NewF, Pname, From, St, Loc)); @@ -384,13 +386,16 @@ enter_file(Path, NewName, Inc, From, St) -> %% Set epp to use this file and "enter" it. enter_file2(NewF, Pname, From, St, AtLocation) -> - enter_file2(NewF, Pname, From, St, AtLocation, []). - -enter_file2(NewF, Pname, From, St, AtLocation, ExtraPath) -> Loc = start_loc(AtLocation), enter_file_reply(From, Pname, Loc, AtLocation), Ms = dict:store({atom,'FILE'}, {none,[{string,Loc,Pname}]}, St#epp.macs), - Path = St#epp.path ++ ExtraPath, + %% 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 + %% that the directory of the parent source file (the previous head of + %% the path) must be dropped, otherwise the path used within the current + %% file will depend on the order of file inclusions in the parent files + Path = [filename:dirname(Pname) | tl(St#epp.path)], #epp{file=NewF,location=Loc,name=Pname,delta=0, sstk=[St|St#epp.sstk],path=Path,macs=Ms}. @@ -655,7 +660,7 @@ scan_undef(_Toks, Undef, From, St) -> scan_include([{'(',_Llp},{string,_Lf,NewName0},{')',_Lrp},{dot,_Ld}], Inc, From, St) -> NewName = expand_var(NewName0), - enter_file(St#epp.path, NewName, Inc, From, St); + enter_file(NewName, Inc, From, St); scan_include(_Toks, Inc, From, St) -> epp_reply(From, {error,{abs_loc(Inc),epp,{bad,include}}}), wait_req_scan(St). @@ -687,9 +692,8 @@ scan_include_lib([{'(',_Llp},{string,_Lf,NewName0},{')',_Lrp},{dot,_Ld}], LibName = fname_join([LibDir | Rest]), case file:open(LibName, [read]) of {ok,NewF} -> - ExtraPath = [filename:dirname(LibName)], wait_req_scan(enter_file2(NewF, LibName, From, - St, Loc, ExtraPath)); + St, Loc)); {error,_E2} -> epp_reply(From, {error,{abs_loc(Inc),epp, diff --git a/lib/stdlib/src/erl_compile.erl b/lib/stdlib/src/erl_compile.erl index ff032b129c..81bec21a3f 100644 --- a/lib/stdlib/src/erl_compile.erl +++ b/lib/stdlib/src/erl_compile.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2011. All Rights Reserved. +%% Copyright Ericsson AB 1997-2012. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -57,17 +57,7 @@ compile_cmdline(List) -> end. my_halt(Reason) -> - case process_info(group_leader(), status) of - {_,waiting} -> - %% Now all output data is down in the driver. - %% Give the driver some extra time before halting. - receive after 1 -> ok end, - halt(Reason); - _ -> - %% Probably still processing I/O requests. - erlang:yield(), - my_halt(Reason) - end. + erlang:halt(Reason). %% Run the the compiler in a separate process, trapping EXITs. diff --git a/lib/stdlib/src/erl_eval.erl b/lib/stdlib/src/erl_eval.erl index 4f4fa16040..95ba6b1096 100644 --- a/lib/stdlib/src/erl_eval.erl +++ b/lib/stdlib/src/erl_eval.erl @@ -256,7 +256,8 @@ expr({'receive',_,Cs}, Bs, Lf, Ef, RBs) -> expr({'receive',_, Cs, E, TB}, Bs0, Lf, Ef, RBs) -> {value,T,Bs} = expr(E, Bs0, Lf, Ef, none), receive_clauses(T, Cs, {TB,Bs}, Bs0, Lf, Ef, [], RBs); -expr({'fun',_Line,{function,Mod,Name,Arity}}, Bs, _Lf, _Ef, RBs) -> +expr({'fun',_Line,{function,Mod0,Name0,Arity0}}, Bs0, Lf, Ef, RBs) -> + {[Mod,Name,Arity],Bs} = expr_list([Mod0,Name0,Arity0], Bs0, Lf, Ef), F = erlang:make_fun(Mod, Name, Arity), ret_expr(F, Bs, RBs); expr({'fun',_Line,{function,Name,Arity}}, _Bs0, _Lf, _Ef, _RBs) -> % R8 @@ -340,7 +341,7 @@ expr({call,_,{remote,_,Mod,Func},As0}, Bs0, Lf, Ef, RBs) -> true -> bif(F, As, Bs3, Ef, RBs); false -> - do_apply({M,F}, As, Bs3, Ef, RBs) + do_apply(M, F, As, Bs3, Ef, RBs) end; expr({call,_,{atom,_,Func},As0}, Bs0, Lf, Ef, RBs) -> case erl_internal:bif(Func, length(As0)) of @@ -498,11 +499,11 @@ local_func2({eval,F,As,Bs}, RBs) -> % This reply is not documented. bif(apply, [erlang,apply,As], Bs, Ef, RBs) -> bif(apply, As, Bs, Ef, RBs); bif(apply, [M,F,As], Bs, Ef, RBs) -> - do_apply({M,F}, As, Bs, Ef, RBs); + do_apply(M, F, As, Bs, Ef, RBs); bif(apply, [F,As], Bs, Ef, RBs) -> do_apply(F, As, Bs, Ef, RBs); bif(Name, As, Bs, Ef, RBs) -> - do_apply({erlang,Name}, As, Bs, Ef, RBs). + do_apply(erlang, Name, As, Bs, Ef, RBs). %% do_apply(MF, Arguments, Bindings, ExternalFuncHandler, RBs) -> %% {value,Value,Bindings} | Value when @@ -562,6 +563,19 @@ do_apply(Func, As, Bs0, Ef, RBs) -> ret_expr(F(Func, As), Bs0, RBs) end. +do_apply(Mod, Func, As, Bs0, Ef, RBs) -> + case Ef of + none when RBs =:= value -> + %% Make tail recursive calls when possible. + apply(Mod, Func, As); + none -> + ret_expr(apply(Mod, Func, As), Bs0, RBs); + {value,F} when RBs =:= value -> + F({Mod,Func}, As); + {value,F} -> + ret_expr(F({Mod,Func}, As), Bs0, RBs) + end. + %% eval_lc(Expr, [Qualifier], Bindings, LocalFunctionHandler, %% ExternalFuncHandler, RetBindings) -> %% {value,Value,Bindings} | Value @@ -730,10 +744,10 @@ expr_list([], Vs, _, Bs, _Lf, _Ef) -> {reverse(Vs),Bs}. eval_op(Op, Arg1, Arg2, Bs, Ef, RBs) -> - do_apply({erlang,Op}, [Arg1,Arg2], Bs, Ef, RBs). + do_apply(erlang, Op, [Arg1,Arg2], Bs, Ef, RBs). eval_op(Op, Arg, Bs, Ef, RBs) -> - do_apply({erlang,Op}, [Arg], Bs, Ef, RBs). + do_apply(erlang, Op, [Arg], Bs, Ef, RBs). %% if_clauses(Clauses, Bindings, LocalFuncHandler, ExtFuncHandler, RBs) @@ -919,8 +933,9 @@ guard0([], _Bs, _Lf, _Ef) -> true. guard_test({call,L,{atom,Ln,F},As0}, Bs0, Lf, Ef) -> TT = type_test(F), - guard_test({call,L,{tuple,Ln,[{atom,Ln,erlang},{atom,Ln,TT}]},As0}, - Bs0, Lf, Ef); + G = {call,L,{atom,Ln,TT},As0}, + try {value,true,_} = expr(G, Bs0, Lf, Ef, none) + catch error:_ -> {value,false,Bs0} end; guard_test({call,L,{remote,_Lr,{atom,_Lm,erlang},{atom,_Lf,_F}=T},As0}, Bs0, Lf, Ef) -> guard_test({call,L,T,As0}, Bs0, Lf, Ef); @@ -932,7 +947,6 @@ type_test(integer) -> is_integer; type_test(float) -> is_float; type_test(number) -> is_number; type_test(atom) -> is_atom; -type_test(constant) -> is_constant; type_test(list) -> is_list; type_test(tuple) -> is_tuple; type_test(pid) -> is_pid; diff --git a/lib/stdlib/src/erl_expand_records.erl b/lib/stdlib/src/erl_expand_records.erl index 20fd247cea..9759a8f001 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-2011. All Rights Reserved. +%% Copyright Ericsson AB 2005-2012. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -452,8 +452,10 @@ conj([], _E) -> conj([{{Name,_Rp},L,R,Sz} | AL], E) -> NL = neg_line(L), T1 = {op,NL,'orelse', - {call,NL,{atom,NL,is_record},[R,{atom,NL,Name},{integer,NL,Sz}]}, - {atom,NL,fail}}, + {call,NL, + {remote,NL,{atom,NL,erlang},{atom,NL,is_record}}, + [R,{atom,NL,Name},{integer,NL,Sz}]}, + {atom,NL,fail}}, T2 = case conj(AL, none) of empty -> T1; C -> {op,NL,'and',C,T1} @@ -581,7 +583,9 @@ strict_get_record_field(Line, R, {atom,_,F}=Index, Name, St0) -> ExpRp = erl_lint:modify_line(ExpR, fun(_L) -> 0 end), RA = {{Name,ExpRp},Line,ExpR,length(Fs)+1}, St2 = St1#exprec{strict_ra = [RA | St1#exprec.strict_ra]}, - {{call,Line,{atom,Line,element},[I,ExpR]},St2} + {{call,Line, + {remote,Line,{atom,Line,erlang},{atom,Line,element}}, + [I,ExpR]},St2} end. record_pattern(I, I, Var, Sz, Line, Acc) -> @@ -593,7 +597,9 @@ record_pattern(_, _, _, _, _, Acc) -> reverse(Acc). sloppy_get_record_field(Line, R, Index, Name, St) -> Fs = record_fields(Name, St), I = index_expr(Line, Index, Name, Fs), - expr({call,Line,{atom,Line,element},[I,R]}, St). + expr({call,Line, + {remote,Line,{atom,Line,erlang},{atom,Line,element}}, + [I,R]}, St). strict_record_tests([strict_record_tests | _]) -> true; strict_record_tests([no_strict_record_tests | _]) -> false; @@ -710,7 +716,8 @@ record_setel(R, Name, Fs, Us0) -> {'case',Lr,R, [{clause,Lr,[{tuple,Lr,[{atom,Lr,Name} | Wildcards]}],[], [foldr(fun ({I,Lf,Val}, Acc) -> - {call,Lf,{atom,Lf,setelement},[I,Acc,Val]} end, + {call,Lf,{remote,Lf,{atom,Lf,erlang}, + {atom,Lf,setelement}},[I,Acc,Val]} end, R, Us)]}, {clause,NLr,[{var,NLr,'_'}],[], [call_error(NLr, {tuple,NLr,[{atom,NLr,badrecord},{atom,NLr,Name}]})]}]}. diff --git a/lib/stdlib/src/erl_internal.erl b/lib/stdlib/src/erl_internal.erl index cd3b531d10..3063881890 100644 --- a/lib/stdlib/src/erl_internal.erl +++ b/lib/stdlib/src/erl_internal.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2011. All Rights Reserved. +%% Copyright Ericsson AB 1998-2012. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -287,6 +287,7 @@ bif(group_leader, 0) -> true; bif(group_leader, 2) -> true; bif(halt, 0) -> true; bif(halt, 1) -> true; +bif(halt, 2) -> true; bif(hd, 1) -> true; bif(integer_to_list, 1) -> true; bif(integer_to_list, 2) -> true; diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index 78b996d94b..648ff349a4 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-2012. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -248,6 +248,8 @@ format_error({illegal_guard_local_call, {F,A}}) -> io_lib:format("call to local/imported function ~w/~w is illegal in guard", [F,A]); format_error(illegal_guard_expr) -> "illegal guard expression"; +format_error(deprecated_tuple_fun) -> + "tuple funs are deprecated and will be removed in R16"; %% --- exports --- format_error({explicit_export,F,A}) -> io_lib:format("in this release, the call to ~w/~w must be written " @@ -1804,12 +1806,19 @@ guard_test(G, Vt, St0) -> %% Specially handle record type test here. guard_test2({call,Line,{atom,Lr,record},[E,A]}, Vt, St0) -> gexpr({call,Line,{atom,Lr,is_record},[E,A]}, Vt, St0); -guard_test2({call,_Line,{atom,_La,F},As}=G, Vt, St0) -> +guard_test2({call,Line,{atom,_La,F},As}=G, Vt, St0) -> {Asvt,St1} = gexpr_list(As, Vt, St0), %Always check this. A = length(As), case erl_internal:type_test(F, A) of - true when F =/= is_record -> {Asvt,St1}; - _ -> gexpr(G, Vt, St0) + true when F =/= is_record, A =/= 2 -> + case no_guard_bif_clash(St1, {F,A}) of + false -> + {Asvt,add_error(Line, {illegal_guard_local_call,{F,A}}, St1)}; + true -> + {Asvt,St1} + end; + _ -> + gexpr(G, Vt, St0) end; guard_test2(G, Vt, St) -> %% Everything else is a guard expression. @@ -1865,9 +1874,15 @@ gexpr({call,Line,{atom,_Lr,is_record},[E,R]}, Vt, St0) -> gexpr({call,Line,{remote,_Lr,{atom,_Lm,erlang},{atom,Lf,is_record}},[E,A]}, Vt, St0) -> gexpr({call,Line,{atom,Lf,is_record},[E,A]}, Vt, St0); -gexpr({call,_Line,{atom,_Lr,is_record},[E,{atom,_,_Name},{integer,_,_}]}, +gexpr({call,Line,{atom,_Lr,is_record},[E0,{atom,_,_Name},{integer,_,_}]}, Vt, St0) -> - gexpr(E, Vt, St0); + {E,St1} = gexpr(E0, Vt, St0), + case no_guard_bif_clash(St0, {is_record,3}) of + true -> + {E,St1}; + false -> + {E,add_error(Line, {illegal_guard_local_call,{is_record,3}}, St1)} + end; gexpr({call,Line,{atom,_Lr,is_record},[_,_,_]=Asvt0}, Vt, St0) -> {Asvt,St1} = gexpr_list(Asvt0, Vt, St0), {Asvt,add_error(Line, illegal_guard_expr, St1)}; @@ -1901,7 +1916,8 @@ gexpr({call,Line,{remote,_Lr,{atom,_Lm,erlang},{atom,_Lf,F}},As}, Vt, St0) -> true -> {Asvt,St1}; false -> {Asvt,add_error(Line, illegal_guard_expr, St1)} end; -gexpr({call,L,{tuple,Lt,[{atom,Lm,erlang},{atom,Lf,F}]},As}, Vt, St) -> +gexpr({call,L,{tuple,Lt,[{atom,Lm,erlang},{atom,Lf,F}]},As}, Vt, St0) -> + St = add_warning(L, deprecated_tuple_fun, St0), gexpr({call,L,{remote,Lt,{atom,Lm,erlang},{atom,Lf,F}},As}, Vt, St); gexpr({op,Line,Op,A}, Vt, St0) -> {Avt,St1} = gexpr(A, Vt, St0), @@ -2127,8 +2143,13 @@ expr({'fun',Line,Body}, Vt, St) -> true -> {[],St}; false -> {[],call_function(Line, F, A, St)} end; - {function,_M,_F,_A} -> - {[],St} + {function,M,F,A} when is_atom(M), is_atom(F), is_integer(A) -> + %% Compatibility with pre-R15 abstract format. + {[],St}; + {function,M,F,A} -> + %% New in R15. + {Bvt, St1} = expr_list([M,F,A], Vt, St), + {vtupdate(Bvt, Vt),St1} end; expr({call,_Line,{atom,_Lr,is_record},[E,{atom,Ln,Name}]}, Vt, St0) -> {Rvt,St1} = expr(E, Vt, St0), @@ -2762,12 +2783,6 @@ default_types() -> {var, 1}], dict:from_list([{T, -1} || T <- DefTypes]). -%% R12B-5 -is_newly_introduced_builtin_type({module, 0}) -> true; -is_newly_introduced_builtin_type({node, 0}) -> true; -is_newly_introduced_builtin_type({nonempty_string, 0}) -> true; -is_newly_introduced_builtin_type({term, 0}) -> true; -is_newly_introduced_builtin_type({timeout, 0}) -> true; %% R13 is_newly_introduced_builtin_type({arity, 0}) -> true; is_newly_introduced_builtin_type({array, 0}) -> true; % opaque @@ -3424,17 +3439,11 @@ obsolete_guard({call,Line,{atom,Lr,F},As}, St0) -> false -> deprecated_function(Line, erlang, F, As, St0); true -> - St1 = case F of - constant -> - deprecated_function(Lr, erlang, is_constant, As, St0); - _ -> - St0 - end, - case is_warn_enabled(obsolete_guard, St1) of + case is_warn_enabled(obsolete_guard, St0) of true -> - add_warning(Lr,{obsolete_guard, {F, Arity}}, St1); + add_warning(Lr,{obsolete_guard, {F, Arity}}, St0); false -> - St1 + St0 end end; obsolete_guard(_G, St) -> diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl index 709bd83e6f..928c10f7f2 100644 --- a/lib/stdlib/src/erl_parse.yrl +++ b/lib/stdlib/src/erl_parse.yrl @@ -35,7 +35,7 @@ tuple %struct record_expr record_tuple record_field record_fields if_expr if_clause if_clauses case_expr cr_clause cr_clauses receive_expr -fun_expr fun_clause fun_clauses +fun_expr fun_clause fun_clauses atom_or_var integer_or_var try_expr try_catch try_clause try_clauses query_expr function_call argument_list exprs guard @@ -395,11 +395,17 @@ receive_expr -> 'receive' cr_clauses 'after' expr clause_body 'end' : fun_expr -> 'fun' atom '/' integer : {'fun',?line('$1'),{function,element(3, '$2'),element(3, '$4')}}. -fun_expr -> 'fun' atom ':' atom '/' integer : - {'fun',?line('$1'),{function,element(3, '$2'),element(3, '$4'),element(3,'$6')}}. +fun_expr -> 'fun' atom_or_var ':' atom_or_var '/' integer_or_var : + {'fun',?line('$1'),{function,'$2','$4','$6'}}. fun_expr -> 'fun' fun_clauses 'end' : build_fun(?line('$1'), '$2'). +atom_or_var -> atom : '$1'. +atom_or_var -> var : '$1'. + +integer_or_var -> integer : '$1'. +integer_or_var -> var : '$1'. + fun_clauses -> fun_clause : ['$1']. fun_clauses -> fun_clause ';' fun_clauses : ['$1' | '$3']. diff --git a/lib/stdlib/src/erl_pp.erl b/lib/stdlib/src/erl_pp.erl index 7dc19f2e9b..6b5aa951cf 100644 --- a/lib/stdlib/src/erl_pp.erl +++ b/lib/stdlib/src/erl_pp.erl @@ -457,8 +457,16 @@ lexpr({'fun',_,{function,F,A}}, _Prec, _Hook) -> leaf(format("fun ~w/~w", [F,A])); lexpr({'fun',_,{function,F,A},Extra}, _Prec, _Hook) -> {force_nl,fun_info(Extra),leaf(format("fun ~w/~w", [F,A]))}; -lexpr({'fun',_,{function,M,F,A}}, _Prec, _Hook) -> +lexpr({'fun',_,{function,M,F,A}}, _Prec, _Hook) + when is_atom(M), is_atom(F), is_integer(A) -> + %% For backward compatibility with pre-R15 abstract format. leaf(format("fun ~w:~w/~w", [M,F,A])); +lexpr({'fun',_,{function,M,F,A}}, _Prec, Hook) -> + %% New format in R15. + NameItem = lexpr(M, Hook), + CallItem = lexpr(F, Hook), + ArityItem = lexpr(A, Hook), + ["fun ",NameItem,$:,CallItem,$/,ArityItem]; lexpr({'fun',_,{clauses,Cs}}, _Prec, Hook) -> {list,[{first,'fun',fun_clauses(Cs, Hook)},'end']}; lexpr({'fun',_,{clauses,Cs},Extra}, _Prec, Hook) -> diff --git a/lib/stdlib/src/error_logger_file_h.erl b/lib/stdlib/src/error_logger_file_h.erl index ee4f0b3a51..e9364ed787 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-2009. All Rights Reserved. +%% Copyright Ericsson AB 1996-2012. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -104,7 +104,7 @@ code_change(_OldVsn, State, _Extra) -> %%% ------------------------------------------------------ tag_event(Event) -> - {erlang:localtime(), Event}. + {erlang:universaltime(), Event}. write_events(Fd, Events) -> write_events1(Fd, lists:reverse(Events)). @@ -169,23 +169,18 @@ write_event(_, _) -> maybe_utc(Time) -> UTC = case application:get_env(sasl, utc_log) of - {ok, Val} -> - Val; + {ok, Val} -> Val; undefined -> %% Backwards compatible: case application:get_env(stdlib, utc_log) of - {ok, Val} -> - Val; - undefined -> - false + {ok, Val} -> Val; + undefined -> false end end, - if - UTC =:= true -> - {utc, calendar:local_time_to_universal_time(Time)}; - true -> - Time - end. + maybe_utc(Time, UTC). + +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 @@ -238,7 +233,7 @@ 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)]); -write_time({{Y,Mo,D},{H,Mi,S}}, Type) -> +write_time({local, {{Y,Mo,D},{H,Mi,S}}}, Type) -> io_lib:format("~n=~s==== ~p-~s-~p::~s:~s:~s ===~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 fa13fbb2bd..ad5891f191 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-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-2012. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -97,7 +97,7 @@ set_group_leader() -> end. tag_event(Event) -> - {erlang:localtime(), Event}. + {erlang:universaltime(), Event}. write_events(Events,IOMod) -> write_events1(lists:reverse(Events),IOMod). @@ -162,23 +162,18 @@ write_event({_Time, _Error},_IOMod) -> maybe_utc(Time) -> UTC = case application:get_env(sasl, utc_log) of - {ok, Val} -> - Val; + {ok, Val} -> Val; undefined -> %% Backwards compatible: case application:get_env(stdlib, utc_log) of - {ok, Val} -> - Val; - undefined -> - false + {ok, Val} -> Val; + undefined -> false end end, - if - UTC =:= true -> - {utc, calendar:local_time_to_universal_time(Time)}; - true -> - Time - end. + maybe_utc(Time, UTC). + +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); @@ -234,7 +229,7 @@ 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)]); -write_time({{Y,Mo,D},{H,Mi,S}},Type) -> +write_time({local, {{Y,Mo,D},{H,Mi,S}}},Type) -> io_lib:format("~n=~s==== ~p-~s-~p::~s:~s:~s ===~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 ad49d89908..498d850df3 100644 --- a/lib/stdlib/src/escript.erl +++ b/lib/stdlib/src/escript.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2011. All Rights Reserved. +%% Copyright Ericsson AB 2007-2012. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -22,7 +22,7 @@ -export([script_name/0, create/2, extract/2]). %% Internal API. --export([start/0, start/1]). +-export([start/0, start/1, parse_file/1]). %%----------------------------------------------------------------------- @@ -346,7 +346,8 @@ parse_and_run(File, Args, Options) -> case Source of archive -> {ok, FileInfo} = file:read_file_info(File), - case code:set_primary_archive(File, FormsOrBin, FileInfo) of + case code:set_primary_archive(File, FormsOrBin, FileInfo, + fun escript:parse_file/1) of ok when CheckOnly -> case code:load_file(Module) of {module, _} -> @@ -396,6 +397,19 @@ parse_and_run(File, Args, Options) -> %% Parse script %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Only used as callback by erl_prim_loader +parse_file(File) -> + try parse_file(File, false) of + {_Source, _Module, FormsOrBin, _HasRecs, _Mode} + when is_binary(FormsOrBin) -> + {ok, FormsOrBin}; + _ -> + {error, no_archive_bin} + catch + throw:Reason -> + {error, Reason} + end. + parse_file(File, CheckOnly) -> {HeaderSz, NextLineNo, Fd, Sections} = parse_header(File, false), @@ -848,17 +862,7 @@ fatal(Str) -> throw(Str). my_halt(Reason) -> - case process_info(group_leader(), status) of - {_,waiting} -> - %% Now all output data is down in the driver. - %% Give the driver some extra time before halting. - receive after 1 -> ok end, - halt(Reason); - _ -> - %% Probably still processing I/O requests. - erlang:yield(), - my_halt(Reason) - end. + erlang:halt(Reason). hidden_apply(App, M, F, Args) -> try diff --git a/lib/stdlib/src/filelib.erl b/lib/stdlib/src/filelib.erl index d532cea187..b098d4cb91 100644 --- a/lib/stdlib/src/filelib.erl +++ b/lib/stdlib/src/filelib.erl @@ -264,6 +264,9 @@ ensure_dir(F) -> case do_is_dir(Dir, file) of true -> ok; + false when Dir =:= F -> + %% Protect against infinite loop + {error,einval}; false -> ensure_dir(Dir), case file:make_dir(Dir) of diff --git a/lib/stdlib/src/filename.erl b/lib/stdlib/src/filename.erl index 1cb9e4a25e..870af4e95f 100644 --- a/lib/stdlib/src/filename.erl +++ b/lib/stdlib/src/filename.erl @@ -147,9 +147,10 @@ basename(Name) when is_binary(Name) -> end; basename(Name0) -> - Name = flatten(Name0), + Name1 = flatten(Name0), {DirSep2, DrvSep} = separators(), - basename1(skip_prefix(Name, DrvSep), [], DirSep2). + Name = skip_prefix(Name1, DrvSep), + basename1(Name, Name, DirSep2). win_basenameb(<<Letter,$:,Rest/binary>>) when ?IS_DRIVELETTER(Letter) -> basenameb(Rest,[<<"/">>,<<"\\">>]); @@ -167,16 +168,18 @@ basenameb(Bin,Sep) -> -basename1([$/|[]], Tail, DirSep2) -> - basename1([], Tail, DirSep2); +basename1([$/], Tail0, _DirSep2) -> + %% End of filename -- must get rid of trailing directory separator. + [_|Tail] = lists:reverse(Tail0), + lists:reverse(Tail); basename1([$/|Rest], _Tail, DirSep2) -> - basename1(Rest, [], DirSep2); + basename1(Rest, Rest, DirSep2); basename1([DirSep2|Rest], Tail, DirSep2) when is_integer(DirSep2) -> basename1([$/|Rest], Tail, DirSep2); basename1([Char|Rest], Tail, DirSep2) when is_integer(Char) -> - basename1(Rest, [Char|Tail], DirSep2); + basename1(Rest, Tail, DirSep2); basename1([], Tail, _DirSep2) -> - lists:reverse(Tail). + Tail. skip_prefix(Name, false) -> Name; @@ -369,8 +372,8 @@ extension(Name0) -> Name = flatten(Name0), extension(Name, [], major_os_type()). -extension([$.|Rest], _Result, OsType) -> - extension(Rest, [$.], OsType); +extension([$.|Rest]=Result, _Result, OsType) -> + extension(Rest, Result, OsType); extension([Char|Rest], [], OsType) when is_integer(Char) -> extension(Rest, [], OsType); extension([$/|Rest], _Result, OsType) -> @@ -378,9 +381,9 @@ extension([$/|Rest], _Result, OsType) -> extension([$\\|Rest], _Result, win32) -> extension(Rest, [], win32); extension([Char|Rest], Result, OsType) when is_integer(Char) -> - extension(Rest, [Char|Result], OsType); + extension(Rest, Result, OsType); extension([], Result, _OsType) -> - lists:reverse(Result). + Result. %% Joins a list of filenames with directory separators. @@ -723,6 +726,8 @@ nativename(Name0) -> _ -> Name end. +win32_nativename(Name) when is_binary(Name) -> + binary:replace(Name, <<"/">>, <<"\\">>, [global]); win32_nativename([$/|Rest]) -> [$\\|win32_nativename(Rest)]; win32_nativename([C|Rest]) -> @@ -833,16 +838,18 @@ try_file(undefined, ObjFilename, Mod, Rules) -> Error -> Error end; try_file(Src, _ObjFilename, Mod, _Rules) -> - List = Mod:module_info(compile), - {options, Options} = lists:keyfind(options, 1, List), + List = case Mod:module_info(compile) of + none -> []; + List0 -> List0 + end, + Options = proplists:get_value(options, List, []), {ok, Cwd} = file:get_cwd(), AbsPath = make_abs_path(Cwd, Src), {AbsPath, filter_options(dirname(AbsPath), Options, [])}. %% Filters the options. %% -%% 1) Remove options that have no effect on the generated code, -%% such as report and verbose. +%% 1) Only keep options that have any effect on code generation. %% %% 2) The paths found in {i, Path} and {outdir, Path} are converted %% to absolute paths. When doing this, it is assumed that relatives @@ -854,14 +861,10 @@ filter_options(Base, [{outdir, Path}|Rest], Result) -> filter_options(Base, Rest, [{outdir, make_abs_path(Base, Path)}|Result]); filter_options(Base, [{i, Path}|Rest], Result) -> filter_options(Base, Rest, [{i, make_abs_path(Base, Path)}|Result]); -filter_options(Base, [Option|Rest], Result) when Option =:= trace -> - filter_options(Base, Rest, [Option|Result]); filter_options(Base, [Option|Rest], Result) when Option =:= export_all -> filter_options(Base, Rest, [Option|Result]); filter_options(Base, [Option|Rest], Result) when Option =:= binary -> filter_options(Base, Rest, [Option|Result]); -filter_options(Base, [Option|Rest], Result) when Option =:= fast -> - filter_options(Base, Rest, [Option|Result]); filter_options(Base, [Tuple|Rest], Result) when element(1, Tuple) =:= d -> filter_options(Base, Rest, [Tuple|Result]); filter_options(Base, [Tuple|Rest], Result) @@ -875,12 +878,7 @@ filter_options(_Base, [], Result) -> %% Gets the source file given path of object code and module name. get_source_file(Obj, Mod, Rules) -> - case catch Mod:module_info(source_file) of - {'EXIT', _Reason} -> - source_by_rules(dirname(Obj), packages:last(Mod), Rules); - File -> - {ok, File} - end. + source_by_rules(dirname(Obj), packages:last(Mod), Rules). source_by_rules(Dir, Base, [{From, To}|Rest]) -> case try_rule(Dir, Base, From, To) of diff --git a/lib/stdlib/src/gen.erl b/lib/stdlib/src/gen.erl index 574146b1cd..42555aedd7 100644 --- a/lib/stdlib/src/gen.erl +++ b/lib/stdlib/src/gen.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% Copyright Ericsson AB 1996-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -36,7 +36,7 @@ %%----------------------------------------------------------------- -type linkage() :: 'link' | 'nolink'. --type emgr_name() :: {'local', atom()} | {'global', term()}. +-type emgr_name() :: {'local', atom()} | {'global', term()} | {via, atom(), term()}. -type start_ret() :: {'ok', pid()} | 'ignore' | {'error', term()}. @@ -53,7 +53,7 @@ %% start(GenMod, LinkP, Name, Mod, Args, Options) %% GenMod = atom(), callback module implementing the 'real' fsm %% LinkP = link | nolink -%% Name = {local, atom()} | {global, term()} +%% Name = {local, atom()} | {global, term()} | {via, atom(), term()} %% Args = term(), init arguments (to Mod:init/1) %% Options = [{timeout, Timeout} | {debug, [Flag]} | {spawn_opt, OptionList}] %% Flag = trace | log | {logfile, File} | statistics | debug @@ -158,9 +158,12 @@ call(Name, Label, Request, Timeout) exit(noproc) end; %% Global by name -call({global, _Name}=Process, Label, Request, Timeout) - when Timeout =:= infinity; - is_integer(Timeout), Timeout >= 0 -> +call(Process, Label, Request, Timeout) + when ((tuple_size(Process) == 2 andalso element(1, Process) == global) + orelse + (tuple_size(Process) == 3 andalso element(1, Process) == via)) + andalso + (Timeout =:= infinity orelse (is_integer(Timeout) andalso Timeout >= 0)) -> case where(Process) of Pid when is_pid(Pid) -> Node = node(Pid), @@ -273,7 +276,8 @@ reply({To, Tag}, Reply) -> %%%----------------------------------------------------------------- %%% Misc. functions. %%%----------------------------------------------------------------- -where({global, Name}) -> global:safe_whereis_name(Name); +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) -> @@ -287,8 +291,16 @@ name_register({global, Name} = GN) -> case global:register_name(Name, self()) of yes -> true; no -> {false, where(GN)} + end; +name_register({via, Module, Name} = GN) -> + case Module:register_name(Name, self()) of + yes -> + true; + no -> + {false, where(GN)} end. + timeout(Options) -> case opt(timeout, Options) of {ok, Time} -> diff --git a/lib/stdlib/src/gen_event.erl b/lib/stdlib/src/gen_event.erl index 9879b76391..2b8ba86909 100644 --- a/lib/stdlib/src/gen_event.erl +++ b/lib/stdlib/src/gen_event.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-2012. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -70,7 +70,8 @@ -callback init(InitArgs :: term()) -> {ok, State :: term()} | - {ok, State :: term(), hibernate}. + {ok, State :: term(), hibernate} | + {error, Reason :: term()}. -callback handle_event(Event :: term(), State :: term()) -> {ok, NewState :: term()} | {ok, NewState :: term(), hibernate} | @@ -106,8 +107,10 @@ -type add_handler_ret() :: ok | term() | {'EXIT',term()}. -type del_handler_ret() :: ok | term() | {'EXIT',term()}. --type emgr_name() :: {'local', atom()} | {'global', atom()}. --type emgr_ref() :: atom() | {atom(), atom()} | {'global', atom()} | pid(). +-type emgr_name() :: {'local', atom()} | {'global', atom()} + | {'via', atom(), term()}. +-type emgr_ref() :: atom() | {atom(), atom()} | {'global', atom()} + | {'via', atom(), term()} | pid(). -type start_ret() :: {'ok', pid()} | {'error', term()}. %%--------------------------------------------------------------------------- @@ -142,6 +145,7 @@ init_it(Starter, Parent, Name0, _, _, Options) -> 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(). @@ -208,6 +212,9 @@ call1(M, Handler, Query, Timeout) -> send({global, Name}, Cmd) -> catch global:send(Name, Cmd), ok; +send({via, Mod, Name}, Cmd) -> + catch Mod:send(Name, Cmd), + ok; send(M, Cmd) -> M ! Cmd, ok. diff --git a/lib/stdlib/src/gen_fsm.erl b/lib/stdlib/src/gen_fsm.erl index 3db8c9f4f2..e480e2ac11 100644 --- a/lib/stdlib/src/gen_fsm.erl +++ b/lib/stdlib/src/gen_fsm.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% Copyright Ericsson AB 1996-2012. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -165,7 +165,7 @@ %%% start(Name, Mod, Args, Options) %%% start_link(Mod, Args, Options) %%% start_link(Name, Mod, Args, Options) where: -%%% Name ::= {local, atom()} | {global, atom()} +%%% Name ::= {local, atom()} | {global, atom()} | {via, atom(), term()} %%% Mod ::= atom(), callback module implementing the 'real' fsm %%% Args ::= term(), init arguments (to Mod:init/1) %%% Options ::= [{debug, [Flag]}] @@ -191,6 +191,9 @@ start_link(Name, Mod, Args, Options) -> send_event({global, Name}, Event) -> catch global:send(Name, {'$gen_event', Event}), ok; +send_event({via, Mod, Name}, Event) -> + catch Mod:send(Name, {'$gen_event', Event}), + ok; send_event(Name, Event) -> Name ! {'$gen_event', Event}, ok. @@ -214,6 +217,9 @@ sync_send_event(Name, Event, Timeout) -> send_all_state_event({global, Name}, Event) -> catch global:send(Name, {'$gen_all_state_event', Event}), ok; +send_all_state_event({via, Mod, Name}, Event) -> + catch Mod:send(Name, {'$gen_all_state_event', Event}), + ok; send_all_state_event(Name, Event) -> Name ! {'$gen_all_state_event', Event}, ok. @@ -273,7 +279,10 @@ cancel_timer(Ref) -> enter_loop(Mod, Options, StateName, StateData) -> enter_loop(Mod, Options, StateName, StateData, self(), infinity). -enter_loop(Mod, Options, StateName, StateData, ServerName = {_,_}) -> +enter_loop(Mod, Options, StateName, StateData, {Scope,_} = ServerName) + when Scope == local; Scope == global -> + enter_loop(Mod, Options, StateName, StateData, ServerName,infinity); +enter_loop(Mod, Options, StateName, StateData, {via,_,_} = ServerName) -> enter_loop(Mod, Options, StateName, StateData, ServerName,infinity); enter_loop(Mod, Options, StateName, StateData, Timeout) -> enter_loop(Mod, Options, StateName, StateData, self(), Timeout). @@ -296,13 +305,22 @@ get_proc_name({local, Name}) -> exit(process_not_registered) end; get_proc_name({global, Name}) -> - case global:safe_whereis_name(Name) of + 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() -> @@ -318,9 +336,9 @@ get_parent() -> name_to_pid(Name) -> case whereis(Name) of undefined -> - case global:safe_whereis_name(Name) of + case global:whereis_name(Name) of undefined -> - exit(could_not_find_registerd_name); + exit(could_not_find_registered_name); Pid -> Pid end; @@ -348,12 +366,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), proc_lib:init_ack(Starter, {error, Reason}), exit(Reason); ignore -> + unregister_name(Name0), proc_lib:init_ack(Starter, ignore), exit(normal); {'EXIT', Reason} -> + unregister_name(Name0), proc_lib:init_ack(Starter, {error, Reason}), exit(Reason); Else -> @@ -364,8 +385,18 @@ init_it(Starter, Parent, Name0, Mod, Args, Options) -> 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 dd0ef74f30..04308a51b7 100644 --- a/lib/stdlib/src/gen_server.erl +++ b/lib/stdlib/src/gen_server.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% Copyright Ericsson AB 1996-2012. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -134,7 +134,7 @@ term(). -callback code_change(OldVsn :: (term() | {down, term()}), State :: term(), Extra :: term()) -> - {ok, NewState :: term()}. + {ok, NewState :: term()} | {error, Reason :: term()}. %%% ----------------------------------------------------------------- %%% Starts a generic server. @@ -142,7 +142,7 @@ %%% start(Name, Mod, Args, Options) %%% start_link(Mod, Args, Options) %%% start_link(Name, Mod, Args, Options) where: -%%% Name ::= {local, atom()} | {global, atom()} +%%% Name ::= {local, atom()} | {global, atom()} | {via, atom(), term()} %%% Mod ::= atom(), callback module implementing the 'real' server %%% Args ::= term(), init arguments (to Mod:init/1) %%% Options ::= [{timeout, Timeout} | {debug, [Flag]}] @@ -194,6 +194,9 @@ call(Name, Request, Timeout) -> cast({global,Name}, Request) -> catch global:send(Name, cast_msg(Request)), ok; +cast({via, Mod, Name}, Request) -> + catch Mod:send(Name, cast_msg(Request)), + ok; cast({Name,Node}=Dest, Request) when is_atom(Name), is_atom(Node) -> do_cast(Dest, Request); cast(Dest, Request) when is_atom(Dest) -> @@ -266,7 +269,11 @@ multi_call(Nodes, Name, Req, Timeout) enter_loop(Mod, Options, State) -> enter_loop(Mod, Options, State, self(), infinity). -enter_loop(Mod, Options, State, ServerName = {_, _}) -> +enter_loop(Mod, Options, State, ServerName = {Scope, _}) + when Scope == local; Scope == global -> + enter_loop(Mod, Options, State, ServerName, infinity); + +enter_loop(Mod, Options, State, ServerName = {via, _, _}) -> enter_loop(Mod, Options, State, ServerName, infinity); enter_loop(Mod, Options, State, Timeout) -> @@ -327,12 +334,15 @@ init_it(Starter, Parent, Name0, Mod, Args, Options) -> 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. @@ -820,13 +830,22 @@ get_proc_name({local, Name}) -> exit(process_not_registered) end; get_proc_name({global, Name}) -> - case global:safe_whereis_name(Name) of + 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() -> @@ -842,9 +861,9 @@ get_parent() -> name_to_pid(Name) -> case whereis(Name) of undefined -> - case global:safe_whereis_name(Name) of + case global:whereis_name(Name) of undefined -> - exit(could_not_find_registerd_name); + exit(could_not_find_registered_name); Pid -> Pid end; diff --git a/lib/stdlib/src/lib.erl b/lib/stdlib/src/lib.erl index 314fd60903..cf4b87d7eb 100644 --- a/lib/stdlib/src/lib.erl +++ b/lib/stdlib/src/lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-2012. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -209,7 +209,7 @@ explain_reason(badarg, error, [], _PF, _S) -> explain_reason({badarg,V}, error=Cl, [], PF, S) -> % orelse, andalso format_value(V, <<"bad argument: ">>, Cl, PF, S); explain_reason(badarith, error, [], _PF, _S) -> - <<"bad argument in an arithmetic expression">>; + <<"an error occurred when evaluating an arithmetic expression">>; explain_reason({badarity,{Fun,As}}, error, [], _PF, _S) when is_function(Fun) -> %% Only the arity is displayed, not the arguments As. diff --git a/lib/stdlib/src/ms_transform.erl b/lib/stdlib/src/ms_transform.erl index 48e22e53fa..4389fd457c 100644 --- a/lib/stdlib/src/ms_transform.erl +++ b/lib/stdlib/src/ms_transform.erl @@ -333,17 +333,18 @@ form({function,Line,Name0,Arity0,Clauses0}) -> form(AnyOther) -> AnyOther. function(Name, Arity, Clauses0) -> - {Clauses1,_} = clauses(Clauses0,gb_sets:new()), + Clauses1 = clauses(Clauses0), {Name,Arity,Clauses1}. -clauses([C0|Cs],Bound) -> - {C1,Bound1} = clause(C0,Bound), - {C2,Bound2} = clauses(Cs,Bound1), - {[C1|C2],Bound2}; -clauses([],Bound) -> {[],Bound}. +clauses([C0|Cs]) -> + C1 = clause(C0,gb_sets:new()), + C2 = clauses(Cs), + [C1|C2]; +clauses([]) -> []. + clause({clause,Line,H0,G0,B0},Bound) -> {H1,Bound1} = copy(H0,Bound), - {B1,Bound2} = copy(B0,Bound1), - {{clause,Line,H1,G0,B1},Bound2}. + {B1,_Bound2} = copy(B0,Bound1), + {clause,Line,H1,G0,B1}. copy({call,Line,{remote,_Line2,{atom,_Line3,ets},{atom,_Line4,fun2ms}}, As0},Bound) -> @@ -880,7 +881,6 @@ translate_language_element(Atom) -> end. old_bool_test(atom,1) -> is_atom; -old_bool_test(constant,1) -> is_constant; old_bool_test(float,1) -> is_float; old_bool_test(integer,1) -> is_integer; old_bool_test(list,1) -> is_list; @@ -895,7 +895,6 @@ old_bool_test(record,2) -> is_record; old_bool_test(_,_) -> undefined. bool_test(is_atom,1) -> true; -bool_test(is_constant,1) -> true; bool_test(is_float,1) -> true; bool_test(is_integer,1) -> true; bool_test(is_list,1) -> true; diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl index c1285dab60..b9fbef9ed0 100644 --- a/lib/stdlib/src/otp_internal.erl +++ b/lib/stdlib/src/otp_internal.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2011. All Rights Reserved. +%% Copyright Ericsson AB 1999-2012. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -41,37 +41,12 @@ obsolete(Module, Name, Arity) -> no end. -obsolete_1(init, get_flag, 1) -> - {removed, {init, get_argument, 1}, "R12B"}; -obsolete_1(init, get_flags, 0) -> - {removed, {init, get_arguments, 0}, "R12B"}; -obsolete_1(init, get_args, 0) -> - {removed, {init, get_plain_arguments, 0}, "R12B"}; -obsolete_1(unix, cmd, 1) -> - {removed, {os,cmd,1}, "R9B"}; - obsolete_1(net, _, _) -> {deprecated, "module 'net' obsolete; use 'net_adm'"}; obsolete_1(erl_internal, builtins, 0) -> {deprecated, {erl_internal, bif, 2}}; -obsolete_1(string, re_sh_to_awk, 1) -> - {removed, {regexp, sh_to_awk, 1}, "R12B"}; -obsolete_1(string, re_parse, 1) -> - {removed, {regexp, parse, 1}, "R12B"}; -obsolete_1(string, re_match, 2) -> - {removed, {regexp, match, 2}, "R12B"}; -obsolete_1(string, re_sub, 3) -> - {removed, {regexp, sub, 3}, "R12B"}; -obsolete_1(string, re_gsub, 3) -> - {removed, {regexp, gsub, 3}, "R12B"}; -obsolete_1(string, re_split, 2) -> - {removed, {regexp, split, 2}, "R12B"}; - -obsolete_1(string, index, 2) -> - {removed, {string, str, 2}, "R12B"}; - obsolete_1(erl_eval, seq, 2) -> {deprecated, {erl_eval, exprs, 2}}; obsolete_1(erl_eval, seq, 3) -> @@ -81,99 +56,9 @@ obsolete_1(erl_eval, arg_list, 2) -> obsolete_1(erl_eval, arg_list, 3) -> {deprecated, {erl_eval, expr_list, 3}}; -obsolete_1(erl_pp, seq, 1) -> - {removed, {erl_pp, exprs, 1}, "R12B"}; -obsolete_1(erl_pp, seq, 2) -> - {removed, {erl_pp, exprs, 2}, "R12B"}; - -obsolete_1(io, scan_erl_seq, 1) -> - {removed, {io, scan_erl_exprs, 1}, "R12B"}; -obsolete_1(io, scan_erl_seq, 2) -> - {removed, {io, scan_erl_exprs, 2}, "R12B"}; -obsolete_1(io, scan_erl_seq, 3) -> - {removed, {io, scan_erl_exprs, 3}, "R12B"}; -obsolete_1(io, parse_erl_seq, 1) -> - {removed, {io, parse_erl_exprs, 1}, "R12B"}; -obsolete_1(io, parse_erl_seq, 2) -> - {removed, {io, parse_erl_exprs, 2}, "R12B"}; -obsolete_1(io, parse_erl_seq, 3) -> - {removed, {io, parse_erl_exprs, 3}, "R12B"}; -obsolete_1(io, parse_exprs, 2) -> - {removed, {io, parse_erl_exprs, 2}, "R12B"}; - -obsolete_1(io_lib, scan, 1) -> - {removed, {erl_scan, string, 1}, "R12B"}; -obsolete_1(io_lib, scan, 2) -> - {removed, {erl_scan, string, 2}, "R12B"}; -obsolete_1(io_lib, scan, 3) -> - {removed, {erl_scan, tokens, 3}, "R12B"}; -obsolete_1(io_lib, reserved_word, 1) -> - {removed, {erl_scan, reserved_word, 1}, "R12B"}; - -obsolete_1(lists, keymap, 4) -> - {removed, {lists, keymap, 3}, "R12B"}; -obsolete_1(lists, all, 3) -> - {removed, {lists, all, 2}, "R12B"}; -obsolete_1(lists, any, 3) -> - {removed, {lists, any, 2}, "R12B"}; -obsolete_1(lists, map, 3) -> - {removed, {lists, map, 2}, "R12B"}; -obsolete_1(lists, flatmap, 3) -> - {removed, {lists, flatmap, 2}, "R12B"}; -obsolete_1(lists, foldl, 4) -> - {removed, {lists, foldl, 3}, "R12B"}; -obsolete_1(lists, foldr, 4) -> - {removed, {lists, foldr, 3}, "R12B"}; -obsolete_1(lists, mapfoldl, 4) -> - {removed, {lists, mapfoldl, 3}, "R12B"}; -obsolete_1(lists, mapfoldr, 4) -> - {removed, {lists, mapfoldr, 3}, "R12B"}; -obsolete_1(lists, filter, 3) -> - {removed, {lists, filter, 2}, "R12B"}; -obsolete_1(lists, foreach, 3) -> - {removed, {lists, foreach, 2}, "R12B"}; -obsolete_1(lists, zf, 3) -> - {removed, {lists, zf, 2}, "R12B"}; - -obsolete_1(ets, fixtable, 2) -> - {removed, {ets, safe_fixtable, 2}, "R12B"}; - -obsolete_1(erlang, old_binary_to_term, 1) -> - {removed, {erlang, binary_to_term, 1}, "R12B"}; -obsolete_1(erlang, info, 1) -> - {removed, {erlang, system_info, 1}, "R12B"}; obsolete_1(erlang, hash, 2) -> {deprecated, {erlang, phash2, 2}}; -obsolete_1(file, file_info, 1) -> - {removed, {file, read_file_info, 1}, "R12B"}; - -obsolete_1(dict, dict_to_list, 1) -> - {removed, {dict,to_list,1}, "R12B"}; -obsolete_1(dict, list_to_dict, 1) -> - {removed, {dict,from_list,1}, "R12B"}; -obsolete_1(orddict, dict_to_list, 1) -> - {removed, {orddict,to_list,1}, "R12B"}; -obsolete_1(orddict, list_to_dict, 1) -> - {removed, {orddict,from_list,1}, "R12B"}; - -obsolete_1(sets, new_set, 0) -> - {removed, {sets, new, 0}, "R12B"}; -obsolete_1(sets, set_to_list, 1) -> - {removed, {sets, to_list, 1}, "R12B"}; -obsolete_1(sets, list_to_set, 1) -> - {removed, {sets, from_list, 1}, "R12B"}; -obsolete_1(sets, subset, 2) -> - {removed, {sets, is_subset, 2}, "R12B"}; -obsolete_1(ordsets, new_set, 0) -> - {removed, {ordsets, new, 0}, "R12B"}; -obsolete_1(ordsets, set_to_list, 1) -> - {removed, {ordsets, to_list, 1}, "R12B"}; -obsolete_1(ordsets, list_to_set, 1) -> - {removed, {ordsets, from_list, 1}, "R12B"}; -obsolete_1(ordsets, subset, 2) -> - {removed, {ordsets, is_subset, 2}, "R12B"}; - obsolete_1(calendar, local_time_to_universal_time, 1) -> {deprecated, {calendar, local_time_to_universal_time_dst, 1}}; @@ -302,17 +187,6 @@ obsolete_1(auth, node_cookie, 1) -> obsolete_1(auth, node_cookie, 2) -> {deprecated, "Deprecated; use erlang:set_cookie/2 and net_adm:ping/1 instead"}; -%% Added in R11B-5. -obsolete_1(http_base_64, _, _) -> - {removed, "The http_base_64 module was removed in R12B; use the base64 module instead"}; -obsolete_1(httpd_util, encode_base64, 1) -> - {removed, "Removed in R12B; use one of the encode functions in the base64 module instead"}; -obsolete_1(httpd_util, decode_base64, 1) -> - {removed, "Removed in R12B; use one of the decode functions in the base64 module instead"}; -obsolete_1(httpd_util, to_upper, 1) -> - {removed, {string, to_upper, 1}, "R12B"}; -obsolete_1(httpd_util, to_lower, 1) -> - {removed, {string, to_lower, 1}, "R12B"}; obsolete_1(erlang, is_constant, 1) -> {removed, "Removed in R13B"}; @@ -431,7 +305,7 @@ obsolete_1(ssh_sshd, stop, 1) -> %% Added in R13A. obsolete_1(regexp, _, _) -> - {deprecated, "the regexp module is deprecated (will be removed in R15A); use the re module instead"}; + {removed, "removed in R15; use the re module instead"}; obsolete_1(lists, flat_length, 1) -> {removed,{lists,flatlength,1},"R14"}; @@ -463,20 +337,31 @@ obsolete_1(public_key, decode_private_key, A) when A =:= 1; A =:= 2 -> %% Added in R14B03. obsolete_1(docb_gen, _, _) -> - {deprecated,"the DocBuilder application is deprecated (will be removed in R15B)"}; + {removed,"the DocBuilder application was removed in R15B"}; obsolete_1(docb_transform, _, _) -> - {deprecated,"the DocBuilder application is deprecated (will be removed in R15B)"}; + {removed,"the DocBuilder application was removed in R15B"}; obsolete_1(docb_xml_check, _, _) -> - {deprecated,"the DocBuilder application is deprecated (will be removed in R15B)"}; + {removed,"the DocBuilder application was removed in R15B"}; %% Added in R15B obsolete_1(asn1rt, F, _) when F == load_driver; F == unload_driver -> {deprecated,"deprecated (will be removed in R16A); has no effect as drivers are no longer used."}; - +obsolete_1(ssl, pid, 1) -> + {deprecated,"deprecated (will be removed in R17); is no longer needed"}; +obsolete_1(inviso, _, _) -> + {deprecated,"the inviso application has been deprecated and will be removed in R16"}; + +%% Added in R15B01. +obsolete_1(gs, _, _) -> + {deprecated,"the gs application has been deprecated and will be removed in R16; use the wx application instead"}; +obsolete_1(ssh, sign_data, 2) -> + {deprecated,"deprecated (will be removed in R16A); use public_key:pem_decode/1, public_key:pem_entry_decode/1 " + "and public_key:sign/3 instead"}; +obsolete_1(ssh, verify_data, 3) -> + {deprecated,"deprecated (will be removed in R16A); use public_key:ssh_decode/1, and public_key:verify/4 instead"}; obsolete_1(_, _, _) -> no. - -spec is_snmp_agent_function(atom(), byte()) -> boolean(). is_snmp_agent_function(c, 1) -> true; diff --git a/lib/stdlib/src/qlc.erl b/lib/stdlib/src/qlc.erl index f5e180b4bd..2b691e6abf 100644 --- a/lib/stdlib/src/qlc.erl +++ b/lib/stdlib/src/qlc.erl @@ -1272,7 +1272,10 @@ abstr_term(Fun, Line) when is_function(Fun) -> case erlang:fun_info(Fun, type) of {type, external} -> {module, Module} = erlang:fun_info(Fun, module), - {'fun', Line, {function,Module,Name,Arity}}; + {'fun', Line, {function, + {atom,Line,Module}, + {atom,Line,Name}, + {integer,Line,Arity}}}; {type, local} -> {'fun', Line, {function,Name,Arity}} end diff --git a/lib/stdlib/src/random.erl b/lib/stdlib/src/random.erl index dbb524cc74..d7b51a151c 100644 --- a/lib/stdlib/src/random.erl +++ b/lib/stdlib/src/random.erl @@ -26,6 +26,10 @@ -export([seed/0, seed/1, seed/3, uniform/0, uniform/1, uniform_s/1, uniform_s/2, seed0/0]). +-define(PRIME1, 30269). +-define(PRIME2, 30307). +-define(PRIME3, 30323). + %%----------------------------------------------------------------------- %% The type of the state @@ -44,7 +48,11 @@ seed0() -> -spec seed() -> ran(). seed() -> - reseed(seed0()). + case seed_put(seed0()) of + undefined -> seed0(); + {_,_,_} = Tuple -> Tuple + end. + %% seed({A1, A2, A3}) %% Seed random number generation @@ -66,17 +74,15 @@ seed({A1, A2, A3}) -> A3 :: integer(). seed(A1, A2, A3) -> - put(random_seed, - {abs(A1) rem 30269, abs(A2) rem 30307, abs(A3) rem 30323}). + seed_put({(abs(A1) rem (?PRIME1-1)) + 1, % Avoid seed numbers that are + (abs(A2) rem (?PRIME2-1)) + 1, % even divisors of the + (abs(A3) rem (?PRIME3-1)) + 1}). % corresponding primes. --spec reseed(ran()) -> ran(). - -reseed({A1, A2, A3}) -> - case seed(A1, A2, A3) of - undefined -> seed0(); - {_,_,_} = Tuple -> Tuple - end. +-spec seed_put(ran()) -> 'undefined' | ran(). + +seed_put(Seed) -> + put(random_seed, Seed). %% uniform() %% Returns a random float between 0 and 1. @@ -88,11 +94,11 @@ uniform() -> undefined -> seed0(); Tuple -> Tuple end, - B1 = (A1*171) rem 30269, - B2 = (A2*172) rem 30307, - B3 = (A3*170) rem 30323, + B1 = (A1*171) rem ?PRIME1, + B2 = (A2*172) rem ?PRIME2, + B3 = (A3*170) rem ?PRIME3, put(random_seed, {B1,B2,B3}), - R = A1/30269 + A2/30307 + A3/30323, + R = B1/?PRIME1 + B2/?PRIME2 + B3/?PRIME3, R - trunc(R). %% uniform(N) -> I @@ -116,10 +122,10 @@ uniform(N) when is_integer(N), N >= 1 -> State1 :: ran(). uniform_s({A1, A2, A3}) -> - B1 = (A1*171) rem 30269, - B2 = (A2*172) rem 30307, - B3 = (A3*170) rem 30323, - R = A1/30269 + A2/30307 + A3/30323, + B1 = (A1*171) rem ?PRIME1, + B2 = (A2*172) rem ?PRIME2, + B3 = (A3*170) rem ?PRIME3, + R = B1/?PRIME1 + B2/?PRIME2 + B3/?PRIME3, {R - trunc(R), {B1,B2,B3}}. %% uniform_s(N, State) -> {I, NewState} diff --git a/lib/stdlib/src/re.erl b/lib/stdlib/src/re.erl index 99bcbd722e..246d535943 100644 --- a/lib/stdlib/src/re.erl +++ b/lib/stdlib/src/re.erl @@ -48,7 +48,7 @@ split(Subject,RE) -> Subject :: iodata() | unicode:charlist(), RE :: mp() | iodata() | unicode:charlist(), Options :: [ Option ], - Option :: anchored | global | notbol | noteol | notempty + Option :: anchored | notbol | noteol | notempty | {offset, non_neg_integer()} | {newline, nl_spec()} | bsr_anycrlf | bsr_unicode | {return, ReturnType} | {parts, NumParts} | group | trim | CompileOpt, diff --git a/lib/stdlib/src/regexp.erl b/lib/stdlib/src/regexp.erl deleted file mode 100644 index 65f9ca247d..0000000000 --- a/lib/stdlib/src/regexp.erl +++ /dev/null @@ -1,557 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% --module(regexp). - -%% This entire module is deprecated and will be removed in a future -%% release. Use the 're' module instead. -%% -%% This module provides a basic set of regular expression functions -%% for strings. The functions provided are taken from AWK. -%% -%% Note that we interpret the syntax tree of a regular expression -%% directly instead of converting it to an NFA and then interpreting -%% that. This method seems to go significantly faster. - --export([sh_to_awk/1,parse/1,format_error/1,match/2,first_match/2,matches/2]). --export([sub/3,gsub/3,split/2]). - --deprecated([sh_to_awk/1,parse/1,format_error/1,match/2,first_match/2,matches/2]). --deprecated([sub/3,gsub/3,split/2]). - --import(string, [substr/2,substr/3]). --import(lists, [reverse/1]). - --type errordesc() :: term(). --opaque regexp() :: term(). - -%% -type matchres() = {match,Start,Length} | nomatch | {error,E}. -%% -type subres() = {ok,RepString,RepCount} | {error,E}. -%% -type splitres() = {ok,[SubString]} | {error,E}. - -%%-compile([export_all]). - -%% This is the regular expression grammar used. It is equivalent to the -%% one used in AWK, except that we allow ^ $ to be used anywhere and fail -%% in the matching. -%% -%% reg -> reg1 : '$1'. -%% reg1 -> reg1 "|" reg2 : {'or','$1','$2'}. -%% reg1 -> reg2 : '$1'. -%% reg2 -> reg2 reg3 : {concat,'$1','$2'}. -%% reg2 -> reg3 : '$1'. -%% reg3 -> reg3 "*" : {kclosure,'$1'}. -%% reg3 -> reg3 "+" : {pclosure,'$1'}. -%% reg3 -> reg3 "?" : {optional,'$1'}. -%% reg3 -> reg4 : '$1'. -%% reg4 -> "(" reg ")" : '$2'. -%% reg4 -> "\\" char : '$2'. -%% reg4 -> "^" : bos. -%% reg4 -> "$" : eos. -%% reg4 -> "." : char. -%% reg4 -> "[" class "]" : {char_class,char_class('$2')} -%% reg4 -> "[" "^" class "]" : {comp_class,char_class('$3')} -%% reg4 -> "\"" chars "\"" : char_string('$2') -%% reg4 -> char : '$1'. -%% reg4 -> empty : epsilon. -%% The grammar of the current regular expressions. The actual parser -%% is a recursive descent implementation of the grammar. - -reg(S) -> reg1(S). - -%% reg1 -> reg2 reg1' -%% reg1' -> "|" reg2 -%% reg1' -> empty - -reg1(S0) -> - {L,S1} = reg2(S0), - reg1p(S1, L). - -reg1p([$||S0], L) -> - {R,S1} = reg2(S0), - reg1p(S1, {'or',L,R}); -reg1p(S, L) -> {L,S}. - -%% reg2 -> reg3 reg2' -%% reg2' -> reg3 -%% reg2' -> empty - -reg2(S0) -> - {L,S1} = reg3(S0), - reg2p(S1, L). - -reg2p([C|S0], L) when C =/= $|, C =/= $) -> - {R,S1} = reg3([C|S0]), - reg2p(S1, {concat,L,R}); -reg2p(S, L) -> {L,S}. - -%% reg3 -> reg4 reg3' -%% reg3' -> "*" reg3' -%% reg3' -> "+" reg3' -%% reg3' -> "?" reg3' -%% reg3' -> empty - -reg3(S0) -> - {L,S1} = reg4(S0), - reg3p(S1, L). - -reg3p([$*|S], L) -> reg3p(S, {kclosure,L}); -reg3p([$+|S], L) -> reg3p(S, {pclosure,L}); -reg3p([$?|S], L) -> reg3p(S, {optional,L}); -reg3p(S, L) -> {L,S}. - --define(HEX(C), C >= $0 andalso C =< $9 orelse - C >= $A andalso C =< $F orelse - C >= $a andalso C =< $f). - -reg4([$(|S0]) -> - case reg(S0) of - {R,[$)|S1]} -> {R,S1}; - {_R,_S} -> throw({error,{unterminated,"("}}) - end; -reg4([$\\,O1,O2,O3|S]) when - O1 >= $0, O1 =< $7, O2 >= $0, O2 =< $7, O3 >= $0, O3 =< $7 -> - {(O1*8 + O2)*8 + O3 - 73*$0,S}; -reg4([$\\,$x,H1,H2|S]) when ?HEX(H1), ?HEX(H2) -> - {erlang:list_to_integer([H1,H2], 16),S}; -reg4([$\\,$x,${|S]) -> - hex(S, []); -reg4([$\\,$x|_]) -> - throw({error,{illegal,[$x]}}); -reg4([$\\,C|S]) -> {escape_char(C),S}; -reg4([$\\]) -> throw({error,{unterminated,"\\"}}); -reg4([$^|S]) -> {bos,S}; -reg4([$$|S]) -> {eos,S}; -reg4([$.|S]) -> {{comp_class,"\n"},S}; -reg4("[^" ++ S0) -> - case char_class(S0) of - {Cc,[$]|S1]} -> {{comp_class,Cc},S1}; - {_Cc,_S} -> throw({error,{unterminated,"["}}) - end; -reg4([$[|S0]) -> - case char_class(S0) of - {Cc,[$]|S1]} -> {{char_class,Cc},S1}; - {_Cc,_S1} -> throw({error,{unterminated,"["}}) - end; -%reg4([$"|S0]) -> -% case char_string(S0) of -% {St,[$"|S1]} -> {St,S1}; -% {St,S1} -> throw({error,{unterminated,"\""}}) -% end; -reg4([C|S]) when C =/= $*, C =/= $+, C =/= $?, C =/= $] -> {C,S}; -reg4([C|_S]) -> throw({error,{illegal,[C]}}); -reg4([]) -> {epsilon,[]}. - -hex([C|Cs], L) when ?HEX(C) -> - hex(Cs, [C|L]); -hex([$}|S], L) -> - case catch erlang:list_to_integer(lists:reverse(L), 16) of - V when V =< 16#FF -> - {V,S}; - _ -> - throw({error,{illegal,[$}]}}) - end; -hex(_S, _) -> - throw({error,{unterminated,"\\x{"}}). - -escape_char($n) -> $\n; %\n = LF -escape_char($r) -> $\r; %\r = CR -escape_char($t) -> $\t; %\t = TAB -escape_char($v) -> $\v; %\v = VT -escape_char($b) -> $\b; %\b = BS -escape_char($f) -> $\f; %\f = FF -escape_char($e) -> $\e; %\e = ESC -escape_char($s) -> $\s; %\s = SPACE -escape_char($d) -> $\d; %\d = DEL -escape_char(C) -> C. - -char_class([$]|S]) -> char_class(S, [$]]); -char_class(S) -> char_class(S, []). - -char($\\, [O1,O2,O3|S]) when - O1 >= $0, O1 =< $7, O2 >= $0, O2 =< $7, O3 >= $0, O3 =< $7 -> - {(O1*8 + O2)*8 + O3 - 73*$0,S}; -char($\\, [$x,H1,H2|S]) when ?HEX(H1), ?HEX(H2) -> - {erlang:list_to_integer([H1,H2], 16),S}; -char($\\,[$x,${|S]) -> - hex(S, []); -char($\\,[$x|_]) -> - throw({error,{illegal,[$x]}}); -char($\\, [C|S]) -> {escape_char(C),S}; -char(C, S) -> {C,S}. - -char_class([C1|S0], Cc) when C1 =/= $] -> - case char(C1, S0) of - {Cf,[$-,C2|S1]} when C2 =/= $] -> - case char(C2, S1) of - {Cl,S2} when Cf < Cl -> char_class(S2, [{Cf,Cl}|Cc]); - {Cl,_S2} -> throw({error,{char_class,[Cf,$-,Cl]}}) - end; - {C,S1} -> char_class(S1, [C|Cc]) - end; -char_class(S, Cc) -> {Cc,S}. - -%char_string([C|S]) when C =/= $" -> char_string(S, C); -%char_string(S) -> {epsilon,S}. - -%char_string([C|S0], L) when C =/= $" -> -% char_string(S0, {concat,L,C}); -%char_string(S, L) -> {L,S}. - -%% -deftype re_app_res() = {match,RestPos,Rest} | nomatch. - -%% re_apply(String, StartPos, RegExp) -> re_app_res(). -%% -%% Apply the (parse of the) regular expression RegExp to String. If -%% there is a match return the position of the remaining string and -%% the string if else return 'nomatch'. BestMatch specifies if we want -%% the longest match, or just a match. -%% -%% StartPos should be the real start position as it is used to decide -%% if we ae at the beginning of the string. -%% -%% Pass two functions to re_apply_or so it can decide, on the basis -%% of BestMatch, whether to just any take any match or try both to -%% find the longest. This is slower but saves duplicatng code. - -re_apply(S, St, RE) -> re_apply(RE, [], S, St). - -re_apply(epsilon, More, S, P) -> %This always matches - re_apply_more(More, S, P); -re_apply({'or',RE1,RE2}, More, S, P) -> - re_apply_or(re_apply(RE1, More, S, P), - re_apply(RE2, More, S, P)); -re_apply({concat,RE1,RE2}, More, S0, P) -> - re_apply(RE1, [RE2|More], S0, P); -re_apply({kclosure,CE}, More, S, P) -> - %% Be careful with the recursion, explicitly do one call before - %% looping. - re_apply_or(re_apply_more(More, S, P), - re_apply(CE, [{kclosure,CE}|More], S, P)); -re_apply({pclosure,CE}, More, S, P) -> - re_apply(CE, [{kclosure,CE}|More], S, P); -re_apply({optional,CE}, More, S, P) -> - re_apply_or(re_apply_more(More, S, P), - re_apply(CE, More, S, P)); -re_apply(bos, More, S, 1) -> re_apply_more(More, S, 1); -re_apply(eos, More, [$\n|S], P) -> re_apply_more(More, S, P); -re_apply(eos, More, [], P) -> re_apply_more(More, [], P); -re_apply({char_class,Cc}, More, [C|S], P) -> - case in_char_class(C, Cc) of - true -> re_apply_more(More, S, P+1); - false -> nomatch - end; -re_apply({comp_class,Cc}, More, [C|S], P) -> - case in_char_class(C, Cc) of - true -> nomatch; - false -> re_apply_more(More, S, P+1) - end; -re_apply(C, More, [C|S], P) when is_integer(C) -> - re_apply_more(More, S, P+1); -re_apply(_RE, _More, _S, _P) -> nomatch. - -%% re_apply_more([RegExp], String, Length) -> re_app_res(). - -re_apply_more([RE|More], S, P) -> re_apply(RE, More, S, P); -re_apply_more([], S, P) -> {match,P,S}. - -%% in_char_class(Char, Class) -> bool(). - -in_char_class(C, [{C1,C2}|_Cc]) when C >= C1, C =< C2 -> true; -in_char_class(C, [C|_Cc]) -> true; -in_char_class(C, [_|Cc]) -> in_char_class(C, Cc); -in_char_class(_C, []) -> false. - -%% re_apply_or(Match1, Match2) -> re_app_res(). -%% If we want the best match then choose the longest match, else just -%% choose one by trying sequentially. - -re_apply_or({match,P1,S1}, {match,P2,_S2}) when P1 >= P2 -> {match,P1,S1}; -re_apply_or({match,_P1,_S1}, {match,P2,S2}) -> {match,P2,S2}; -re_apply_or(nomatch, R2) -> R2; -re_apply_or(R1, nomatch) -> R1. - -%% sh_to_awk(ShellRegExp) -%% Convert a sh style regexp into a full AWK one. The main difficulty is -%% getting character sets right as the conventions are different. - --spec sh_to_awk(ShRegExp) -> AwkRegExp when - ShRegExp :: string(), - AwkRegExp :: string(). - -sh_to_awk(Sh) -> "^(" ++ sh_to_awk_1(Sh). %Fix the beginning - -sh_to_awk_1([$*|Sh]) -> %This matches any string - ".*" ++ sh_to_awk_1(Sh); -sh_to_awk_1([$?|Sh]) -> %This matches any character - [$.|sh_to_awk_1(Sh)]; -sh_to_awk_1([$[,$^,$]|Sh]) -> %This takes careful handling - "\\^" ++ sh_to_awk_1(Sh); -sh_to_awk_1("[^" ++ Sh) -> [$[|sh_to_awk_2(Sh, true)]; -sh_to_awk_1("[!" ++ Sh) -> "[^" ++ sh_to_awk_2(Sh, false); -sh_to_awk_1([$[|Sh]) -> [$[|sh_to_awk_2(Sh, false)]; -sh_to_awk_1([C|Sh]) -> - %% Unspecialise everything else which is not an escape character. - case special_char(C) of - true -> [$\\,C|sh_to_awk_1(Sh)]; - false -> [C|sh_to_awk_1(Sh)] - end; -sh_to_awk_1([]) -> ")$". %Fix the end - -sh_to_awk_2([$]|Sh], UpArrow) -> [$]|sh_to_awk_3(Sh, UpArrow)]; -sh_to_awk_2(Sh, UpArrow) -> sh_to_awk_3(Sh, UpArrow). - -sh_to_awk_3([$]|Sh], true) -> "^]" ++ sh_to_awk_1(Sh); -sh_to_awk_3([$]|Sh], false) -> [$]|sh_to_awk_1(Sh)]; -sh_to_awk_3([C|Sh], UpArrow) -> [C|sh_to_awk_3(Sh, UpArrow)]; -sh_to_awk_3([], true) -> [$^|sh_to_awk_1([])]; -sh_to_awk_3([], false) -> sh_to_awk_1([]). - -%% -type special_char(char()) -> bool(). -%% Test if a character is a special character. - -special_char($|) -> true; -special_char($*) -> true; -special_char($+) -> true; -special_char($?) -> true; -special_char($() -> true; -special_char($)) -> true; -special_char($\\) -> true; -special_char($^) -> true; -special_char($$) -> true; -special_char($.) -> true; -special_char($[) -> true; -special_char($]) -> true; -special_char($") -> true; -special_char(_C) -> false. - -%% parse(RegExp) -> {ok,RE} | {error,E}. -%% Parse the regexp described in the string RegExp. - --spec parse(RegExp) -> ParseRes when - RegExp :: string(), - ParseRes :: {ok, RE} | {error, Error}, - RE :: regexp(), - Error :: errordesc(). - -parse(S) -> - case catch reg(S) of - {R,[]} -> {ok,R}; - {_R,[C|_]} -> {error,{illegal,[C]}}; - {error,E} -> {error,E} - end. - -%% format_error(Error) -> String. - --spec format_error(ErrorDescriptor) -> Chars when - ErrorDescriptor :: errordesc(), - Chars :: io_lib:chars(). - -format_error({illegal,What}) -> ["illegal character `",What,"'"]; -format_error({unterminated,What}) -> ["unterminated `",What,"'"]; -format_error({char_class,What}) -> - ["illegal character class ",io_lib:write_string(What)]. - -%% -type match(String, RegExp) -> matchres(). -%% Find the longest match of RegExp in String. - --spec match(String, RegExp) -> MatchRes when - String :: string(), - RegExp :: string() | regexp(), - MatchRes :: {match, Start, Length} | nomatch | {error, Error}, - Start :: pos_integer(), - Length :: pos_integer(), - Error :: errordesc(). - -match(S, RegExp) when is_list(RegExp) -> - case parse(RegExp) of - {ok,RE} -> match(S, RE); - {error,E} -> {error,E} - end; -match(S, RE) -> - case match(RE, S, 1, 0, -1) of - {Start,Len} when Len >= 0 -> - {match,Start,Len}; - {_Start,_Len} -> nomatch - end. - -match(RE, S, St, Pos, L) -> - case first_match(RE, S, St) of - {St1,L1} -> - Nst = St1 + 1, - if L1 > L -> match(RE, lists:nthtail(Nst-St, S), Nst, St1, L1); - true -> match(RE, lists:nthtail(Nst-St, S), Nst, Pos, L) - end; - nomatch -> {Pos,L} - end. - -%% -type first_match(String, RegExp) -> matchres(). -%% Find the first match of RegExp in String. - --spec first_match(String, RegExp) -> MatchRes when - String :: string(), - RegExp :: string() | regexp(), - MatchRes :: {match, Start, Length} | nomatch | {error, Error}, - Start :: pos_integer(), - Length :: pos_integer(), - Error :: errordesc(). - -first_match(S, RegExp) when is_list(RegExp) -> - case parse(RegExp) of - {ok,RE} -> first_match(S, RE); - {error,E} -> {error,E} - end; -first_match(S, RE) -> - case first_match(RE, S, 1) of - {Start,Len} when Len >= 0 -> - {match,Start,Len}; - nomatch -> nomatch - end. - -first_match(RE, S, St) when S =/= [] -> - case re_apply(S, St, RE) of - {match,P,_Rest} -> {St,P-St}; - nomatch -> first_match(RE, tl(S), St+1) - end; -first_match(_RE, [], _St) -> nomatch. - -%% -type matches(String, RegExp) -> {match,[{Start,Length}]} | {error,E}. -%% Return the all the non-overlapping matches of RegExp in String. - --spec matches(String, RegExp) -> MatchRes when - String :: string(), - RegExp :: string() | regexp(), - MatchRes :: {match, Matches} | {error, Error}, - Matches :: [{Start, Length}], - Start :: pos_integer(), - Length :: pos_integer(), - Error :: errordesc(). - -matches(S, RegExp) when is_list(RegExp) -> - case parse(RegExp) of - {ok,RE} -> matches(S, RE); - {error,E} -> {error,E} - end; -matches(S, RE) -> - {match,matches(S, RE, 1)}. - -matches(S, RE, St) -> - case first_match(RE, S, St) of - {St1,0} -> [{St1,0}|matches(substr(S, St1+2-St), RE, St1+1)]; - {St1,L1} -> [{St1,L1}|matches(substr(S, St1+L1+1-St), RE, St1+L1)]; - nomatch -> [] - end. - -%% -type sub(String, RegExp, Replace) -> subsres(). -%% Substitute the first match of the regular expression RegExp with -%% the string Replace in String. Accept pre-parsed regular -%% expressions. - --spec sub(String, RegExp, New) -> SubRes when - String :: string(), - RegExp :: string() | regexp(), - New :: string(), - NewString :: string(), - SubRes :: {ok, NewString, RepCount} | {error, Error}, - RepCount :: 0 | 1, - Error :: errordesc(). - -sub(String, RegExp, Rep) when is_list(RegExp) -> - case parse(RegExp) of - {ok,RE} -> sub(String, RE, Rep); - {error,E} -> {error,E} - end; -sub(String, RE, Rep) -> - Ss = sub_match(String, RE, 1), - {ok,sub_repl(Ss, Rep, String, 1),length(Ss)}. - -sub_match(S, RE, St) -> - case first_match(RE, S, St) of - {St1,L1} -> [{St1,L1}]; - nomatch -> [] - end. - -sub_repl([{St,L}|Ss], Rep, S, Pos) -> - Rs = sub_repl(Ss, Rep, S, St+L), - substr(S, Pos, St-Pos) ++ sub_repl(Rep, substr(S, St, L), Rs); -sub_repl([], _Rep, S, Pos) -> substr(S, Pos). - -sub_repl([$&|Rep], M, Rest) -> M ++ sub_repl(Rep, M, Rest); -sub_repl("\\&" ++ Rep, M, Rest) -> [$&|sub_repl(Rep, M, Rest)]; -sub_repl([C|Rep], M, Rest) -> [C|sub_repl(Rep, M, Rest)]; -sub_repl([], _M, Rest) -> Rest. - -%% -type gsub(String, RegExp, Replace) -> subres(). -%% Substitute every match of the regular expression RegExp with the -%% string New in String. Accept pre-parsed regular expressions. - --spec gsub(String, RegExp, New) -> SubRes when - String :: string(), - RegExp :: string() | regexp(), - New :: string(), - NewString :: string(), - SubRes :: {ok, NewString, RepCount} | {error, Error}, - RepCount :: non_neg_integer(), - Error :: errordesc(). - -gsub(String, RegExp, Rep) when is_list(RegExp) -> - case parse(RegExp) of - {ok,RE} -> gsub(String, RE, Rep); - {error,E} -> {error,E} - end; -gsub(String, RE, Rep) -> - Ss = matches(String, RE, 1), - {ok,sub_repl(Ss, Rep, String, 1),length(Ss)}. - -%% -type split(String, RegExp) -> splitres(). -%% Split a string into substrings where the RegExp describes the -%% field seperator. The RegExp " " is specially treated. - --spec split(String, RegExp) -> SplitRes when - String :: string(), - RegExp :: string() | regexp(), - SplitRes :: {ok, FieldList} | {error, Error}, - FieldList :: [string()], - Error :: errordesc(). - -split(String, " ") -> %This is really special - {ok,RE} = parse("[ \t]+"), - case split_apply(String, RE, true) of - [[]|Ss] -> {ok,Ss}; - Ss -> {ok,Ss} - end; -split(String, RegExp) when is_list(RegExp) -> - case parse(RegExp) of - {ok,RE} -> {ok,split_apply(String, RE, false)}; - {error,E} -> {error,E} - end; -split(String, RE) -> {ok,split_apply(String, RE, false)}. - -split_apply(S, RE, Trim) -> split_apply(S, 1, RE, Trim, []). - -split_apply([], _P, _RE, true, []) -> []; -split_apply([], _P, _RE, _T, Sub) -> [reverse(Sub)]; -split_apply(S, P, RE, T, Sub) -> - case re_apply(S, P, RE) of - {match,P,_Rest} -> - split_apply(tl(S), P+1, RE, T, [hd(S)|Sub]); - {match,P1,Rest} -> - [reverse(Sub)|split_apply(Rest, P1, RE, T, [])]; - nomatch -> - split_apply(tl(S), P+1, RE, T, [hd(S)|Sub]) - end. diff --git a/lib/stdlib/src/shell.erl b/lib/stdlib/src/shell.erl index 964697cae6..dc450f0ee6 100644 --- a/lib/stdlib/src/shell.erl +++ b/lib/stdlib/src/shell.erl @@ -1065,9 +1065,10 @@ local_func(F, As0, Bs0, _Shell, _RT, Lf, Ef) when is_atom(F) -> non_builtin_local_func(F,As,Bs). non_builtin_local_func(F,As,Bs) -> - case erlang:function_exported(user_default, F, length(As)) of + Arity = length(As), + case erlang:function_exported(user_default, F, Arity) of true -> - {eval,{user_default,F},As,Bs}; + {eval,erlang:make_fun(user_default, F, Arity),As,Bs}; false -> shell_default(F,As,Bs) end. @@ -1079,7 +1080,7 @@ shell_default(F,As,Bs) -> {module, _} -> case erlang:function_exported(M,F,A) of true -> - {eval,{M,F},As,Bs}; + {eval,erlang:make_fun(M, F, A),As,Bs}; false -> shell_undef(F,A) end; diff --git a/lib/stdlib/src/stdlib.app.src b/lib/stdlib/src/stdlib.app.src index 9d15f01683..a30685e830 100644 --- a/lib/stdlib/src/stdlib.app.src +++ b/lib/stdlib/src/stdlib.app.src @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% Copyright Ericsson AB 1996-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -85,7 +85,6 @@ queue, random, re, - regexp, sets, shell, shell_default, diff --git a/lib/stdlib/src/stdlib.appup.src b/lib/stdlib/src/stdlib.appup.src index 54a63833e6..94e81188b5 100644 --- a/lib/stdlib/src/stdlib.appup.src +++ b/lib/stdlib/src/stdlib.appup.src @@ -1 +1,27 @@ -{"%VSN%",[],[]}. +%% -*- erlang -*- +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1999-2011. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +{"%VSN%", + %% Up from - max two major revisions back + [{<<"1\\.18(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R15 + {<<"1\\.17(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R14 + {<<"1\\.16(\\.[0-9]+)*">>,[restart_new_emulator]}],%% R13 + %% Down to - max two major revisions back + [{<<"1\\.18(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R15 + {<<"1\\.17(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R14 + {<<"1\\.16(\\.[0-9]+)*">>,[restart_new_emulator]}] %% R13 +}. diff --git a/lib/stdlib/src/supervisor.erl b/lib/stdlib/src/supervisor.erl index 9da0d52f8c..7d3c5a0e21 100644 --- a/lib/stdlib/src/supervisor.erl +++ b/lib/stdlib/src/supervisor.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-2012. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -28,8 +28,9 @@ check_childspecs/1]). %% Internal exports --export([init/1, handle_call/3, handle_info/2, terminate/2, code_change/3]). --export([handle_cast/2]). +-export([init/1, handle_call/3, handle_cast/2, handle_info/2, + terminate/2, code_change/3]). +-export([try_again_restart/2]). %%-------------------------------------------------------------------------- @@ -37,7 +38,7 @@ %%-------------------------------------------------------------------------- --type child() :: pid() | 'undefined'. +-type child() :: 'undefined' | pid(). -type child_id() :: term(). -type mfargs() :: {M :: module(), F :: atom(), A :: [term()] | undefined}. -type modules() :: [module()] | 'dynamic'. @@ -62,8 +63,8 @@ %%-------------------------------------------------------------------------- -record(child, {% pid is undefined when child is not running - pid = undefined :: child(), - name, + pid = undefined :: child() | {restarting,pid()} | [pid()], + name :: child_id(), mfargs :: mfargs(), restart_type :: restart(), shutdown :: shutdown(), @@ -95,6 +96,8 @@ [ChildSpec :: child_spec()]}} | ignore. +-define(restarting(_Pid_), {restarting,_Pid_}). + %%% --------------------------------------------------- %%% This is a general process supervisor built upon gen_server.erl. %%% Servers/processes should/could also be built using gen_server.erl. @@ -139,7 +142,8 @@ start_child(Supervisor, ChildSpec) -> Result :: {'ok', Child :: child()} | {'ok', Child :: child(), Info :: term()} | {'error', Error}, - Error :: 'running' | 'not_found' | 'simple_one_for_one' | term(). + Error :: 'running' | 'restarting' | 'not_found' | 'simple_one_for_one' | + term(). restart_child(Supervisor, Name) -> call(Supervisor, {restart_child, Name}). @@ -147,7 +151,7 @@ restart_child(Supervisor, Name) -> SupRef :: sup_ref(), Id :: child_id(), Result :: 'ok' | {'error', Error}, - Error :: 'running' | 'not_found' | 'simple_one_for_one'. + Error :: 'running' | 'restarting' | 'not_found' | 'simple_one_for_one'. delete_child(Supervisor, Name) -> call(Supervisor, {delete_child, Name}). @@ -169,7 +173,7 @@ terminate_child(Supervisor, Name) -> -spec which_children(SupRef) -> [{Id,Child,Type,Modules}] when SupRef :: sup_ref(), Id :: child_id() | undefined, - Child :: child(), + Child :: child() | 'restarting', Type :: worker(), Modules :: modules(). which_children(Supervisor) -> @@ -198,6 +202,17 @@ check_childspecs(ChildSpecs) when is_list(ChildSpecs) -> end; check_childspecs(X) -> {error, {badarg, X}}. +%%%----------------------------------------------------------------- +%%% Called by timer:apply_after from restart/2 +-spec try_again_restart(SupRef, Child) -> ok when + SupRef :: sup_ref(), + Child :: child_id() | pid(). +try_again_restart(Supervisor, Child) -> + cast(Supervisor, {try_again_restart, Child}). + +cast(Supervisor, Req) -> + gen_server:cast(Supervisor, Req). + %%% --------------------------------------------------- %%% %%% Initialize the supervisor. @@ -270,6 +285,8 @@ start_children(Children, SupName) -> start_children(Children, [], SupName). start_children([Child|Chs], NChildren, SupName) -> case do_start_child(SupName, Child) of + {ok, undefined} when Child#child.restart_type =:= temporary -> + start_children(Chs, NChildren, SupName); {ok, Pid} -> start_children(Chs, [Child#child{pid = Pid}|NChildren], SupName); {ok, Pid, _Extra} -> @@ -325,6 +342,8 @@ handle_call({start_child, EArgs}, _From, State) when ?is_simple(State) -> #child{mfargs = {M, F, A}} = Child, Args = A ++ EArgs, case do_start_child_i(M, F, Args) of + {ok, undefined} when Child#child.restart_type =:= temporary -> + {reply, {ok, undefined}, State}; {ok, Pid} -> NState = save_dynamic_child(Child#child.restart_type, Pid, Args, State), {reply, {ok, Pid}, NState}; @@ -380,6 +399,8 @@ handle_call({restart_child, Name}, _From, State) -> Error -> {reply, Error, State} end; + {value, #child{pid=?restarting(_)}} -> + {reply, {error, restarting}, State}; {value, _} -> {reply, {error, running}, State}; _ -> @@ -391,6 +412,8 @@ handle_call({delete_child, Name}, _From, State) -> {value, Child} when Child#child.pid =:= undefined -> NState = remove_child(Child, State), {reply, ok, NState}; + {value, #child{pid=?restarting(_)}} -> + {reply, {error, restarting}, State}; {value, _} -> {reply, {error, running}, State}; _ -> @@ -409,13 +432,17 @@ handle_call(which_children, _From, #state{children = [#child{restart_type = RTyp child_type = CT, modules = Mods}]} = State) when ?is_simple(State) -> - Reply = lists:map(fun({Pid, _}) -> {undefined, Pid, CT, Mods} end, + Reply = lists:map(fun({?restarting(_),_}) -> {undefined,restarting,CT,Mods}; + ({Pid, _}) -> {undefined, Pid, CT, Mods} end, ?DICT:to_list(dynamics_db(RType, State#state.dynamics))), {reply, Reply, State}; handle_call(which_children, _From, State) -> Resp = - lists:map(fun(#child{pid = Pid, name = Name, + lists:map(fun(#child{pid = ?restarting(_), name = Name, + child_type = ChildType, modules = Mods}) -> + {Name, restarting, ChildType, Mods}; + (#child{pid = Pid, name = Name, child_type = ChildType, modules = Mods}) -> {Name, Pid, ChildType, Mods} end, @@ -428,8 +455,11 @@ handle_call(count_children, _From, #state{children = [#child{restart_type = temp when ?is_simple(State) -> {Active, Count} = ?SETS:fold(fun(Pid, {Alive, Tot}) -> - if is_pid(Pid) -> {Alive+1, Tot +1}; - true -> {Alive, Tot + 1} end + 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)), Reply = case CT of supervisor -> [{specs, 1}, {active, Active}, @@ -444,8 +474,12 @@ handle_call(count_children, _From, #state{children = [#child{restart_type = RTy when ?is_simple(State) -> {Active, Count} = ?DICT:fold(fun(Pid, _Val, {Alive, Tot}) -> - if is_pid(Pid) -> {Alive+1, Tot +1}; - true -> {Alive, Tot + 1} end + 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)), Reply = case CT of supervisor -> [{specs, 1}, {active, Active}, @@ -482,14 +516,42 @@ count_child(#child{pid = Pid, child_type = supervisor}, end. -%%% Hopefully cause a function-clause as there is no API function -%%% that utilizes cast. --spec handle_cast('null', state()) -> {'noreply', state()}. +%%% If a restart attempt failed, this message is sent via +%%% timer:apply_after(0,...) 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()}. -handle_cast(null, State) -> - error_logger:error_msg("ERROR: Supervisor received cast-message 'null'~n", - []), - {noreply, State}. +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 + {ok, Args} -> + {M, F, _} = Child#child.mfargs, + NChild = Child#child{pid = RPid, mfargs = {M, F, Args}}, + case restart(NChild,State) of + {ok, State1} -> + {noreply, State1}; + {shutdown, State1} -> + {stop, shutdown, State1} + end; + error -> + {noreply, State} + end; + +handle_cast({try_again_restart,Name}, State) -> + case lists:keyfind(Name,#child.name,State#state.children) of + Child = #child{pid=?restarting(_)} -> + case restart(Child,State) of + {ok, State1} -> + {noreply, State1}; + {shutdown, State1} -> + {stop, shutdown, State1} + end; + _ -> + {noreply,State} + end. %% %% Take care of terminated children. @@ -515,9 +577,12 @@ handle_info(Msg, State) -> %% -spec terminate(term(), state()) -> 'ok'. +terminate(_Reason, #state{children=[Child]} = State) when ?is_simple(State) -> + terminate_dynamic_children(Child, dynamics_db(Child#child.restart_type, + State#state.dynamics), + State#state.name); terminate(_Reason, State) -> - terminate_children(State#state.children, State#state.name), - ok. + terminate_children(State#state.children, State#state.name). %% %% Change code for the supervisor. @@ -559,13 +624,12 @@ check_flags(What) -> {bad_flags, What}. update_childspec(State, StartSpec) when ?is_simple(State) -> - case check_startspec(StartSpec) of - {ok, [Child]} -> - {ok, State#state{children = [Child]}}; - Error -> - {error, Error} - end; - + case check_startspec(StartSpec) of + {ok, [Child]} -> + {ok, State#state{children = [Child]}}; + Error -> + {error, Error} + end; update_childspec(State, StartSpec) -> case check_startspec(StartSpec) of {ok, Children} -> @@ -585,7 +649,7 @@ update_childspec1([Child|OldC], Children, KeepOld) -> end; update_childspec1([], Children, KeepOld) -> %% Return them in (kept) reverse start order. - lists:reverse(Children ++ KeepOld). + lists:reverse(Children ++ KeepOld). update_chsp(OldCh, Children) -> case lists:map(fun(Ch) when OldCh#child.name =:= Ch#child.name -> @@ -608,16 +672,16 @@ handle_start_child(Child, State) -> case get_child(Child#child.name, State) of false -> case do_start_child(State#state.name, Child) of + {ok, undefined} when Child#child.restart_type =:= temporary -> + {{ok, undefined}, State}; {ok, Pid} -> - {{ok, Pid}, - save_child(Child#child{pid = Pid}, State)}; + {{ok, Pid}, save_child(Child#child{pid = Pid}, State)}; {ok, Pid, Extra} -> - {{ok, Pid, Extra}, - save_child(Child#child{pid = Pid}, State)}; + {{ok, Pid, Extra}, save_child(Child#child{pid = Pid}, State)}; {error, What} -> {{error, {What, Child}}, State} end; - {value, OldChild} when OldChild#child.pid =/= undefined -> + {value, OldChild} when is_pid(OldChild#child.pid) -> {{error, {already_started, OldChild#child.pid}}, State}; {value, _OldChild} -> {{error, already_present}, State} @@ -671,7 +735,21 @@ do_restart(temporary, Reason, Child, State) -> restart(Child, State) -> case add_restart(State) of {ok, NState} -> - restart(NState#state.strategy, Child, NState); + case restart(NState#state.strategy, Child, NState) of + {try_again,NState2} -> + %% Leaving control back to gen_server before + %% trying again. This way other incoming requsts + %% for the supervisor can be handled - e.g. a + %% shutdown request for the supervisor or the + %% child. + Id = if ?is_simple(State) -> Child#child.pid; + true -> Child#child.name + end, + timer:apply_after(0,?MODULE,try_again_restart,[self(),Id]), + {ok,NState2}; + Other -> + Other + end; {terminate, NState} -> report_error(shutdown, reached_max_restart_intensity, Child, State#state.name), @@ -679,9 +757,9 @@ restart(Child, State) -> end. restart(simple_one_for_one, Child, State) -> - #child{mfargs = {M, F, A}} = Child, - Dynamics = ?DICT:erase(Child#child.pid, dynamics_db(Child#child.restart_type, - State#state.dynamics)), + #child{pid = OldPid, mfargs = {M, F, A}} = Child, + Dynamics = ?DICT: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 = ?DICT:store(Pid, A, Dynamics)}, @@ -690,10 +768,13 @@ restart(simple_one_for_one, Child, State) -> NState = State#state{dynamics = ?DICT:store(Pid, A, Dynamics)}, {ok, NState}; {error, Error} -> + NState = State#state{dynamics = ?DICT:store(restarting(OldPid), A, + Dynamics)}, report_error(start_error, Error, Child, State#state.name), - restart(Child, State) + {try_again, NState} end; restart(one_for_one, Child, State) -> + OldPid = Child#child.pid, case do_start_child(State#state.name, Child) of {ok, Pid} -> NState = replace_child(Child#child{pid = Pid}, State), @@ -702,8 +783,9 @@ restart(one_for_one, Child, State) -> NState = replace_child(Child#child{pid = Pid}, State), {ok, NState}; {error, Reason} -> + NState = replace_child(Child#child{pid = restarting(OldPid)}, State), report_error(start_error, Reason, Child, State#state.name), - restart(Child, State) + {try_again, NState} end; restart(rest_for_one, Child, State) -> {ChAfter, ChBefore} = split_child(Child#child.pid, State#state.children), @@ -712,7 +794,9 @@ restart(rest_for_one, Child, State) -> {ok, ChAfter3} -> {ok, State#state{children = ChAfter3 ++ ChBefore}}; {error, ChAfter3} -> - restart(Child, State#state{children = ChAfter3 ++ ChBefore}) + NChild = Child#child{pid=restarting(Child#child.pid)}, + NState = State#state{children = ChAfter3 ++ ChBefore}, + {try_again, replace_child(NChild,NState)} end; restart(one_for_all, Child, State) -> Children1 = del_child(Child#child.pid, State#state.children), @@ -721,9 +805,14 @@ restart(one_for_all, Child, State) -> {ok, NChs} -> {ok, State#state{children = NChs}}; {error, NChs} -> - restart(Child, State#state{children = NChs}) + NChild = Child#child{pid=restarting(Child#child.pid)}, + NState = State#state{children = NChs}, + {try_again, replace_child(NChild,NState)} end. +restarting(Pid) when is_pid(Pid) -> ?restarting(Pid); +restarting(RPid) -> RPid. + %%----------------------------------------------------------------- %% Func: terminate_children/2 %% Args: Children = [child_rec()] in termination order @@ -747,7 +836,7 @@ terminate_children([Child | Children], SupName, Res) -> terminate_children([], _SupName, Res) -> Res. -do_terminate(Child, SupName) when Child#child.pid =/= undefined -> +do_terminate(Child, SupName) when is_pid(Child#child.pid) -> case shutdown(Child#child.pid, Child#child.shutdown) of ok -> ok; @@ -758,7 +847,7 @@ do_terminate(Child, SupName) when Child#child.pid =/= undefined -> end, Child#child{pid = undefined}; do_terminate(Child, _SupName) -> - Child. + Child#child{pid = undefined}. %%----------------------------------------------------------------- %% Shutdowns a child. We must check the EXIT value @@ -830,8 +919,111 @@ monitor_child(Pid) -> %% that will be handled in shutdown/2. ok end. - - + + +%%----------------------------------------------------------------- +%% Func: terminate_dynamic_children/3 +%% Args: Child = child_rec() +%% Dynamics = ?DICT() | ?SET() +%% SupName = {local, atom()} | {global, atom()} | {pid(),Mod} +%% Returns: ok +%% +%% +%% Shutdown all dynamic children. This happens when the supervisor is +%% stopped. Because the supervisor can have millions of dynamic children, we +%% can have an significative overhead here. +%%----------------------------------------------------------------- +terminate_dynamic_children(Child, Dynamics, SupName) -> + {Pids, EStack0} = monitor_dynamic_children(Child, Dynamics), + Sz = ?SETS:size(Pids), + EStack = case Child#child.shutdown of + brutal_kill -> + ?SETS:fold(fun(P, _) -> exit(P, kill) end, ok, Pids), + wait_dynamic_children(Child, Pids, Sz, undefined, EStack0); + infinity -> + ?SETS:fold(fun(P, _) -> exit(P, shutdown) end, ok, Pids), + wait_dynamic_children(Child, Pids, Sz, undefined, EStack0); + Time -> + ?SETS:fold(fun(P, _) -> exit(P, shutdown) end, ok, Pids), + TRef = erlang:start_timer(Time, self(), kill), + wait_dynamic_children(Child, Pids, Sz, TRef, EStack0) + end, + %% Unroll stacked errors and report them + ?DICT:fold(fun(Reason, Ls, _) -> + report_error(shutdown_error, Reason, + Child#child{pid=Ls}, SupName) + end, ok, EStack). + + +monitor_dynamic_children(#child{restart_type=temporary}, Dynamics) -> + ?SETS:fold(fun(P, {Pids, EStack}) -> + case monitor_child(P) of + ok -> + {?SETS:add_element(P, Pids), EStack}; + {error, normal} -> + {Pids, EStack}; + {error, Reason} -> + {Pids, ?DICT:append(Reason, P, EStack)} + end + end, {?SETS:new(), ?DICT:new()}, Dynamics); +monitor_dynamic_children(#child{restart_type=RType}, Dynamics) -> + ?DICT:fold(fun(P, _, {Pids, EStack}) when is_pid(P) -> + case monitor_child(P) of + ok -> + {?SETS:add_element(P, Pids), EStack}; + {error, normal} when RType =/= permanent -> + {Pids, EStack}; + {error, Reason} -> + {Pids, ?DICT:append(Reason, P, EStack)} + end; + (?restarting(_), _, {Pids, EStack}) -> + {Pids, EStack} + end, {?SETS:new(), ?DICT:new()}, Dynamics). + + +wait_dynamic_children(_Child, _Pids, 0, undefined, EStack) -> + EStack; +wait_dynamic_children(_Child, _Pids, 0, TRef, EStack) -> + %% If the timer has expired before its cancellation, we must empty the + %% mail-box of the 'timeout'-message. + erlang:cancel_timer(TRef), + receive + {timeout, TRef, kill} -> + EStack + after 0 -> + EStack + end; +wait_dynamic_children(#child{shutdown=brutal_kill} = Child, Pids, Sz, + TRef, EStack) -> + receive + {'DOWN', _MRef, process, Pid, killed} -> + wait_dynamic_children(Child, ?SETS:del_element(Pid, Pids), Sz-1, + TRef, EStack); + + {'DOWN', _MRef, process, Pid, Reason} -> + wait_dynamic_children(Child, ?SETS:del_element(Pid, Pids), Sz-1, + TRef, ?DICT:append(Reason, Pid, EStack)) + end; +wait_dynamic_children(#child{restart_type=RType} = Child, Pids, Sz, + TRef, EStack) -> + receive + {'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); + + {'DOWN', _MRef, process, Pid, Reason} -> + wait_dynamic_children(Child, ?SETS:del_element(Pid, Pids), Sz-1, + TRef, ?DICT:append(Reason, Pid, EStack)); + + {timeout, TRef, kill} -> + ?SETS:fold(fun(P, _) -> exit(P, kill) end, ok, Pids), + wait_dynamic_children(Child, Pids, Sz-1, undefined, EStack) + end. + %%----------------------------------------------------------------- %% Child/State manipulating functions. %%----------------------------------------------------------------- @@ -912,13 +1104,20 @@ get_child(Name, State, _) -> lists:keysearch(Name, #child.name, State#state.children). get_dynamic_child(Pid, #state{children=[Child], dynamics=Dynamics}) -> - case is_dynamic_pid(Pid, dynamics_db(Child#child.restart_type, Dynamics)) of + DynamicsDb = dynamics_db(Child#child.restart_type, Dynamics), + case is_dynamic_pid(Pid, DynamicsDb) of true -> {value, Child#child{pid=Pid}}; false -> - case erlang:is_process_alive(Pid) of - true -> false; - false -> {value, Child} + RPid = restarting(Pid), + case is_dynamic_pid(RPid, DynamicsDb) of + true -> + {value, Child#child{pid=RPid}}; + false -> + case erlang:is_process_alive(Pid) of + true -> false; + false -> {value, Child} + end end end. @@ -948,9 +1147,9 @@ remove_child(Child, State) -> %% Args: SupName = {local, atom()} | {global, atom()} | self %% Type = {Strategy, MaxIntensity, Period} %% Strategy = one_for_one | one_for_all | simple_one_for_one | -%% rest_for_one -%% MaxIntensity = integer() -%% Period = integer() +%% rest_for_one +%% MaxIntensity = integer() >= 0 +%% Period = integer() > 0 %% Mod :== atom() %% Args :== term() %% Purpose: Check that Type is of correct type (!) @@ -1001,7 +1200,7 @@ supname(N, _) -> N. %%% where Name is an atom %%% Func is {Mod, Fun, Args} == {atom(), atom(), list()} %%% RestartType is permanent | temporary | transient -%%% Shutdown = integer() | infinity | brutal_kill +%%% Shutdown = integer() > 0 | infinity | brutal_kill %%% ChildType = supervisor | worker %%% Modules = [atom()] | dynamic %%% Returns: {ok, [child_rec()]} | Error @@ -1053,7 +1252,7 @@ validRestartType(RestartType) -> throw({invalid_restart_type, RestartType}). validShutdown(Shutdown, _) when is_integer(Shutdown), Shutdown > 0 -> true; -validShutdown(infinity, supervisor) -> true; +validShutdown(infinity, _) -> true; validShutdown(brutal_kill, _) -> true; validShutdown(Shutdown, _) -> throw({invalid_shutdown, Shutdown}). @@ -1134,6 +1333,13 @@ report_error(Error, Reason, Child, SupName) -> error_logger:error_report(supervisor_report, ErrorMsg). +extract_child(Child) when is_list(Child#child.pid) -> + [{nb_children, length(Child#child.pid)}, + {name, Child#child.name}, + {mfargs, Child#child.mfargs}, + {restart_type, Child#child.restart_type}, + {shutdown, Child#child.shutdown}, + {child_type, Child#child.child_type}]; extract_child(Child) -> [{pid, Child#child.pid}, {name, Child#child.name}, diff --git a/lib/stdlib/src/zip.erl b/lib/stdlib/src/zip.erl index c82c8159b6..fd480726a7 100644 --- a/lib/stdlib/src/zip.erl +++ b/lib/stdlib/src/zip.erl @@ -1017,7 +1017,7 @@ cd_file_header_from_lh_and_pos(LH, Pos) -> file_name_length = FileNameLength, extra_field_length = ExtraFieldLength, file_comment_length = 0, % FileCommentLength, - disk_num_start = 1, % DiskNumStart, + disk_num_start = 0, % DiskNumStart, internal_attr = 0, % InternalAttr, external_attr = 0, % ExternalAttr, local_header_offset = Pos}. |