diff options
Diffstat (limited to 'lib')
22 files changed, 744 insertions, 377 deletions
diff --git a/lib/dialyzer/src/dialyzer_dataflow.erl b/lib/dialyzer/src/dialyzer_dataflow.erl index d74c04385b..6008dba080 100644 --- a/lib/dialyzer/src/dialyzer_dataflow.erl +++ b/lib/dialyzer/src/dialyzer_dataflow.erl @@ -101,6 +101,12 @@ behaviour_api_dict = [] :: dialyzer_behaviours:behaviour_api_dict()}). +-record(map, {dict = dict:new() :: dict(), + subst = dict:new() :: dict(), + modified = [] :: [Key :: term()], + modified_stack = [] :: [{[Key :: term()],reference()}], + ref = undefined :: reference() | undefined}). + %% Exported Types -opaque state() :: #state{}. @@ -1058,12 +1064,13 @@ handle_case(Tree, Map, #state{callgraph = Callgraph} = State) -> RaceListSize + 1, State1); false -> State1 end, + Map2 = join_maps_begin(Map1), {MapList, State3, Type} = handle_clauses(Clauses, Arg, ArgType, ArgType, State2, - [], Map1, [], []), - Map2 = join_maps(MapList, Map1), + [], Map2, [], []), + Map3 = join_maps_end(MapList, Map2), debug_pp_map(Map2), - {State3, Map2, Type} + {State3, Map3, Type} end. %%---------------------------------------- @@ -1640,14 +1647,15 @@ bind_pat_vars([Pat|PatLeft], [Type|TypeLeft], Acc, Map, State, Rev) -> false -> SubTuples = t_tuple_subtypes(Tuple), %% Need to call the top function to get the try-catch wrapper + MapJ = join_maps_begin(Map), Results = case Rev of true -> [bind_pat_vars_reverse(Es, t_tuple_args(SubTuple), [], - Map, State) + MapJ, State) || SubTuple <- SubTuples]; false -> - [bind_pat_vars(Es, t_tuple_args(SubTuple), [], Map, State) + [bind_pat_vars(Es, t_tuple_args(SubTuple), [], MapJ, State) || SubTuple <- SubTuples] end, case lists:keyfind(opaque, 2, Results) of @@ -1661,7 +1669,7 @@ bind_pat_vars([Pat|PatLeft], [Type|TypeLeft], Acc, Map, State, Rev) -> false -> bind_error([Pat], Tuple, t_none(), bind) end; Maps -> - Map1 = join_maps(Maps, Map), + Map1 = join_maps_end(Maps, MapJ), TupleType = t_sup([t_tuple(EsTypes) || {M, EsTypes} <- Results, M =/= error]), {Map1, TupleType} @@ -2308,27 +2316,29 @@ handle_guard_and(Guard, Map, Env, Eval, State) -> end end; neg -> + MapJ = join_maps_begin(Map), {Map1, Type1} = - try bind_guard(Arg1, Map, Env, neg, State) - catch throw:{fail, _} -> bind_guard(Arg2, Map, Env, pos, State) + try bind_guard(Arg1, MapJ, Env, neg, State) + catch throw:{fail, _} -> bind_guard(Arg2, MapJ, Env, pos, State) end, {Map2, Type2} = - try bind_guard(Arg2, Map, Env, neg, State) - catch throw:{fail, _} -> bind_guard(Arg1, Map, Env, pos, State) + try bind_guard(Arg2, MapJ, Env, neg, State) + catch throw:{fail, _} -> bind_guard(Arg1, MapJ, Env, pos, State) end, case t_is_atom(false, Type1) orelse t_is_atom(false, Type2) of - true -> {join_maps([Map1, Map2], Map), t_atom(false)}; + true -> {join_maps_end([Map1, Map2], MapJ), t_atom(false)}; false -> signal_guard_fail(Eval, Guard, [Type1, Type2], State) end; dont_know -> - {Map1, Type1} = bind_guard(Arg1, Map, Env, dont_know, State), - {Map2, Type2} = bind_guard(Arg2, Map, Env, dont_know, State), + MapJ = join_maps_begin(Map), + {Map1, Type1} = bind_guard(Arg1, MapJ, Env, dont_know, State), + {Map2, Type2} = bind_guard(Arg2, MapJ, Env, dont_know, State), Bool1 = t_inf(Type1, t_boolean()), Bool2 = t_inf(Type2, t_boolean()), case t_is_none(Bool1) orelse t_is_none(Bool2) of true -> throw({fatal_fail, none}); false -> - NewMap = join_maps([Map1, Map2], Map), + NewMap = join_maps_end([Map1, Map2], MapJ), NewType = case {t_atom_vals(Bool1), t_atom_vals(Bool2)} of {['true'] , ['true'] } -> t_atom(true); @@ -2344,20 +2354,21 @@ handle_guard_or(Guard, Map, Env, Eval, State) -> [Arg1, Arg2] = cerl:call_args(Guard), case Eval of pos -> + MapJ = join_maps_begin(Map), {Map1, Bool1} = - try bind_guard(Arg1, Map, Env, pos, State) + try bind_guard(Arg1, MapJ, Env, pos, State) catch - throw:{fail,_} -> bind_guard(Arg1, Map, Env, dont_know, State) + throw:{fail,_} -> bind_guard(Arg1, MapJ, Env, dont_know, State) end, {Map2, Bool2} = - try bind_guard(Arg2, Map, Env, pos, State) + try bind_guard(Arg2, MapJ, Env, pos, State) catch - throw:{fail,_} -> bind_guard(Arg2, Map, Env, dont_know, State) + throw:{fail,_} -> bind_guard(Arg2, MapJ, Env, dont_know, State) end, case ((t_is_atom(true, Bool1) andalso t_is_boolean(Bool2)) orelse (t_is_atom(true, Bool2) andalso t_is_boolean(Bool1))) of - true -> {join_maps([Map1, Map2], Map), t_atom(true)}; + true -> {join_maps_end([Map1, Map2], MapJ), t_atom(true)}; false -> signal_guard_fail(Eval, Guard, [Bool1, Bool2], State) end; neg -> @@ -2372,14 +2383,15 @@ handle_guard_or(Guard, Map, Env, Eval, State) -> end end; dont_know -> - {Map1, Type1} = bind_guard(Arg1, Map, Env, dont_know, State), - {Map2, Type2} = bind_guard(Arg2, Map, Env, dont_know, State), + MapJ = join_maps_begin(Map), + {Map1, Type1} = bind_guard(Arg1, MapJ, Env, dont_know, State), + {Map2, Type2} = bind_guard(Arg2, MapJ, Env, dont_know, State), Bool1 = t_inf(Type1, t_boolean()), Bool2 = t_inf(Type2, t_boolean()), case t_is_none(Bool1) orelse t_is_none(Bool2) of true -> throw({fatal_fail, none}); false -> - NewMap = join_maps([Map1, Map2], Map), + NewMap = join_maps_end([Map1, Map2], MapJ), NewType = case {t_atom_vals(Bool1), t_atom_vals(Bool2)} of {['false'], ['false']} -> t_atom(false); @@ -2493,8 +2505,9 @@ mk_guard_msg(Eval, F, Args, ArgTypes, State) -> end end. -bind_guard_case_clauses(Arg, Clauses, Map, Env, Eval, State) -> +bind_guard_case_clauses(Arg, Clauses, Map0, Env, Eval, State) -> Clauses1 = filter_fail_clauses(Clauses), + Map = join_maps_begin(Map0), {GenMap, GenArgType} = bind_guard(Arg, Map, Env, dont_know, State), bind_guard_case_clauses(GenArgType, GenMap, Arg, Clauses1, Map, Env, Eval, t_none(), [], State). @@ -2594,7 +2607,7 @@ bind_guard_case_clauses(_GenArgType, _GenMap, _ArgExpr, [], Map, _Env, _Eval, AccType, AccMaps, _State) -> case t_is_none(AccType) of true -> throw({fail, none}); - false -> {join_maps(AccMaps, Map), AccType} + false -> {join_maps_end(AccMaps, Map), AccType} end. %%% =========================================================================== @@ -2604,11 +2617,34 @@ bind_guard_case_clauses(_GenArgType, _GenMap, _ArgExpr, [], Map, _Env, _Eval, %%% =========================================================================== map__new() -> - {dict:new(), dict:new()}. + #map{}. + +%% join_maps_begin pushes 'modified' to the stack; join_maps pops +%% 'modified' from the stack. + +join_maps_begin(#map{modified = M, modified_stack = S, ref = Ref} = Map) -> + Map#map{ref = make_ref(), modified = [], modified_stack = [{M,Ref} | S]}. + +join_maps_end(Maps, MapOut) -> + #map{ref = Ref, modified_stack = [{M1,R1} | S]} = MapOut, + true = lists:all(fun(M) -> M#map.ref =:= Ref end, Maps), % sanity + Keys0 = lists:usort(lists:append([M#map.modified || M <- Maps])), + #map{dict = Dict, subst = Subst} = MapOut, + Keys = [Key || + Key <- Keys0, + dict:is_key(Key, Dict) orelse dict:is_key(Key, Subst)], + Out = case Maps of + [] -> join_maps(Maps, MapOut); + _ -> join_maps(Keys, Maps, MapOut) + end, + debug_join_check(Maps, MapOut, Out), + Out#map{ref = R1, + modified = Out#map.modified ++ M1, % duplicates possible + modified_stack = S}. join_maps(Maps, MapOut) -> - {Map, Subst} = MapOut, - Keys = ordsets:from_list(dict:fetch_keys(Map) ++ dict:fetch_keys(Subst)), + #map{dict = Dict, subst = Subst} = MapOut, + Keys = ordsets:from_list(dict:fetch_keys(Dict) ++ dict:fetch_keys(Subst)), join_maps(Keys, Maps, MapOut). join_maps([Key|Left], Maps, MapOut) -> @@ -2631,6 +2667,17 @@ join_maps_one_key([Map|Left], Key, AccType) -> join_maps_one_key([], _Key, AccType) -> AccType. +-ifdef(DEBUG). +debug_join_check(Maps, MapOut, Out) -> + #map{dict = Dict, subst = Subst} = Out, + #map{dict = Dict2, subst = Subst2} = join_maps(Maps, MapOut), + F = fun(D) -> lists:keysort(1, dict:to_list(D)) end, + [throw({bug, join_maps}) || + F(Dict) =/= F(Dict2) orelse F(Subst) =/= F(Subst2)]. +-else. +debug_join_check(_Maps, _MapOut, _Out) -> ok. +-endif. + enter_type_lists([Key|KeyTail], [Val|ValTail], Map) -> Map1 = enter_type(Key, Val, Map), enter_type_lists(KeyTail, ValTail, Map1); @@ -2643,20 +2690,21 @@ enter_type_list([{Key, Val}|Left], Map) -> enter_type_list([], Map) -> Map. -enter_type(Key, Val, {Map, Subst} = MS) -> +enter_type(Key, Val, MS) -> case cerl:is_literal(Key) of true -> MS; false -> case cerl:is_c_values(Key) of true -> - Keys = cerl:values_es(Key), + Keys = cerl:values_es(Key), case t_is_any(Val) orelse t_is_none(Val) of true -> enter_type_lists(Keys, [Val || _ <- Keys], MS); false -> - enter_type_lists(cerl:values_es(Key), t_to_tlist(Val), MS) + enter_type_lists(Keys, t_to_tlist(Val), MS) end; false -> + #map{dict = Dict, subst = Subst} = MS, KeyLabel = get_label(Key), case dict:find(KeyLabel, Subst) of {ok, NewKey} -> @@ -2664,21 +2712,25 @@ enter_type(Key, Val, {Map, Subst} = MS) -> enter_type(NewKey, Val, MS); error -> ?debug("Entering ~p :: ~s\n", [KeyLabel, t_to_string(Val)]), - case dict:find(KeyLabel, Map) of + case dict:find(KeyLabel, Dict) of {ok, Val} -> MS; - {ok, _OldVal} -> {dict:store(KeyLabel, Val, Map), Subst}; - error -> {dict:store(KeyLabel, Val, Map), Subst} + {ok, _OldVal} -> store_map(KeyLabel, Val, MS); + error -> store_map(KeyLabel, Val, MS) end end end end. -enter_subst(Key, Val, {Map, Subst} = MS) -> +store_map(Key, Val, #map{dict = Dict, ref = undefined} = Map) -> + Map#map{dict = dict:store(Key, Val, Dict)}; +store_map(Key, Val, #map{dict = Dict, modified = Mod} = Map) -> + Map#map{dict = dict:store(Key, Val, Dict), modified = [Key | Mod]}. + +enter_subst(Key, Val, #map{subst = Subst} = MS) -> KeyLabel = get_label(Key), case cerl:is_literal(Val) of true -> - NewMap = dict:store(KeyLabel, literal_type(Val), Map), - {NewMap, Subst}; + store_map(KeyLabel, literal_type(Val), MS); false -> case cerl:is_c_var(Val) of false -> MS; @@ -2691,25 +2743,29 @@ enter_subst(Key, Val, {Map, Subst} = MS) -> if KeyLabel =:= ValLabel -> MS; true -> ?debug("Subst: storing ~p = ~p\n", [KeyLabel, ValLabel]), - NewSubst = dict:store(KeyLabel, ValLabel, Subst), - {Map, NewSubst} + store_subst(KeyLabel, ValLabel, MS) end end end end. -lookup_type(Key, {Map, Subst}) -> - lookup(Key, Map, Subst, t_none()). +store_subst(Key, Val, #map{subst = S, ref = undefined} = Map) -> + Map#map{subst = dict:store(Key, Val, S)}; +store_subst(Key, Val, #map{subst = S, modified = Mod} = Map) -> + Map#map{subst = dict:store(Key, Val, S), modified = [Key | Mod]}. + +lookup_type(Key, #map{dict = Dict, subst = Subst}) -> + lookup(Key, Dict, Subst, t_none()). -lookup(Key, Map, Subst, AnyNone) -> +lookup(Key, Dict, Subst, AnyNone) -> case cerl:is_literal(Key) of true -> literal_type(Key); false -> Label = get_label(Key), case dict:find(Label, Subst) of - {ok, NewKey} -> lookup(NewKey, Map, Subst, AnyNone); + {ok, NewKey} -> lookup(NewKey, Dict, Subst, AnyNone); error -> - case dict:find(Label, Map) of + case dict:find(Label, Dict) of {ok, Val} -> Val; error -> AnyNone end @@ -2744,8 +2800,8 @@ mark_as_fresh([], Map) -> Map. -ifdef(DEBUG). -debug_pp_map(Map = {Map0, _Subst}) -> - Keys = dict:fetch_keys(Map0), +debug_pp_map(#map{dict = Dict}=Map) -> + Keys = dict:fetch_keys(Dict), io:format("Map:\n", []), lists:foreach(fun (Key) -> io:format("\t~w :: ~s\n", diff --git a/lib/erl_interface/src/legacy/global_names.c b/lib/erl_interface/src/legacy/global_names.c index 7333d94931..db1c3e6296 100644 --- a/lib/erl_interface/src/legacy/global_names.c +++ b/lib/erl_interface/src/legacy/global_names.c @@ -94,7 +94,7 @@ char **erl_global_names(int fd, int *count) if (!(names = malloc((arity * sizeof(char**)) + (size-index)))) return NULL; /* arity pointers first, followed by s */ - s = (char *)(names+arity+1); + s = (char *)(names+arity); if (count) *count = 0; for (i=0; i<arity; i++) { diff --git a/lib/hipe/cerl/erl_bif_types.erl b/lib/hipe/cerl/erl_bif_types.erl index 6f0141b0ca..cee399e861 100644 --- a/lib/hipe/cerl/erl_bif_types.erl +++ b/lib/hipe/cerl/erl_bif_types.erl @@ -1321,6 +1321,9 @@ type(erlang, resume_process, 1, Xs) -> fun (_) -> t_any() end); %% TODO: overapproximation -- fix this type(erlang, round, 1, Xs) -> strict(arg_types(erlang, round, 1), Xs, fun (_) -> t_integer() end); +type(erlang, posixtime_to_universaltime, 1, Xs) -> + strict(arg_types(erlang, posixtime_to_universaltime, 1), Xs, + fun(_) -> t_tuple([t_date(), t_time()]) end); type(erlang, self, 0, _) -> t_pid(); type(erlang, send, 2, Xs) -> type(erlang, '!', 2, Xs); % alias type(erlang, send, 3, Xs) -> @@ -1717,6 +1720,9 @@ type(erlang, universaltime, 0, _) -> type(erlang, universaltime_to_localtime, 1, Xs) -> strict(arg_types(erlang, universaltime_to_localtime, 1), Xs, fun ([T]) -> T end); +type(erlang, universaltime_to_posixtime, 1, Xs) -> + strict(arg_types(erlang, universaltime_to_posixtime,1), Xs, + fun(_) -> t_integer() end); type(erlang, unlink, 1, Xs) -> strict(arg_types(erlang, unlink, 1), Xs, fun (_) -> t_atom('true') end); type(erlang, unregister, 1, Xs) -> @@ -3776,6 +3782,8 @@ arg_types(erlang, resume_process, 1) -> [t_pid()]; % intended for debugging only arg_types(erlang, round, 1) -> [t_number()]; +arg_types(erlang, posixtime_to_universaltime, 1) -> + [t_integer()]; arg_types(erlang, self, 0) -> []; arg_types(erlang, send, 2) -> @@ -3942,6 +3950,8 @@ arg_types(erlang, universaltime, 0) -> []; arg_types(erlang, universaltime_to_localtime, 1) -> [t_tuple([t_date(), t_time()])]; +arg_types(erlang, universaltime_to_posixtime, 1) -> + [t_tuple([t_date(), t_time()])]; arg_types(erlang, unlink, 1) -> [t_sup(t_pid(), t_port())]; arg_types(erlang, unregister, 1) -> diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index 387690df43..620fed365e 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -2528,31 +2528,77 @@ findfirst(N1, N2, U1, B1, U2, B2) -> %%----------------------------------------------------------------------------- %% Substitution of variables %% +%% Dialyzer versions prior to R15B used a dict data structure to map variables +%% to types. Hans Bolinder suggested the use of lists of Key-Value pairs for +%% this data structure and measurements showed a non-trivial speedup when using +%% them for operations within this module (e.g. in t_unify/2). However, there +%% is code outside erl_types that still passes a dict() in the 2nd argument. +%% So, for the time being, this module provides a t_subst/2 function for these +%% external calls and a clone of it (t_subst_kv/2) which is used from all calls +%% from within this module. This code duplication needs to be eliminated at +%% some point. -spec t_subst(erl_type(), dict()) -> erl_type(). t_subst(T, Dict) -> case t_has_var(T) of - true -> t_subst_aux(T, Dict); + true -> t_subst_dict(T, Dict); false -> T end. +t_subst_dict(?var(Id), Dict) -> + case dict:find(Id, Dict) of + error -> ?any; + {ok, Type} -> Type + end; +t_subst_dict(?list(Contents, Termination, Size), Dict) -> + case t_subst_dict(Contents, Dict) of + ?none -> ?none; + NewContents -> + %% Be careful here to make the termination collapse if necessary. + case t_subst_dict(Termination, Dict) of + ?nil -> ?list(NewContents, ?nil, Size); + ?any -> ?list(NewContents, ?any, Size); + Other -> + ?list(NewContents, NewTermination, _) = t_cons(NewContents, Other), + ?list(NewContents, NewTermination, Size) + end + end; +t_subst_dict(?function(Domain, Range), Dict) -> + ?function(t_subst_dict(Domain, Dict), t_subst_dict(Range, Dict)); +t_subst_dict(?product(Types), Dict) -> + ?product([t_subst_dict(T, Dict) || T <- Types]); +t_subst_dict(?tuple(?any, ?any, ?any) = T, _Dict) -> + T; +t_subst_dict(?tuple(Elements, _Arity, _Tag), Dict) -> + t_tuple([t_subst_dict(E, Dict) || E <- Elements]); +t_subst_dict(?tuple_set(_) = TS, Dict) -> + t_sup([t_subst_dict(T, Dict) || T <- t_tuple_subtypes(TS)]); +t_subst_dict(T, _Dict) -> + T. + -spec subst_all_vars_to_any(erl_type()) -> erl_type(). subst_all_vars_to_any(T) -> - t_subst(T, dict:new()). + t_subst_kv(T, []). -t_subst_aux(?var(Id), Dict) -> - case dict:find(Id, Dict) of - error -> ?any; - {ok, Type} -> Type +t_subst_kv(T, KVMap) -> + case t_has_var(T) of + true -> t_subst_aux(T, KVMap); + false -> T + end. + +t_subst_aux(?var(Id), VarMap) -> + case lists:keyfind(Id, 1, VarMap) of + false -> ?any; + {Id, Type} -> Type end; -t_subst_aux(?list(Contents, Termination, Size), Dict) -> - case t_subst_aux(Contents, Dict) of +t_subst_aux(?list(Contents, Termination, Size), VarMap) -> + case t_subst_aux(Contents, VarMap) of ?none -> ?none; NewContents -> %% Be careful here to make the termination collapse if necessary. - case t_subst_aux(Termination, Dict) of + case t_subst_aux(Termination, VarMap) of ?nil -> ?list(NewContents, ?nil, Size); ?any -> ?list(NewContents, ?any, Size); Other -> @@ -2560,17 +2606,17 @@ t_subst_aux(?list(Contents, Termination, Size), Dict) -> ?list(NewContents, NewTermination, Size) end end; -t_subst_aux(?function(Domain, Range), Dict) -> - ?function(t_subst_aux(Domain, Dict), t_subst_aux(Range, Dict)); -t_subst_aux(?product(Types), Dict) -> - ?product([t_subst_aux(T, Dict) || T <- Types]); -t_subst_aux(?tuple(?any, ?any, ?any) = T, _Dict) -> +t_subst_aux(?function(Domain, Range), VarMap) -> + ?function(t_subst_aux(Domain, VarMap), t_subst_aux(Range, VarMap)); +t_subst_aux(?product(Types), VarMap) -> + ?product([t_subst_aux(T, VarMap) || T <- Types]); +t_subst_aux(?tuple(?any, ?any, ?any) = T, _VarMap) -> T; -t_subst_aux(?tuple(Elements, _Arity, _Tag), Dict) -> - t_tuple([t_subst_aux(E, Dict) || E <- Elements]); -t_subst_aux(?tuple_set(_) = TS, Dict) -> - t_sup([t_subst_aux(T, Dict) || T <- t_tuple_subtypes(TS)]); -t_subst_aux(T, _Dict) -> +t_subst_aux(?tuple(Elements, _Arity, _Tag), VarMap) -> + t_tuple([t_subst_aux(E, VarMap) || E <- Elements]); +t_subst_aux(?tuple_set(_) = TS, VarMap) -> + t_sup([t_subst_aux(T, VarMap) || T <- t_tuple_subtypes(TS)]); +t_subst_aux(T, _VarMap) -> T. %%----------------------------------------------------------------------------- @@ -2587,87 +2633,87 @@ t_unify(T1, T2) -> -spec t_unify(erl_type(), erl_type(), [erl_type()]) -> t_unify_ret(). t_unify(T1, T2, Opaques) -> - {T, Dict} = t_unify(T1, T2, dict:new(), Opaques), - {t_subst(T, Dict), lists:keysort(1, dict:to_list(Dict))}. - -t_unify(?var(Id) = T, ?var(Id), Dict, _Opaques) -> - {T, Dict}; -t_unify(?var(Id1) = T, ?var(Id2), Dict, Opaques) -> - case dict:find(Id1, Dict) of - error -> - case dict:find(Id2, Dict) of - error -> {T, dict:store(Id2, T, Dict)}; - {ok, Type} -> t_unify(T, Type, Dict, Opaques) + {T, VarMap} = t_unify(T1, T2, [], Opaques), + {t_subst_kv(T, VarMap), lists:keysort(1, VarMap)}. + +t_unify(?var(Id) = T, ?var(Id), VarMap, _Opaques) -> + {T, VarMap}; +t_unify(?var(Id1) = T, ?var(Id2), VarMap, Opaques) -> + case lists:keyfind(Id1, 1, VarMap) of + false -> + case lists:keyfind(Id2, 1, VarMap) of + false -> {T, [{Id2, T} | VarMap]}; + {Id2, Type} -> t_unify(T, Type, VarMap, Opaques) end; - {ok, Type1} -> - case dict:find(Id2, Dict) of - error -> {Type1, dict:store(Id2, T, Dict)}; - {ok, Type2} -> t_unify(Type1, Type2, Dict, Opaques) + {Id1, Type1} -> + case lists:keyfind(Id2, 1, VarMap) of + false -> {Type1, [{Id2, T} | VarMap]}; + {Id2, Type2} -> t_unify(Type1, Type2, VarMap, Opaques) end end; -t_unify(?var(Id), Type, Dict, Opaques) -> - case dict:find(Id, Dict) of - error -> {Type, dict:store(Id, Type, Dict)}; - {ok, VarType} -> t_unify(VarType, Type, Dict, Opaques) +t_unify(?var(Id), Type, VarMap, Opaques) -> + case lists:keyfind(Id, 1, VarMap) of + false -> {Type, [{Id, Type} | VarMap]}; + {Id, VarType} -> t_unify(VarType, Type, VarMap, Opaques) end; -t_unify(Type, ?var(Id), Dict, Opaques) -> - case dict:find(Id, Dict) of - error -> {Type, dict:store(Id, Type, Dict)}; - {ok, VarType} -> t_unify(VarType, Type, Dict, Opaques) +t_unify(Type, ?var(Id), VarMap, Opaques) -> + case lists:keyfind(Id, 1, VarMap) of + false -> {Type, [{Id, Type} | VarMap]}; + {Id, VarType} -> t_unify(VarType, Type, VarMap, Opaques) end; -t_unify(?function(Domain1, Range1), ?function(Domain2, Range2), Dict, Opaques) -> - {Domain, Dict1} = t_unify(Domain1, Domain2, Dict, Opaques), - {Range, Dict2} = t_unify(Range1, Range2, Dict1, Opaques), - {?function(Domain, Range), Dict2}; +t_unify(?function(Domain1, Range1), ?function(Domain2, Range2), VarMap, Opaques) -> + {Domain, VarMap1} = t_unify(Domain1, Domain2, VarMap, Opaques), + {Range, VarMap2} = t_unify(Range1, Range2, VarMap1, Opaques), + {?function(Domain, Range), VarMap2}; t_unify(?list(Contents1, Termination1, Size), - ?list(Contents2, Termination2, Size), Dict, Opaques) -> - {Contents, Dict1} = t_unify(Contents1, Contents2, Dict, Opaques), - {Termination, Dict2} = t_unify(Termination1, Termination2, Dict1, Opaques), - {?list(Contents, Termination, Size), Dict2}; -t_unify(?product(Types1), ?product(Types2), Dict, Opaques) -> - {Types, Dict1} = unify_lists(Types1, Types2, Dict, Opaques), - {?product(Types), Dict1}; -t_unify(?tuple(?any, ?any, ?any) = T, ?tuple(?any, ?any, ?any), Dict, _Opaques) -> - {T, Dict}; + ?list(Contents2, Termination2, Size), VarMap, Opaques) -> + {Contents, VarMap1} = t_unify(Contents1, Contents2, VarMap, Opaques), + {Termination, VarMap2} = t_unify(Termination1, Termination2, VarMap1, Opaques), + {?list(Contents, Termination, Size), VarMap2}; +t_unify(?product(Types1), ?product(Types2), VarMap, Opaques) -> + {Types, VarMap1} = unify_lists(Types1, Types2, VarMap, Opaques), + {?product(Types), VarMap1}; +t_unify(?tuple(?any, ?any, ?any) = T, ?tuple(?any, ?any, ?any), VarMap, _Opaques) -> + {T, VarMap}; t_unify(?tuple(Elements1, Arity, _), - ?tuple(Elements2, Arity, _), Dict, Opaques) when Arity =/= ?any -> - {NewElements, Dict1} = unify_lists(Elements1, Elements2, Dict, Opaques), - {t_tuple(NewElements), Dict1}; + ?tuple(Elements2, Arity, _), VarMap, Opaques) when Arity =/= ?any -> + {NewElements, VarMap1} = unify_lists(Elements1, Elements2, VarMap, Opaques), + {t_tuple(NewElements), VarMap1}; t_unify(?tuple_set([{Arity, _}]) = T1, - ?tuple(_, Arity, _) = T2, Dict, Opaques) when Arity =/= ?any -> - unify_tuple_set_and_tuple(T1, T2, Dict, Opaques); + ?tuple(_, Arity, _) = T2, VarMap, Opaques) when Arity =/= ?any -> + unify_tuple_set_and_tuple(T1, T2, VarMap, Opaques); t_unify(?tuple(_, Arity, _) = T1, - ?tuple_set([{Arity, _}]) = T2, Dict, Opaques) when Arity =/= ?any -> - unify_tuple_set_and_tuple(T2, T1, Dict, Opaques); -t_unify(?tuple_set(List1), ?tuple_set(List2), Dict, Opaques) -> - {Tuples, NewDict} = + ?tuple_set([{Arity, _}]) = T2, VarMap, Opaques) when Arity =/= ?any -> + unify_tuple_set_and_tuple(T2, T1, VarMap, Opaques); +t_unify(?tuple_set(List1), ?tuple_set(List2), VarMap, Opaques) -> + {Tuples, NewVarMap} = unify_lists(lists:append([T || {_Arity, T} <- List1]), - lists:append([T || {_Arity, T} <- List2]), Dict, Opaques), - {t_sup(Tuples), NewDict}; -t_unify(?opaque(Elements) = T, ?opaque(Elements), Dict, _Opaques) -> - {T, Dict}; -t_unify(?opaque(_) = T1, ?opaque(_) = T2, _Dict, _Opaques) -> + lists:append([T || {_Arity, T} <- List2]), VarMap, Opaques), + {t_sup(Tuples), NewVarMap}; +t_unify(?opaque(Elements) = T, ?opaque(Elements), VarMap, _Opaques) -> + {T, VarMap}; +t_unify(?opaque(_) = T1, ?opaque(_) = T2, _VarMap, _Opaques) -> throw({mismatch, T1, T2}); -t_unify(Type, ?opaque(_) = OpType, Dict, Opaques) -> - t_unify_with_opaque(Type, OpType, Dict, Opaques); -t_unify(?opaque(_) = OpType, Type, Dict, Opaques) -> - t_unify_with_opaque(Type, OpType, Dict, Opaques); -t_unify(T, T, Dict, _Opaques) -> - {T, Dict}; +t_unify(Type, ?opaque(_) = OpType, VarMap, Opaques) -> + t_unify_with_opaque(Type, OpType, VarMap, Opaques); +t_unify(?opaque(_) = OpType, Type, VarMap, Opaques) -> + t_unify_with_opaque(Type, OpType, VarMap, Opaques); +t_unify(T, T, VarMap, _Opaques) -> + {T, VarMap}; t_unify(T1, T2, _, _) -> throw({mismatch, T1, T2}). -t_unify_with_opaque(Type, OpType, Dict, Opaques) -> +t_unify_with_opaque(Type, OpType, VarMap, Opaques) -> case lists:member(OpType, Opaques) of true -> Struct = t_opaque_structure(OpType), - try t_unify(Type, Struct, Dict, Opaques) of - {_T, Dict1} -> {OpType, Dict1} + try t_unify(Type, Struct, VarMap, Opaques) of + {_T, VarMap1} -> {OpType, VarMap1} catch throw:{mismatch, _T1, _T2} -> case t_inf(OpType, Type, opaque) of ?none -> throw({mismatch, Type, OpType}); - _ -> {OpType, Dict} + _ -> {OpType, VarMap} end end; false -> @@ -2675,20 +2721,20 @@ t_unify_with_opaque(Type, OpType, Dict, Opaques) -> end. unify_tuple_set_and_tuple(?tuple_set([{Arity, List}]), - ?tuple(Elements2, Arity, _), Dict, Opaques) -> + ?tuple(Elements2, Arity, _), VarMap, Opaques) -> %% Can only work if the single tuple has variables at correct places. %% Collapse the tuple set. - {NewElements, Dict1} = unify_lists(sup_tuple_elements(List), Elements2, Dict, Opaques), - {t_tuple(NewElements), Dict1}. + {NewElements, VarMap1} = unify_lists(sup_tuple_elements(List), Elements2, VarMap, Opaques), + {t_tuple(NewElements), VarMap1}. -unify_lists(L1, L2, Dict, Opaques) -> - unify_lists(L1, L2, Dict, [], Opaques). +unify_lists(L1, L2, VarMap, Opaques) -> + unify_lists(L1, L2, VarMap, [], Opaques). -unify_lists([T1|Left1], [T2|Left2], Dict, Acc, Opaques) -> - {NewT, NewDict} = t_unify(T1, T2, Dict, Opaques), - unify_lists(Left1, Left2, NewDict, [NewT|Acc], Opaques); -unify_lists([], [], Dict, Acc, _Opaques) -> - {lists:reverse(Acc), Dict}. +unify_lists([T1|Left1], [T2|Left2], VarMap, Acc, Opaques) -> + {NewT, NewVarMap} = t_unify(T1, T2, VarMap, Opaques), + unify_lists(Left1, Left2, NewVarMap, [NewT|Acc], Opaques); +unify_lists([], [], VarMap, Acc, _Opaques) -> + {lists:reverse(Acc), VarMap}. %%t_assign_variables_to_subtype(T1, T2) -> %% try diff --git a/lib/kernel/doc/src/file.xml b/lib/kernel/doc/src/file.xml index 719cbba2b8..772eff13cc 100644 --- a/lib/kernel/doc/src/file.xml +++ b/lib/kernel/doc/src/file.xml @@ -150,6 +150,9 @@ <name name="mode"/> </datatype> <datatype> + <name name="file_info_option"/> + </datatype> + <datatype> <name name="sendfile_option"/> </datatype> </datatypes> @@ -412,7 +415,7 @@ <name>file_info(Filename) -> {ok, FileInfo} | {error, Reason}</name> <fsummary>Get information about a file (deprecated)</fsummary> <desc> - <p>This function is obsolete. Use <c>read_file_info/1</c> + <p>This function is obsolete. Use <c>read_file_info/1,2</c> instead.</p> </desc> </func> @@ -1189,6 +1192,7 @@ </func> <func> <name name="read_file_info" arity="1"/> + <name name="read_file_info" arity="2"/> <fsummary>Get information about a file</fsummary> <desc> <p>Retrieves information about a file. Returns @@ -1200,6 +1204,20 @@ from which the function is called:</p> <code type="none"> -include_lib("kernel/include/file.hrl").</code> + <p>The time type returned in <c>atime</c>, <c>mtime</c> and <c>ctime</c> + is dependent on the time type set in <c>Opts :: {time, Type}</c>. + Type <c>local</c> will return local time, <c>universal</c> will + return universal time and <c>posix</c> will return seconds since + or before unix time epoch which is 1970-01-01 00:00 UTC. + Default is <c>{time, local}</c>. + </p> + <note> + <p> + Since file times is stored in posix time on most OS it is + faster to query file information with the <c>posix</c> option. + </p> + </note> + <p>The record <c>file_info</c> contains the following fields.</p> <taglist> <tag><c>size = integer()</c></tag> @@ -1214,15 +1232,15 @@ <item> <p>The current system access to the file.</p> </item> - <tag><c>atime = <seealso marker="#type-date_time">date_time()</seealso></c></tag> + <tag><c>atime = <seealso marker="#type-date_time">date_time()</seealso> | integer() </c></tag> <item> - <p>The last (local) time the file was read.</p> + <p>The last time the file was read.</p> </item> - <tag><c>mtime = <seealso marker="#type-date_time">date_time()</seealso></c></tag> + <tag><c>mtime = <seealso marker="#type-date_time">date_time()</seealso> | integer() </c></tag> <item> - <p>The last (local) time the file was written.</p> + <p>The last time the file was written.</p> </item> - <tag><c>ctime = <seealso marker="#type-date_time">date_time()</seealso></c></tag> + <tag><c>ctime = <seealso marker="#type-date_time">date_time()</seealso> | integer() </c></tag> <item> <p>The interpretation of this time field depends on the operating system. On Unix, it is the last time @@ -1378,9 +1396,11 @@ </func> <func> <name name="read_link_info" arity="1"/> + <name name="read_link_info" arity="2"/> <fsummary>Get information about a link or file</fsummary> <desc> - <p>This function works like <c>read_file_info/1</c>, except that + <p>This function works like + <seealso marker="#read_file_info/2">read_file_info/1,2</seealso> except that if <c><anno>Name</anno></c> is a symbolic link, information about the link will be returned in the <c>file_info</c> record and the <c>type</c> field of the record will be set to @@ -1691,6 +1711,7 @@ </func> <func> <name name="write_file_info" arity="2"/> + <name name="write_file_info" arity="3"/> <fsummary>Change information about a file</fsummary> <desc> <p>Change file information. Returns <c>ok</c> if successful, @@ -1701,18 +1722,25 @@ from which the function is called:</p> <code type="none"> -include_lib("kernel/include/file.hrl").</code> + <p>The time type set in <c>atime</c>, <c>mtime</c> and <c>ctime</c> + is dependent on the time type set in <c>Opts :: {time, Type}</c>. + Type <c>local</c> will interpret the time set as local, <c>universal</c> will + interpret it as universal time and <c>posix</c> must be seconds since + or before unix time epoch which is 1970-01-01 00:00 UTC. + Default is <c>{time, local}</c>. + </p> <p>The following fields are used from the record, if they are given.</p> <taglist> - <tag><c>atime = <seealso marker="#type-date_time">date_time()</seealso></c></tag> + <tag><c>atime = <seealso marker="#type-date_time">date_time()</seealso> | integer()</c></tag> <item> - <p>The last (local) time the file was read.</p> + <p>The last time the file was read.</p> </item> - <tag><c>mtime = <seealso marker="#type-date_time">date_time()</seealso></c></tag> + <tag><c>mtime = <seealso marker="#type-date_time">date_time()</seealso> | integer()</c></tag> <item> - <p>The last (local) time the file was written.</p> + <p>The last time the file was written.</p> </item> - <tag><c>ctime = <seealso marker="#type-date_time">date_time()</seealso></c></tag> + <tag><c>ctime = <seealso marker="#type-date_time">date_time()</seealso> | integer()</c></tag> <item> <p>On Unix, any value give for this field will be ignored (the "ctime" for the file will be set to the current diff --git a/lib/kernel/include/file.hrl b/lib/kernel/include/file.hrl index 3889bce393..ef42987a3d 100644 --- a/lib/kernel/include/file.hrl +++ b/lib/kernel/include/file.hrl @@ -25,10 +25,11 @@ {size :: non_neg_integer(), % Size of file in bytes. type :: 'device' | 'directory' | 'other' | 'regular' | 'symlink', access :: 'read' | 'write' | 'read_write' | 'none', - atime :: file:date_time(), % The local time the file was last read: - % {{Year, Mon, Day}, {Hour, Min, Sec}}. - mtime :: file:date_time(), % The local time the file was last written. - ctime :: file:date_time(), % The interpretation of this time field + atime :: file:date_time() | integer(), % The local time the file was last read: + % {{Year, Mon, Day}, {Hour, Min, Sec}}. + % atime, ctime, mtime may also be unix epochs() + mtime :: file:date_time() | integer(), % The local time the file was last written. + ctime :: file:date_time() | integer(), % The interpretation of this time field % is dependent on operating system. % On Unix it is the last time the file % or the inode was changed. On Windows, diff --git a/lib/kernel/src/file.erl b/lib/kernel/src/file.erl index 7793009bb9..4028dd4f0b 100644 --- a/lib/kernel/src/file.erl +++ b/lib/kernel/src/file.erl @@ -28,9 +28,11 @@ %% File system and metadata. -export([get_cwd/0, get_cwd/1, set_cwd/1, delete/1, rename/2, make_dir/1, del_dir/1, list_dir/1, - read_file_info/1, write_file_info/2, + read_file_info/1, read_file_info/2, + write_file_info/2, write_file_info/3, altname/1, - read_link_info/1, read_link/1, + read_link_info/1, read_link_info/2, + read_link/1, make_link/2, make_symlink/2, read_file/1, write_file/2, write_file/3]). %% Specialized @@ -107,6 +109,10 @@ -type posix_file_advise() :: 'normal' | 'sequential' | 'random' | 'no_reuse' | 'will_need' | 'dont_need'. -type sendfile_option() :: {chunk_size, non_neg_integer()}. +-type file_info_option() :: {'time', 'local'} | {'time', 'universal'} + | {'time', 'posix'}. + + %%%----------------------------------------------------------------- %%% General functions @@ -214,6 +220,15 @@ del_dir(Name) -> read_file_info(Name) -> check_and_call(read_file_info, [file_name(Name)]). +-spec read_file_info(Filename, Opts) -> {ok, FileInfo} | {error, Reason} when + Filename :: name(), + Opts :: [file_info_option()], + FileInfo :: file_info(), + Reason :: posix() | badarg. + +read_file_info(Name, Opts) when is_list(Opts) -> + check_and_call(read_file_info, [file_name(Name), Opts]). + -spec altname(Name :: name()) -> any(). altname(Name) -> @@ -227,6 +242,16 @@ altname(Name) -> read_link_info(Name) -> check_and_call(read_link_info, [file_name(Name)]). +-spec read_link_info(Name, Opts) -> {ok, FileInfo} | {error, Reason} when + Name :: name(), + Opts :: [file_info_option()], + FileInfo :: file_info(), + Reason :: posix() | badarg. + +read_link_info(Name, Opts) when is_list(Opts) -> + check_and_call(read_link_info, [file_name(Name),Opts]). + + -spec read_link(Name) -> {ok, Filename} | {error, Reason} when Name :: name(), Filename :: filename(), @@ -243,6 +268,15 @@ read_link(Name) -> write_file_info(Name, Info = #file_info{}) -> check_and_call(write_file_info, [file_name(Name), Info]). +-spec write_file_info(Filename, FileInfo, Opts) -> ok | {error, Reason} when + Filename :: name(), + Opts :: [file_info_option()], + FileInfo :: file_info(), + Reason :: posix() | badarg. + +write_file_info(Name, Info = #file_info{}, Opts) when is_list(Opts) -> + check_and_call(write_file_info, [file_name(Name), Info, Opts]). + -spec list_dir(Dir) -> {ok, Filenames} | {error, Reason} when Dir :: name(), Filenames :: [filename()], @@ -1129,7 +1163,8 @@ change_time(Name, {{AY, AM, AD}, {AH, AMin, ASec}}=Atime, -define(MAX_CHUNK_SIZE, (1 bsl 20)*20). %% 20 MB, has to fit in primary memory -spec sendfile(RawFile, Socket, Offset, Bytes, Opts) -> - {'ok', non_neg_integer()} | {'error', inet:posix() | badarg | not_owner} when + {'ok', non_neg_integer()} | {'error', inet:posix() | + closed | badarg | not_owner} when RawFile :: file:fd(), Socket :: inet:socket(), Offset :: non_neg_integer(), @@ -1154,7 +1189,8 @@ sendfile(File, Sock, Offset, Bytes, Opts) -> %% sendfile/2 -spec sendfile(Filename, Socket) -> - {'ok', non_neg_integer()} | {'error', inet:posix() | badarg | not_owner} + {'ok', non_neg_integer()} | {'error', inet:posix() | + closed | badarg | not_owner} when Filename :: file:name(), Socket :: inet:socket(). sendfile(Filename, Sock) -> diff --git a/lib/kernel/src/file_server.erl b/lib/kernel/src/file_server.erl index 64c61ba3ac..81f9efcf39 100644 --- a/lib/kernel/src/file_server.erl +++ b/lib/kernel/src/file_server.erl @@ -147,15 +147,24 @@ handle_call({get_cwd, Name}, _From, Handle) -> handle_call({read_file_info, Name}, _From, Handle) -> {reply, ?PRIM_FILE:read_file_info(Handle, Name), Handle}; +handle_call({read_file_info, Name, Opts}, _From, Handle) -> + {reply, ?PRIM_FILE:read_file_info(Handle, Name, Opts), Handle}; + handle_call({altname, Name}, _From, Handle) -> {reply, ?PRIM_FILE:altname(Handle, Name), Handle}; handle_call({write_file_info, Name, Info}, _From, Handle) -> {reply, ?PRIM_FILE:write_file_info(Handle, Name, Info), Handle}; +handle_call({write_file_info, Name, Info, Opts}, _From, Handle) -> + {reply, ?PRIM_FILE:write_file_info(Handle, Name, Info, Opts), Handle}; + handle_call({read_link_info, Name}, _From, Handle) -> {reply, ?PRIM_FILE:read_link_info(Handle, Name), Handle}; +handle_call({read_link_info, Name, Opts}, _From, Handle) -> + {reply, ?PRIM_FILE:read_link_info(Handle, Name, Opts), Handle}; + handle_call({read_link, Name}, _From, Handle) -> {reply, ?PRIM_FILE:read_link(Handle, Name), Handle}; diff --git a/lib/kernel/test/gen_tcp_misc_SUITE.erl b/lib/kernel/test/gen_tcp_misc_SUITE.erl index c1c5ff8b81..3da4b07c05 100644 --- a/lib/kernel/test/gen_tcp_misc_SUITE.erl +++ b/lib/kernel/test/gen_tcp_misc_SUITE.erl @@ -1031,6 +1031,7 @@ busy_send_loop(Server, Client, N) -> {Server,send} -> ?line busy_send_2(Server, Client, N+1) after 10000 -> + %% If this happens, see busy_send_srv ?t:fail({timeout,{server,not_send,flush([])}}) end end. @@ -1050,7 +1051,9 @@ busy_send_2(Server, Client, _N) -> busy_send_srv(L, Master, Msg) -> %% Server - %% + %% Sometimes this accept does not return, do not really know why + %% but is causes the timeout error in busy_send_loop to be + %% triggered. Only happens on OS X Leopard?!? {ok,Socket} = gen_tcp:accept(L), busy_send_srv_loop(Socket, Master, Msg). diff --git a/lib/kernel/test/inet_res_SUITE.erl b/lib/kernel/test/inet_res_SUITE.erl index 15b0ed5718..f3ba28e4f9 100644 --- a/lib/kernel/test/inet_res_SUITE.erl +++ b/lib/kernel/test/inet_res_SUITE.erl @@ -88,7 +88,7 @@ init_per_testcase(Func, Config) -> inet_db:ins_alt_ns(IP, Port); _ -> ok end, - Dog = test_server:timetrap(test_server:seconds(10)), + Dog = test_server:timetrap(test_server:seconds(20)), [{nameserver,NsSpec},{res_lookup,Lookup},{watchdog,Dog}|Config] catch SkipReason -> @@ -303,7 +303,7 @@ basic(Config) when is_list(Config) -> {ok,Msg2} = inet_dns:decode(Bin2), %% %% lookup - [IP] = inet_res:lookup(Name, in, a, [{nameservers,[NS]}]), + [IP] = inet_res:lookup(Name, in, a, [{nameservers,[NS]},verbose]), %% %% gethostbyname {ok,#hostent{h_addr_list=[IP]}} = inet_res:gethostbyname(Name), @@ -410,7 +410,7 @@ edns0(Config) when is_list(Config) -> false = inet_db:res_option(edns), % ASSERT true = inet_db:res_option(udp_payload_size) >= 1280, % ASSERT %% These will fall back to TCP - MXs = lists:sort(inet_res:lookup(Domain, in, mx, [{nameservers,[NS]}])), + MXs = lists:sort(inet_res:lookup(Domain, in, mx, [{nameservers,[NS]},verbose])), %% {ok,#hostent{h_addr_list=As}} = inet_res:getbyname(Domain++".", mx), MXs = lists:sort(As), diff --git a/lib/kernel/test/inet_res_SUITE_data/run-named b/lib/kernel/test/inet_res_SUITE_data/run-named index 39e7b1d5aa..eeca680ab5 100755 --- a/lib/kernel/test/inet_res_SUITE_data/run-named +++ b/lib/kernel/test/inet_res_SUITE_data/run-named @@ -163,7 +163,7 @@ echo "Command: $NAMED $NAMED_FG -c $CONF_FILE" NAMED_PID=$! trap "kill -TERM $NAMED_PID >/dev/null 2>&1; wait $NAMED_PID >/dev/null 2>&1" \ 0 1 2 3 15 -sleep 2 # Give name server time to load its zone files +sleep 5 # Give name server time to load its zone files if [ -f "$EXIT_FILE" ]; then ERROR="`cat "$EXIT_FILE"`" (exit "$ERROR")& error "$NAMED returned $ERROR on start" diff --git a/lib/kernel/test/os_SUITE.erl b/lib/kernel/test/os_SUITE.erl index b08b12c978..ae3410d13f 100644 --- a/lib/kernel/test/os_SUITE.erl +++ b/lib/kernel/test/os_SUITE.erl @@ -117,9 +117,21 @@ space_in_name(Config) when is_list(Config) -> ?line ok = file:change_mode(Echo, 8#777), % Make it executable on Unix. %% Run the echo program. - - ?line comp("", os:cmd("\"" ++ Echo ++ "\"")), - ?line comp("a::b::c", os:cmd("\"" ++ Echo ++ "\" a b c")), + %% Quoting on windows depends on if the full path of the executable + %% contains special characters. Paths when running common_tests always + %% include @, why Windows would always fail if we do not double the + %% quotes (this is the behaviour of cmd.exe, not Erlang's idea). + Quote = case os:type() of + {win32,_} -> + case (Echo -- "&<>()@^|") =:= Echo of + true -> "\""; + false -> "\"\"" + end; + _ -> + "\"" + end, + ?line comp("", os:cmd(Quote ++ Echo ++ Quote)), + ?line comp("a::b::c", os:cmd(Quote ++ Echo ++ Quote ++ " a b c")), ?t:sleep(5), ?line [] = receive_all(), ok. diff --git a/lib/kernel/test/prim_file_SUITE.erl b/lib/kernel/test/prim_file_SUITE.erl index 00eda6292f..ccf26ee034 100644 --- a/lib/kernel/test/prim_file_SUITE.erl +++ b/lib/kernel/test/prim_file_SUITE.erl @@ -32,7 +32,10 @@ file_info_basic_directory_a/1, file_info_basic_directory_b/1, file_info_bad_a/1, file_info_bad_b/1, file_info_times_a/1, file_info_times_b/1, - file_write_file_info_a/1, file_write_file_info_b/1]). + file_write_file_info_a/1, file_write_file_info_b/1, + file_read_file_info_opts/1, file_write_file_info_opts/1, + file_write_read_file_info_opts/1 + ]). -export([rename_a/1, rename_b/1, access/1, truncate/1, datasync/1, sync/1, read_write/1, pread_write/1, append/1, exclusive/1]). @@ -90,7 +93,10 @@ groups() -> file_info_basic_directory_a, file_info_basic_directory_b, file_info_bad_a, file_info_bad_b, file_info_times_a, file_info_times_b, - file_write_file_info_a, file_write_file_info_b]}, + file_write_file_info_a, file_write_file_info_b, + file_read_file_info_opts, file_write_file_info_opts, + file_write_read_file_info_opts + ]}, {errors, [], [e_delete, e_rename, e_make_dir, e_del_dir]}, {compression, [], @@ -1074,6 +1080,104 @@ file_write_file_info(Config, Handle, Suffix) -> ?line test_server:timetrap_cancel(Dog), ok. +%% Test the write_file_info/3 function. + +file_write_file_info_opts(suite) -> []; +file_write_file_info_opts(doc) -> []; +file_write_file_info_opts(Config) when is_list(Config) -> + {ok, Handle} = ?PRIM_FILE:start(), + Dog = test_server:timetrap(test_server:seconds(10)), + RootDir = get_good_directory(Config), + test_server:format("RootDir = ~p", [RootDir]), + + Name = filename:join(RootDir, atom_to_list(?MODULE) ++"_write_file_info_opts"), + ok = ?PRIM_FILE:write_file(Name, "hello_opts"), + + lists:foreach(fun + ({FI, Opts}) -> + ok = ?PRIM_FILE_call(write_file_info, Handle, [Name, FI, Opts]) + end, [ + {#file_info{ mode=8#600, atime = Time, mtime = Time, ctime = Time}, Opts} || + Opts <- [[{time, posix}]], + Time <- [ 0,1,-1,100,-100,1000,-1000,10000,-10000 ] + ]), + + % REM: determine date range dependent on time_t = Uint32 | Sint32 | Sint64 + % Determine time_t on os:type()? + lists:foreach(fun + ({FI, Opts}) -> + ok = ?PRIM_FILE_call(write_file_info, Handle, [Name, FI, Opts]) + end, [ + {#file_info{ mode=8#400, atime = Time, mtime = Time, ctime = Time}, Opts} || + Opts <- [[{time, universal}],[{time, local}]], + Time <- [ + {{1970,1,1},{0,0,0}}, + {{1970,1,1},{0,0,1}}, + {{1969,12,31},{23,59,59}}, + {{1908,2,3},{23,59,59}}, + {{2012,2,3},{23,59,59}}, + {{2037,2,3},{23,59,59}}, + erlang:localtime() + ]]), + ok = ?PRIM_FILE:stop(Handle), + test_server:timetrap_cancel(Dog), + ok. + +file_read_file_info_opts(suite) -> []; +file_read_file_info_opts(doc) -> []; +file_read_file_info_opts(Config) when is_list(Config) -> + {ok, Handle} = ?PRIM_FILE:start(), + Dog = test_server:timetrap(test_server:seconds(10)), + RootDir = get_good_directory(Config), + test_server:format("RootDir = ~p", [RootDir]), + + Name = filename:join(RootDir, atom_to_list(?MODULE) ++"_read_file_info_opts"), + ok = ?PRIM_FILE:write_file(Name, "hello_opts"), + + lists:foreach(fun + (Opts) -> + {ok,_} = ?PRIM_FILE_call(read_file_info, Handle, [Name, Opts]) + end, [[{time, Type}] || Type <- [local, universal, posix]]), + ok = ?PRIM_FILE:stop(Handle), + test_server:timetrap_cancel(Dog), + ok. + +%% Test the write and read back *_file_info/3 functions. + +file_write_read_file_info_opts(suite) -> []; +file_write_read_file_info_opts(doc) -> []; +file_write_read_file_info_opts(Config) when is_list(Config) -> + {ok, Handle} = ?PRIM_FILE:start(), + Dog = test_server:timetrap(test_server:seconds(10)), + RootDir = get_good_directory(Config), + test_server:format("RootDir = ~p", [RootDir]), + + Name = filename:join(RootDir, atom_to_list(?MODULE) ++"_read_write_file_info_opts"), + ok = ?PRIM_FILE:write_file(Name, "hello_opts2"), + + ok = file_write_read_file_info_opts(Handle, Name, {{1989, 04, 28}, {19,30,22}}, [{time, local}]), + ok = file_write_read_file_info_opts(Handle, Name, {{1989, 04, 28}, {19,30,22}}, [{time, universal}]), + ok = file_write_read_file_info_opts(Handle, Name, {{1930, 04, 28}, {19,30,22}}, [{time, local}]), + ok = file_write_read_file_info_opts(Handle, Name, {{1930, 04, 28}, {19,30,22}}, [{time, universal}]), + ok = file_write_read_file_info_opts(Handle, Name, 1, [{time, posix}]), + ok = file_write_read_file_info_opts(Handle, Name, -1, [{time, posix}]), + ok = file_write_read_file_info_opts(Handle, Name, 300000, [{time, posix}]), + ok = file_write_read_file_info_opts(Handle, Name, -300000, [{time, posix}]), + ok = file_write_read_file_info_opts(Handle, Name, 0, [{time, posix}]), + + ok = ?PRIM_FILE:stop(Handle), + test_server:timetrap_cancel(Dog), + ok. + +file_write_read_file_info_opts(Handle, Name, Mtime, Opts) -> + {ok, FI} = ?PRIM_FILE_call(read_file_info, Handle, [Name, Opts]), + FI2 = FI#file_info{ mtime = Mtime }, + ok = ?PRIM_FILE_call(write_file_info, Handle, [Name, FI2, Opts]), + {ok, FI2} = ?PRIM_FILE_call(read_file_info, Handle, [Name, Opts]), + ok. + + + %% Returns a directory on a file system that has correct file times. get_good_directory(Config) -> diff --git a/lib/kernel/test/sendfile_SUITE.erl b/lib/kernel/test/sendfile_SUITE.erl index 04af16a6b9..6d0848ee05 100644 --- a/lib/kernel/test/sendfile_SUITE.erl +++ b/lib/kernel/test/sendfile_SUITE.erl @@ -33,6 +33,8 @@ all() -> ,t_sendfile_recvafter ,t_sendfile_sendduring ,t_sendfile_recvduring + ,t_sendfile_closeduring + ,t_sendfile_crashduring ]. init_per_suite(Config) -> @@ -99,7 +101,7 @@ t_sendfile_big(Config) when is_list(Config) -> Size end, - ok = sendfile_send("localhost", Send, 0). + ok = sendfile_send({127,0,0,1}, Send, 0). t_sendfile_partial(Config) -> Filename = proplists:get_value(small_file, Config), @@ -185,14 +187,14 @@ t_sendfile_sendduring(Config) -> {ok, #file_info{size = Size}} = file:read_file_info(Filename), spawn_link(fun() -> - timer:sleep(10), + timer:sleep(50), ok = gen_tcp:send(Sock, <<2>>) end), {ok, Size} = file:sendfile(Filename, Sock), Size+1 end, - ok = sendfile_send("localhost", Send, 0). + ok = sendfile_send({127,0,0,1}, Send, 0). t_sendfile_recvduring(Config) -> Filename = proplists:get_value(big_file, Config), @@ -201,7 +203,7 @@ t_sendfile_recvduring(Config) -> {ok, #file_info{size = Size}} = file:read_file_info(Filename), spawn_link(fun() -> - timer:sleep(10), + timer:sleep(50), ok = gen_tcp:send(Sock, <<1>>), {ok,<<1>>} = gen_tcp:recv(Sock, 1) end), @@ -210,21 +212,83 @@ t_sendfile_recvduring(Config) -> Size+1 end, - ok = sendfile_send("localhost", Send, 0). + ok = sendfile_send({127,0,0,1}, Send, 0). -%% TODO: consolidate tests and reduce code +t_sendfile_closeduring(Config) -> + Filename = proplists:get_value(big_file, Config), + + Send = fun(Sock,SFServPid) -> + spawn_link(fun() -> + timer:sleep(50), + SFServPid ! stop + end), + case erlang:system_info(thread_pool_size) of + 0 -> + {error, closed} = file:sendfile(Filename, Sock); + _Else -> + %% This can return how much has been sent or + %% {error,closed} depending on OS. + %% How much is sent impossible to know as + %% the socket was closed mid sendfile + case file:sendfile(Filename, Sock) of + {error, closed} -> + ok; + {ok, Size} when is_integer(Size) -> + ok + end + end, + -1 + end, + + ok = sendfile_send({127,0,0,1}, Send, 0). + +t_sendfile_crashduring(Config) -> + Filename = proplists:get_value(big_file, Config), + + error_logger:add_report_handler(?MODULE,[self()]), + + Send = fun(Sock) -> + spawn_link(fun() -> + timer:sleep(50), + exit(die) + end), + {error, closed} = file:sendfile(Filename, Sock), + -1 + end, + process_flag(trap_exit,true), + spawn_link(fun() -> + ok = sendfile_send({127,0,0,1}, Send, 0) + end), + receive + {stolen,Reason} -> + process_flag(trap_exit,false), + ct:fail(Reason) + after 200 -> + receive + {'EXIT',_,Reason} -> + process_flag(trap_exit,false), + die = Reason + end + end. + +%% Generic sendfile server code sendfile_send(Send) -> - sendfile_send("localhost",Send). + sendfile_send({127,0,0,1},Send). sendfile_send(Host, Send) -> sendfile_send(Host, Send, []). sendfile_send(Host, Send, Orig) -> - spawn_link(?MODULE, sendfile_server, [self(), Orig]), + SFServer = spawn_link(?MODULE, sendfile_server, [self(), Orig]), receive {server, Port} -> {ok, Sock} = gen_tcp:connect(Host, Port, [binary,{packet,0}, {active,false}]), - Data = Send(Sock), + Data = case proplists:get_value(arity,erlang:fun_info(Send)) of + 1 -> + Send(Sock); + 2 -> + Send(Sock, SFServer) + end, ok = gen_tcp:close(Sock), receive {ok, Bin} -> @@ -245,9 +309,11 @@ sendfile_server(ClientPid, Orig) -> gen_tcp:send(Sock, <<1>>). -define(SENDFILE_TIMEOUT, 10000). -%% f(),{ok, S} = gen_tcp:connect("localhost",7890,[binary]),file:sendfile("/ldisk/lukas/otp/sendfiletest.dat",S). sendfile_do_recv(Sock, Bs) -> receive + stop when Bs /= 0,is_integer(Bs) -> + gen_tcp:close(Sock), + {ok, -1}; {tcp, Sock, B} -> case binary:match(B,<<1>>) of nomatch when is_list(Bs) -> @@ -276,3 +342,14 @@ sendfile_file_info(File) -> {ok, #file_info{size = Size}} = file:read_file_info(File), {ok, Data} = file:read_file(File), {Size, Data}. + + +%% Error handler + +init([Proc]) -> {ok,Proc}. + +handle_event({error,noproc,{emulator,Format,Args}}, Proc) -> + Proc ! {stolen,lists:flatten(io_lib:format(Format,Args))}, + {ok,Proc}; +handle_event(_, Proc) -> + {ok,Proc}. diff --git a/lib/runtime_tools/c_src/trace_file_drv.c b/lib/runtime_tools/c_src/trace_file_drv.c index 668f6f4af3..5de2a65917 100644 --- a/lib/runtime_tools/c_src/trace_file_drv.c +++ b/lib/runtime_tools/c_src/trace_file_drv.c @@ -21,6 +21,9 @@ * Purpose: Send trace messages to a file. */ +#ifdef __WIN32__ +#include <windows.h> +#endif #ifdef HAVE_CONFIG_H # include "config.h" #endif @@ -31,7 +34,6 @@ #ifdef __WIN32__ # include <io.h> # define write _write -# define open _open # define close _close # define unlink _unlink #else @@ -40,11 +42,6 @@ #include <errno.h> #include <sys/types.h> #include <fcntl.h> -#ifdef VXWORKS -# include "reclaim.h" -#endif - - /* * Deduce MAXPATHLEN, which is the one to use in this file, @@ -194,6 +191,12 @@ static int my_flush(TraceFileData *data); static void put_be(unsigned n, unsigned char *s); static void close_unlink_port(TraceFileData *data); static int wrap_file(TraceFileData *data); +#ifdef __WIN32__ +static int win_open(char *path, int flags, int mask); +#define open win_open +#else +ErlDrvEntry *driver_init(void); +#endif /* ** The driver struct @@ -241,6 +244,7 @@ static ErlDrvData trace_file_start(ErlDrvPort port, char *buff) int n, w; static const char name[] = "trace_file_drv"; + #ifdef HARDDEBUG fprintf(stderr,"hello (%s)\r\n", buff); #endif @@ -353,11 +357,11 @@ static void trace_file_output(ErlDrvData handle, char *buff, int bufflen) TraceFileData *data = (TraceFileData *) handle; unsigned char b[5] = ""; put_be((unsigned) bufflen, b + 1); - switch (my_write(data, b, sizeof(b))) { + switch (my_write(data, (unsigned char *) b, sizeof(b))) { case 1: heavy = !0; case 0: - switch (my_write(data, buff, bufflen)) { + switch (my_write(data, (unsigned char *) buff, bufflen)) { case 1: heavy = !0; case 0: @@ -636,3 +640,40 @@ static int wrap_file(TraceFileData *data) { return 0; } +#ifdef __WIN32__ +static int win_open(char *path, int flags, int mask) +{ + DWORD access = 0; + DWORD creation = 0; + HANDLE fd; + int ret; + if (flags & O_WRONLY) { + access = GENERIC_WRITE; + } else if (flags & O_RDONLY) { + access = GENERIC_READ; + } else { + access = (GENERIC_READ | GENERIC_WRITE); + } + + if (flags & O_CREAT) { + creation |= CREATE_ALWAYS; + } else { + creation |= OPEN_ALWAYS; + } + + fd = CreateFileA(path, access, + FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE, + NULL, creation, FILE_ATTRIBUTE_NORMAL, NULL); + if (fd == INVALID_HANDLE_VALUE) { + + return -1; + } + + if ((ret = _open_osfhandle((intptr_t)fd, (flags & O_RDONLY) ? O_RDONLY : 0)) + < 0) { + CloseHandle(fd); + } + + return ret; +} +#endif diff --git a/lib/runtime_tools/src/erts_alloc_config.erl b/lib/runtime_tools/src/erts_alloc_config.erl index 1a57c94443..6c11fe8581 100644 --- a/lib/runtime_tools/src/erts_alloc_config.erl +++ b/lib/runtime_tools/src/erts_alloc_config.erl @@ -472,7 +472,7 @@ au_conf_alloc(#conf{format_to = FTO} = Conf, _ -> fc(FTO, "~p instances used.", [Insts]), - format(FTO, " +M~ct ~p~n", [alloc_char(A), Insts]) + format(FTO, " +M~ct true~n", [alloc_char(A)]) end, mmbcs(Conf, Alc), smbcs_lmbcs_mmmbc(Conf, Alc), diff --git a/lib/ssh/src/ssh.appup.src b/lib/ssh/src/ssh.appup.src index 150b7d86dd..21a0582c06 100644 --- a/lib/ssh/src/ssh.appup.src +++ b/lib/ssh/src/ssh.appup.src @@ -18,7 +18,9 @@ %% {"%VSN%", - [ + [ + {"2.0.8", [{load_module, ssh_sftpd_file_api, soft_purge, soft_purge, []}, + {load_module, ssh_channel, soft_purge, soft_purge, []}]}, {"2.0.7", [{load_module, ssh_sftp, soft_purge, soft_purge, []}]}, {"2.0.6", [{load_module, ssh_userreg, soft_purge, soft_purge, []}, {load_module, ssh_sftp, soft_purge, soft_purge, []}]}, @@ -27,6 +29,8 @@ {load_module, ssh_connection_handler, soft_purge, soft_purge, [ssh_userreg]}]} ], [ + {"2.0.8", [{load_module, ssh_sftpd_file_api, soft_purge, soft_purge, []}, + {load_module, ssh_channel, soft_purge, soft_purge, []}]}, {"2.0.7", [{load_module, ssh_sftp, soft_purge, soft_purge, []}]}, {"2.0.6", [{load_module, ssh_userreg, soft_purge, soft_purge, []}, {load_module, ssh_sftp, soft_purge, soft_purge, []}]}, diff --git a/lib/ssh/src/ssh_channel.erl b/lib/ssh/src/ssh_channel.erl index dcb2d69290..7b600ed8b2 100644 --- a/lib/ssh/src/ssh_channel.erl +++ b/lib/ssh/src/ssh_channel.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2010. All Rights Reserved. +%% Copyright Ericsson AB 2008-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -23,10 +23,23 @@ -include("ssh_connect.hrl"). +%%% Optional callbacks handle_call/3, handle_cast/2, handle_msg/2, +%%% code_change/3 +%% Should be further specified later +-callback init(Options::list()) -> + {ok, State::term()} | {ok, State::term(), Timeout::timeout()} | + {stop, Reason ::term()}. + +-callback terminate(term(), term()) -> term(). + +-callback handle_ssh_msg({ssh_cm, ConnectionRef::term(), SshMsg::term()}, + State::term()) -> {ok, State::term()} | + {stop, ChannelId::integer(), + State::term()}. -behaviour(gen_server). %%% API --export([behaviour_info/1, start/4, start/5, start_link/4, start_link/5, call/2, call/3, +-export([start/4, start/5, start_link/4, start_link/5, call/2, call/3, cast/2, reply/2, enter_loop/1]). %% gen_server callbacks @@ -50,17 +63,6 @@ %% API %%==================================================================== -%%% Optionel callbacks handle_call/3, handle_cast/2, handle_msg/2, -%%% code_change/3 -behaviour_info(callbacks) -> - [ - {init, 1}, - {terminate, 2}, - {handle_ssh_msg, 2}, - {handle_msg, 2} - ]. - - call(ChannelPid, Msg) -> call(ChannelPid, Msg, infinity). diff --git a/lib/ssh/src/ssh_sftpd_file_api.erl b/lib/ssh/src/ssh_sftpd_file_api.erl index 176aa98194..38371f809d 100644 --- a/lib/ssh/src/ssh_sftpd_file_api.erl +++ b/lib/ssh/src/ssh_sftpd_file_api.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2010. All Rights Reserved. +%% Copyright Ericsson AB 2007-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -21,27 +21,41 @@ -module(ssh_sftpd_file_api). --export([behaviour_info/1]). +%% To be further specified later +-callback close(IoDevice::term(), State::term()) -> + ok | {error, Reason::term()}. +-callback delete(Path::term(), State::term()) -> + ok | {error, Reason::term()}. +-callback del_dir(Path::term(), State::term()) -> + ok | {error, Reason::term()}. +-callback get_cwd(State::term()) -> + {ok, Dir::term()} | {error, Reason::term()}. +-callback is_dir(AbsPath::term(), State::term()) -> + boolean(). +-callback list_dir(AbsPath::term(), State::term()) -> + {ok, Filenames::term()} | {error, Reason::term()}. +-callback make_dir(Dir::term(), State::term()) -> + ok | {error, Reason::term()}. +-callback make_symlink(Path2::term(), Path::term(), State::term()) -> + ok | {error, Reason::term()}. +-callback open(Path::term(), Flags::term(), State::term()) -> + {ok, IoDevice::term()} | {error, Reason::term()}. +-callback position(IoDevice::term(), Offs::term(), State::term()) -> + {ok, NewPosition::term()} | {error, Reason::term()}. +-callback read(IoDevice::term(), Len::term(), State::term()) -> + {ok, Data::term()} | eof | {error, Reason::term()}. +-callback read_link(Path::term(), State::term()) -> + {ok, FileName::term()} | {error, Reason::term()}. +-callback read_link_info(Path::term(), State::term()) -> + {ok, FileInfo::term()} | {error, Reason::term()}. +-callback read_file_info(Path::term(), State::term()) -> + {ok, FileInfo::term()} | {error, Reason::term()}. +-callback rename(Path::term(), Path2::term(), State::term()) -> + ok | {error, Reason::term()}. +-callback write(IoDevice::term(), Data::term(), State::term()) -> + ok | {error, Reason::term()}. +-callback write_file_info(Path::term(),Info::term(), State::term()) -> + ok | {error, Reason::term()}. + + -behaviour_info(callbacks) -> - [ - {close, 2}, - {delete, 2}, - {del_dir, 2}, - {get_cwd, 1}, - {is_dir, 2}, - {list_dir, 2}, - {make_dir, 2}, - {make_symlink, 3}, - {open, 3}, - {position, 3}, - {read, 3}, - {read_file_info, 2}, - {read_link, 2}, - {read_link_info, 2}, - {rename, 3}, - {write, 3}, - {write_file_info, 3} - ]; -behaviour_info(_) -> - undefined. diff --git a/lib/ssh/vsn.mk b/lib/ssh/vsn.mk index fe2b915d17..42f860d6ae 100644 --- a/lib/ssh/vsn.mk +++ b/lib/ssh/vsn.mk @@ -1,5 +1,5 @@ #-*-makefile-*- ; force emacs to enter makefile-mode -SSH_VSN = 2.0.8 +SSH_VSN = 2.0.9 APP_VSN = "ssh-$(SSH_VSN)" diff --git a/lib/stdlib/test/supervisor_SUITE.erl b/lib/stdlib/test/supervisor_SUITE.erl index d3d140abbc..fa6faa66f2 100644 --- a/lib/stdlib/test/supervisor_SUITE.erl +++ b/lib/stdlib/test/supervisor_SUITE.erl @@ -158,29 +158,23 @@ get_child_counts(Supervisor) -> %%------------------------------------------------------------------------- %% Test cases starts here. -%%------------------------------------------------------------------------- -sup_start_normal(doc) -> - ["Tests that the supervisor process starts correctly and that it " - "can be terminated gracefully."]; -sup_start_normal(suite) -> []; +%% ------------------------------------------------------------------------- +%% Tests that the supervisor process starts correctly and that it can +%% be terminated gracefully. sup_start_normal(Config) when is_list(Config) -> process_flag(trap_exit, true), {ok, Pid} = start_link({ok, {{one_for_one, 2, 3600}, []}}), terminate(Pid, shutdown). %%------------------------------------------------------------------------- -sup_start_ignore_init(doc) -> - ["Tests what happens if init-callback returns ignore"]; -sup_start_ignore_init(suite) -> []; +%% Tests what happens if init-callback returns ignore. sup_start_ignore_init(Config) when is_list(Config) -> process_flag(trap_exit, true), ignore = start_link(ignore), check_exit_reason(normal). %%------------------------------------------------------------------------- -sup_start_ignore_child(doc) -> - ["Tests what happens if init-callback returns ignore"]; -sup_start_ignore_child(suite) -> []; +%% Tests what happens if init-callback returns ignore. sup_start_ignore_child(Config) when is_list(Config) -> process_flag(trap_exit, true), {ok, _Pid} = start_link({ok, {{one_for_one, 2, 3600}, []}}), @@ -197,30 +191,22 @@ sup_start_ignore_child(Config) when is_list(Config) -> [2,1,0,2] = get_child_counts(sup_test). %%------------------------------------------------------------------------- -sup_start_error_return(doc) -> - ["Tests what happens if init-callback returns a invalid value"]; -sup_start_error_return(suite) -> []; +%% Tests what happens if init-callback returns a invalid value. sup_start_error_return(Config) when is_list(Config) -> process_flag(trap_exit, true), {error, Term} = start_link(invalid), check_exit_reason(Term). %%------------------------------------------------------------------------- -sup_start_fail(doc) -> - ["Tests what happens if init-callback fails"]; -sup_start_fail(suite) -> []; +%% Tests what happens if init-callback fails. sup_start_fail(Config) when is_list(Config) -> process_flag(trap_exit, true), {error, Term} = start_link(fail), check_exit_reason(Term). %%------------------------------------------------------------------------- - -sup_stop_infinity(doc) -> - ["See sup_stop/1 when Shutdown = infinity, this walue is allowed " - "for children of type supervisor _AND_ worker"]; -sup_stop_infinity(suite) -> []; - +%% See sup_stop/1 when Shutdown = infinity, this walue is allowed for +%% children of type supervisor _AND_ worker. sup_stop_infinity(Config) when is_list(Config) -> process_flag(trap_exit, true), {ok, Pid} = start_link({ok, {{one_for_one, 2, 3600}, []}}), @@ -238,11 +224,7 @@ sup_stop_infinity(Config) when is_list(Config) -> check_exit_reason(CPid2, shutdown). %%------------------------------------------------------------------------- - -sup_stop_timeout(doc) -> - ["See sup_stop/1 when Shutdown = 1000"]; -sup_stop_timeout(suite) -> []; - +%% See sup_stop/1 when Shutdown = 1000 sup_stop_timeout(Config) when is_list(Config) -> process_flag(trap_exit, true), {ok, Pid} = start_link({ok, {{one_for_one, 2, 3600}, []}}), @@ -264,10 +246,7 @@ sup_stop_timeout(Config) when is_list(Config) -> %%------------------------------------------------------------------------- -sup_stop_brutal_kill(doc) -> - ["See sup_stop/1 when Shutdown = brutal_kill"]; -sup_stop_brutal_kill(suite) -> []; - +%% See sup_stop/1 when Shutdown = brutal_kill sup_stop_brutal_kill(Config) when is_list(Config) -> process_flag(trap_exit, true), {ok, Pid} = start_link({ok, {{one_for_one, 2, 3600}, []}}), @@ -286,14 +265,10 @@ sup_stop_brutal_kill(Config) when is_list(Config) -> check_exit_reason(CPid2, killed). %%------------------------------------------------------------------------- -extra_return(doc) -> - ["The start function provided to start a child may " - "return {ok, Pid} or {ok, Pid, Info}, if it returns " - "the later check that the supervisor ignores the Info, " - "and includes it unchanged in return from start_child/2 " - "and restart_child/2"]; -extra_return(suite) -> []; - +%% The start function provided to start a child may return {ok, Pid} +%% or {ok, Pid, Info}, if it returns the latter check that the +%% supervisor ignores the Info, and includes it unchanged in return +%% from start_child/2 and restart_child/2. extra_return(Config) when is_list(Config) -> process_flag(trap_exit, true), Child = {child1, {supervisor_1, start_child, [extra_return]}, @@ -333,12 +308,10 @@ extra_return(Config) when is_list(Config) -> ok. %%------------------------------------------------------------------------- -child_adm(doc)-> - ["Test API functions start_child/2, terminate_child/2, delete_child/2 " - "restart_child/2, which_children/1, count_children/1. Only correct " - "childspecs are used, handling of incorrect childspecs is tested in " - "child_specs/1"]; -child_adm(suite) -> []; +%% Test API functions start_child/2, terminate_child/2, delete_child/2 +%% restart_child/2, which_children/1, count_children/1. Only correct +%% childspecs are used, handling of incorrect childspecs is tested in +%% child_specs/1. child_adm(Config) when is_list(Config) -> process_flag(trap_exit, true), Child = {child1, {supervisor_1, start_child, []}, permanent, 1000, @@ -402,11 +375,9 @@ child_adm(Config) when is_list(Config) -> = (catch supervisor:count_children(foo)), ok. %%------------------------------------------------------------------------- -child_adm_simple(doc) -> - ["The API functions terminate_child/2, delete_child/2 " - "restart_child/2 are not valid for a simple_one_for_one supervisor " - "check that the correct error message is returned."]; -child_adm_simple(suite) -> []; +%% The API functions terminate_child/2, delete_child/2 restart_child/2 +%% are not valid for a simple_one_for_one supervisor check that the +%% correct error message is returned. child_adm_simple(Config) when is_list(Config) -> Child = {child, {supervisor_1, start_child, []}, permanent, 1000, worker, []}, @@ -454,9 +425,7 @@ child_adm_simple(Config) when is_list(Config) -> ok. %%------------------------------------------------------------------------- -child_specs(doc) -> - ["Tests child specs, invalid formats should be rejected."]; -child_specs(suite) -> []; +%% Tests child specs, invalid formats should be rejected. child_specs(Config) when is_list(Config) -> process_flag(trap_exit, true), {ok, _Pid} = start_link({ok, {{one_for_one, 2, 3600}, []}}), @@ -507,9 +476,7 @@ child_specs(Config) when is_list(Config) -> ok. %%------------------------------------------------------------------------- -permanent_normal(doc) -> - ["A permanent child should always be restarted"]; -permanent_normal(suite) -> []; +%% A permanent child should always be restarted. permanent_normal(Config) when is_list(Config) -> {ok, SupPid} = start_link({ok, {{one_for_one, 2, 3600}, []}}), Child1 = {child1, {supervisor_1, start_child, []}, permanent, 1000, @@ -529,10 +496,8 @@ permanent_normal(Config) when is_list(Config) -> [1,1,0,1] = get_child_counts(sup_test). %%------------------------------------------------------------------------- -transient_normal(doc) -> - ["A transient child should not be restarted if it exits with " - "reason normal"]; -transient_normal(suite) -> []; +%% A transient child should not be restarted if it exits with reason +%% normal. transient_normal(Config) when is_list(Config) -> {ok, SupPid} = start_link({ok, {{one_for_one, 2, 3600}, []}}), Child1 = {child1, {supervisor_1, start_child, []}, transient, 1000, @@ -546,9 +511,7 @@ transient_normal(Config) when is_list(Config) -> [1,0,0,1] = get_child_counts(sup_test). %%------------------------------------------------------------------------- -temporary_normal(doc) -> - ["A temporary process should never be restarted"]; -temporary_normal(suite) -> []; +%% A temporary process should never be restarted. temporary_normal(Config) when is_list(Config) -> {ok, SupPid} = start_link({ok, {{one_for_one, 2, 3600}, []}}), Child1 = {child1, {supervisor_1, start_child, []}, temporary, 1000, @@ -562,9 +525,7 @@ temporary_normal(Config) when is_list(Config) -> [0,0,0,0] = get_child_counts(sup_test). %%------------------------------------------------------------------------- -permanent_shutdown(doc) -> - ["A permanent child should always be restarted"]; -permanent_shutdown(suite) -> []; +%% A permanent child should always be restarted. permanent_shutdown(Config) when is_list(Config) -> {ok, SupPid} = start_link({ok, {{one_for_one, 2, 3600}, []}}), Child1 = {child1, {supervisor_1, start_child, []}, permanent, 1000, @@ -596,10 +557,8 @@ permanent_shutdown(Config) when is_list(Config) -> [1,1,0,1] = get_child_counts(sup_test). %%------------------------------------------------------------------------- -transient_shutdown(doc) -> - ["A transient child should not be restarted if it exits with " - "reason shutdown or {shutdown,Term}"]; -transient_shutdown(suite) -> []; +%% A transient child should not be restarted if it exits with reason +%% shutdown or {shutdown,Term}. transient_shutdown(Config) when is_list(Config) -> {ok, SupPid} = start_link({ok, {{one_for_one, 2, 3600}, []}}), Child1 = {child1, {supervisor_1, start_child, []}, transient, 1000, @@ -620,9 +579,7 @@ transient_shutdown(Config) when is_list(Config) -> [1,0,0,1] = get_child_counts(sup_test). %%------------------------------------------------------------------------- -temporary_shutdown(doc) -> - ["A temporary process should never be restarted"]; -temporary_shutdown(suite) -> []; +%% A temporary process should never be restarted. temporary_shutdown(Config) when is_list(Config) -> {ok, SupPid} = start_link({ok, {{one_for_one, 2, 3600}, []}}), Child1 = {child1, {supervisor_1, start_child, []}, temporary, 1000, @@ -643,9 +600,7 @@ temporary_shutdown(Config) when is_list(Config) -> [0,0,0,0] = get_child_counts(sup_test). %%------------------------------------------------------------------------- -permanent_abnormal(doc) -> - ["A permanent child should always be restarted"]; -permanent_abnormal(suite) -> []; +%% A permanent child should always be restarted. permanent_abnormal(Config) when is_list(Config) -> {ok, SupPid} = start_link({ok, {{one_for_one, 2, 3600}, []}}), Child1 = {child1, {supervisor_1, start_child, []}, permanent, 1000, @@ -664,10 +619,7 @@ permanent_abnormal(Config) when is_list(Config) -> [1,1,0,1] = get_child_counts(sup_test). %%------------------------------------------------------------------------- -transient_abnormal(doc) -> - ["A transient child should be restarted if it exits with " - "reason abnormal"]; -transient_abnormal(suite) -> []; +%% A transient child should be restarted if it exits with reason abnormal. transient_abnormal(Config) when is_list(Config) -> {ok, SupPid} = start_link({ok, {{one_for_one, 2, 3600}, []}}), Child1 = {child1, {supervisor_1, start_child, []}, transient, 1000, @@ -686,9 +638,7 @@ transient_abnormal(Config) when is_list(Config) -> [1,1,0,1] = get_child_counts(sup_test). %%------------------------------------------------------------------------- -temporary_abnormal(doc) -> - ["A temporary process should never be restarted"]; -temporary_abnormal(suite) -> []; +%% A temporary process should never be restarted. temporary_abnormal(Config) when is_list(Config) -> {ok, SupPid} = start_link({ok, {{one_for_one, 2, 3600}, []}}), Child1 = {child1, {supervisor_1, start_child, []}, temporary, 1000, @@ -701,11 +651,9 @@ temporary_abnormal(Config) when is_list(Config) -> [0,0,0,0] = get_child_counts(sup_test). %%------------------------------------------------------------------------- -temporary_bystander(doc) -> - ["A temporary process killed as part of a rest_for_one or one_for_all " - "restart strategy should not be restarted given its args are not " - " saved. Otherwise the supervisor hits its limit and crashes."]; -temporary_bystander(suite) -> []; +%% A temporary process killed as part of a rest_for_one or one_for_all +%% restart strategy should not be restarted given its args are not +%% saved. Otherwise the supervisor hits its limit and crashes. temporary_bystander(_Config) -> Child1 = {child1, {supervisor_1, start_child, []}, permanent, 100, worker, []}, @@ -732,9 +680,7 @@ temporary_bystander(_Config) -> [{child1, _, _, _}] = supervisor:which_children(SupPid2). %%------------------------------------------------------------------------- -one_for_one(doc) -> - ["Test the one_for_one base case."]; -one_for_one(suite) -> []; +%% Test the one_for_one base case. one_for_one(Config) when is_list(Config) -> process_flag(trap_exit, true), Child1 = {child1, {supervisor_1, start_child, []}, permanent, 1000, @@ -764,9 +710,7 @@ one_for_one(Config) when is_list(Config) -> check_exit([SupPid]). %%------------------------------------------------------------------------- -one_for_one_escalation(doc) -> - ["Test restart escalation on a one_for_one supervisor."]; -one_for_one_escalation(suite) -> []; +%% Test restart escalation on a one_for_one supervisor. one_for_one_escalation(Config) when is_list(Config) -> process_flag(trap_exit, true), @@ -786,9 +730,7 @@ one_for_one_escalation(Config) when is_list(Config) -> %%------------------------------------------------------------------------- -one_for_all(doc) -> - ["Test the one_for_all base case."]; -one_for_all(suite) -> []; +%% Test the one_for_all base case. one_for_all(Config) when is_list(Config) -> process_flag(trap_exit, true), @@ -824,9 +766,7 @@ one_for_all(Config) when is_list(Config) -> %%------------------------------------------------------------------------- -one_for_all_escalation(doc) -> - ["Test restart escalation on a one_for_all supervisor."]; -one_for_all_escalation(suite) -> []; +%% Test restart escalation on a one_for_all supervisor. one_for_all_escalation(Config) when is_list(Config) -> process_flag(trap_exit, true), @@ -845,9 +785,7 @@ one_for_all_escalation(Config) when is_list(Config) -> %%------------------------------------------------------------------------- -simple_one_for_one(doc) -> - ["Test the simple_one_for_one base case."]; -simple_one_for_one(suite) -> []; +%% Test the simple_one_for_one base case. simple_one_for_one(Config) when is_list(Config) -> process_flag(trap_exit, true), Child = {child, {supervisor_1, start_child, []}, permanent, 1000, @@ -878,10 +816,8 @@ simple_one_for_one(Config) when is_list(Config) -> %%------------------------------------------------------------------------- -simple_one_for_one_shutdown(doc) -> - ["Test simple_one_for_one children shutdown accordingly to the " - "supervisor's shutdown strategy."]; -simple_one_for_one_shutdown(suite) -> []; +%% Test simple_one_for_one children shutdown accordingly to the +%% supervisor's shutdown strategy. simple_one_for_one_shutdown(Config) when is_list(Config) -> process_flag(trap_exit, true), ShutdownTime = 1000, @@ -909,10 +845,8 @@ simple_one_for_one_shutdown(Config) when is_list(Config) -> %%------------------------------------------------------------------------- -simple_one_for_one_extra(doc) -> - ["Tests automatic restart of children " - "who's start function return extra info."]; -simple_one_for_one_extra(suite) -> []; +%% Tests automatic restart of children who's start function return +%% extra info. simple_one_for_one_extra(Config) when is_list(Config) -> process_flag(trap_exit, true), Child = {child, {supervisor_1, start_child, [extra_info]}, @@ -937,9 +871,7 @@ simple_one_for_one_extra(Config) when is_list(Config) -> check_exit([SupPid]). %%------------------------------------------------------------------------- -simple_one_for_one_escalation(doc) -> - ["Test restart escalation on a simple_one_for_one supervisor."]; -simple_one_for_one_escalation(suite) -> []; +%% Test restart escalation on a simple_one_for_one supervisor. simple_one_for_one_escalation(Config) when is_list(Config) -> process_flag(trap_exit, true), Child = {child, {supervisor_1, start_child, []}, permanent, 1000, @@ -954,9 +886,7 @@ simple_one_for_one_escalation(Config) when is_list(Config) -> check_exit([SupPid, CPid2]). %%------------------------------------------------------------------------- -rest_for_one(doc) -> - ["Test the rest_for_one base case."]; -rest_for_one(suite) -> []; +%% Test the rest_for_one base case. rest_for_one(Config) when is_list(Config) -> process_flag(trap_exit, true), Child1 = {child1, {supervisor_1, start_child, []}, permanent, 1000, @@ -1004,9 +934,7 @@ rest_for_one(Config) when is_list(Config) -> check_exit([SupPid]). %%------------------------------------------------------------------------- -rest_for_one_escalation(doc) -> - ["Test restart escalation on a rest_for_one supervisor."]; -rest_for_one_escalation(suite) -> []; +%% Test restart escalation on a rest_for_one supervisor. rest_for_one_escalation(Config) when is_list(Config) -> process_flag(trap_exit, true), Child1 = {child1, {supervisor_1, start_child, []}, permanent, 1000, @@ -1023,11 +951,8 @@ rest_for_one_escalation(Config) when is_list(Config) -> check_exit([CPid2, SupPid]). %%------------------------------------------------------------------------- -child_unlink(doc)-> - ["Test that the supervisor does not hang forever if " - "the child unliks and then is terminated by the supervisor."]; -child_unlink(suite) -> - []; +%% Test that the supervisor does not hang forever if the child unliks +%% and then is terminated by the supervisor. child_unlink(Config) when is_list(Config) -> {ok, SupPid} = start_link({ok, {{one_for_one, 2, 3600}, []}}), @@ -1052,10 +977,7 @@ child_unlink(Config) when is_list(Config) -> test_server:fail(supervisor_hangs) end. %%------------------------------------------------------------------------- -tree(doc) -> - ["Test a basic supervison tree."]; -tree(suite) -> - []; +%% Test a basic supervison tree. tree(Config) when is_list(Config) -> process_flag(trap_exit, true), @@ -1131,11 +1053,9 @@ tree(Config) when is_list(Config) -> [] = supervisor:which_children(NewSup2), [0,0,0,0] = get_child_counts(NewSup2). + %%------------------------------------------------------------------------- -count_children_memory(doc) -> - ["Test that count_children does not eat memory."]; -count_children_memory(suite) -> - []; +%% Test that count_children does not eat memory. count_children_memory(Config) when is_list(Config) -> process_flag(trap_exit, true), Child = {child, {supervisor_1, start_child, []}, temporary, 1000, @@ -1177,12 +1097,12 @@ count_children_memory(Config) when is_list(Config) -> case (Size5 =< Size4) of true -> ok; false -> - test_server:fail({count_children, used_more_memory}) + test_server:fail({count_children, used_more_memory,Size4,Size5}) end, case Size7 =< Size6 of true -> ok; false -> - test_server:fail({count_children, used_more_memory}) + test_server:fail({count_children, used_more_memory,Size6,Size7}) end, [terminate(SupPid, Pid, child, kill) || {undefined, Pid, worker, _Modules} <- Children3], @@ -1193,12 +1113,9 @@ proc_memory() -> erlang:memory(processes_used). %%------------------------------------------------------------------------- -do_not_save_start_parameters_for_temporary_children(doc) -> - ["Temporary children shall not be restarted so they should not " - "save start parameters, as it potentially can " - "take up a huge amount of memory for no purpose."]; -do_not_save_start_parameters_for_temporary_children(suite) -> - []; +%% Temporary children shall not be restarted so they should not save +%% start parameters, as it potentially can take up a huge amount of +%% memory for no purpose. do_not_save_start_parameters_for_temporary_children(Config) when is_list(Config) -> process_flag(trap_exit, true), dont_save_start_parameters_for_temporary_children(one_for_all), @@ -1220,11 +1137,8 @@ child_spec({Name, MFA, RestartType, Shutdown, Type, Modules}, N) -> {NewName, MFA, RestartType, Shutdown, Type, Modules}. %%------------------------------------------------------------------------- -do_not_save_child_specs_for_temporary_children(doc) -> - ["Temporary children shall not be restarted so supervisors should " - "not save their spec when they terminate"]; -do_not_save_child_specs_for_temporary_children(suite) -> - []; +%% Temporary children shall not be restarted so supervisors should not +%% save their spec when they terminate. do_not_save_child_specs_for_temporary_children(Config) when is_list(Config) -> process_flag(trap_exit, true), dont_save_child_specs_for_temporary_children(one_for_all, kill), @@ -1373,13 +1287,18 @@ simple_one_for_one_scale_many_temporary_children(_Config) -> end || _<- lists:seq(1,10000)], {T2,done} = timer:tc(?MODULE,terminate_all_children,[C2]), - Scaling = T2 div T1, - if Scaling > 20 -> - %% The scaling shoul be linear (i.e.10, really), but we - %% give some extra here to avoid failing the test - %% unecessarily. - ?t:fail({bad_scaling,Scaling}); + if T1 > 0 -> + Scaling = T2 div T1, + if Scaling > 20 -> + %% The scaling shoul be linear (i.e.10, really), but we + %% give some extra here to avoid failing the test + %% unecessarily. + ?t:fail({bad_scaling,Scaling}); + true -> + ok + end; true -> + %% Means T2 div T1 -> infinity ok end. diff --git a/lib/test_server/test/test_server_SUITE_data/Makefile.src b/lib/test_server/test/test_server_SUITE_data/Makefile.src index d5af919eec..332b855df6 100644 --- a/lib/test_server/test/test_server_SUITE_data/Makefile.src +++ b/lib/test_server/test/test_server_SUITE_data/Makefile.src @@ -1,2 +1,7 @@ all: - erlc *.erl
\ No newline at end of file + erlc test_server_SUITE.erl + erlc test_server_parallel01_SUITE.erl + erlc test_server_conf01_SUITE.erl + erlc test_server_shuffle01_SUITE.erl + erlc test_server_conf02_SUITE.erl + erlc test_server_skip_SUITE.erl
\ No newline at end of file |