Merge branch 'jn/supervisor_child_count_only' into ccase/r13b04_dev

* jn/supervisor_child_count_only:
  Add count_children/1 to supervisor.erl to determine the number of

OTP-8436  Added supervisor:count_children/1 to count the number of children
          being managed without the memory impact of which_children/1.
          (Thanks to Jay Nelson.)

1 files changed, 163 insertions, 12 deletions

diff --git a/lib/stdlib/test/supervisor_SUITE.erl b/lib/stdlib/test/supervisor_SUITE.erl
index f25e877289..039ea298c4 100644
--- a/lib/stdlib/test/supervisor_SUITE.erl
+++ b/lib/stdlib/test/supervisor_SUITE.erl
@@ -50,7 +50,7 @@
 	 simple_one_for_one_extra/1]).
 
 %% Misc tests
--export([child_unlink/1, tree/1]).
+-export([child_unlink/1, tree/1, count_children_memory/1]).
 
 %-------------------------------------------------------------------------
 
@@ -60,7 +60,8 @@ all(suite) ->
       child_adm_simple, extra_return, child_specs,
       restart_one_for_one, restart_one_for_all,
       restart_simple_one_for_one, restart_rest_for_one,
-      normal_termination, abnormal_termination, child_unlink, tree]}.
+      normal_termination, abnormal_termination, child_unlink, tree,
+      count_children_memory]}.
 
 
 start(InitResult) ->
@@ -72,6 +73,15 @@ init(fail) ->
 init(InitResult) ->
     InitResult.
 
+%% Respect proplist return of supervisor:count_children
+get_child_counts(Supervisor) ->
+    Counts = supervisor:count_children(Supervisor),
+    [proplists:get_value(specs, Counts),
+     proplists:get_value(active, Counts),
+     proplists:get_value(supervisors, Counts),
+     proplists:get_value(workers, Counts)].
+
+
 %-------------------------------------------------------------------------
 %
 % Test cases starts here.
@@ -140,6 +150,8 @@ sup_start_ignore_child(Config) when is_list(Config) ->
 
     ?line [{child2, CPid2, worker, []},{child1, undefined, worker, []}] 
 	= supervisor:which_children(sup_test),
+    ?line [2,1,0,2] = get_child_counts(sup_test),
+
     ok.
 
 %-------------------------------------------------------------------------
@@ -341,6 +353,8 @@ extra_return(Config) when is_list(Config) ->
     ?line {error, running} = supervisor:delete_child(sup_test, child1),
     ?line {error, running} = supervisor:restart_child(sup_test, child1),
     ?line [{child1, CPid, worker, []}] = supervisor:which_children(sup_test),
+    ?line [1,1,0,1] = get_child_counts(sup_test),
+
     ?line ok = supervisor:terminate_child(sup_test, child1),
     receive
 	{'EXIT', CPid, shutdown} -> ok;
@@ -350,22 +364,31 @@ extra_return(Config) when is_list(Config) ->
 	    ?line test_server:fail(no_child_termination)
     end,
     ?line [{child1,undefined,worker,[]}] = supervisor:which_children(sup_test),
+    ?line [1,0,0,1] = get_child_counts(sup_test),
+
     ?line {ok, CPid2,extra_return} = 
 	supervisor:restart_child(sup_test, child1),
     ?line [{child1, CPid2, worker, []}] = supervisor:which_children(sup_test),
+    ?line [1,1,0,1] = get_child_counts(sup_test),
+
     ?line ok = supervisor:terminate_child(sup_test, child1),
     ?line ok = supervisor:terminate_child(sup_test, child1),
     ?line ok = supervisor:delete_child(sup_test, child1),
     ?line {error, not_found} = supervisor:restart_child(sup_test, child1),
     ?line [] = supervisor:which_children(sup_test),
+    ?line [0,0,0,0] = get_child_counts(sup_test),
+
     ?line {ok, CPid3, extra_return} = supervisor:start_child(sup_test, Child),
     ?line [{child1, CPid3, worker, []}] = supervisor:which_children(sup_test),
+    ?line [1,1,0,1] = get_child_counts(sup_test),
+
     ok.
 %-------------------------------------------------------------------------
 child_adm(doc)->
     ["Test API functions start_child/2, terminate_child/2, delete_child/2 "
-     "restart_child/2, which_children/1. Only correct childspecs are used, "
-     "handling of incorrect childspecs is tested in child_specs/1"];
+     "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) -> [];
 child_adm(Config) when is_list(Config) ->
     process_flag(trap_exit, true),
@@ -373,6 +396,7 @@ child_adm(Config) when is_list(Config) ->
 	     worker, []},
     ?line {ok, _Pid} = start({ok, {{one_for_one, 2, 3600}, [Child]}}),
     ?line [{child1, CPid, worker, []}] = supervisor:which_children(sup_test),
+    ?line [1,1,0,1] = get_child_counts(sup_test),
     link(CPid),
 
     %% Start of an already runnig process 
@@ -392,6 +416,7 @@ child_adm(Config) when is_list(Config) ->
 	    ?line test_server:fail(no_child_termination)
     end,
     ?line [{child1,undefined,worker,[]}] = supervisor:which_children(sup_test),
+    ?line [1,0,0,1] = get_child_counts(sup_test),
     %% Like deleting something that does not exist, it will succeed!
     ?line ok = supervisor:terminate_child(sup_test, child1),
 
@@ -402,6 +427,7 @@ child_adm(Config) when is_list(Config) ->
     %% Restart
     ?line {ok, CPid2} = supervisor:restart_child(sup_test, child1),
     ?line [{child1, CPid2, worker, []}] = supervisor:which_children(sup_test),
+    ?line [1,1,0,1] = get_child_counts(sup_test),
     ?line {error, running} = supervisor:restart_child(sup_test, child1),
     ?line {error, not_found} = supervisor:restart_child(sup_test, child2),
     
@@ -414,15 +440,19 @@ child_adm(Config) when is_list(Config) ->
     ?line ok = supervisor:delete_child(sup_test, child1),
     ?line {error, not_found} = supervisor:restart_child(sup_test, child1),
     ?line [] = supervisor:which_children(sup_test),
+    ?line [0,0,0,0] = get_child_counts(sup_test),
     
     %% Start
     ?line {'EXIT',{noproc,{gen_server,call, _}}} =
 	(catch supervisor:start_child(foo, Child)),
     ?line {ok, CPid3} = supervisor:start_child(sup_test, Child),
     ?line [{child1, CPid3, worker, []}] = supervisor:which_children(sup_test),
+    ?line [1,1,0,1] = get_child_counts(sup_test),
 
     ?line {'EXIT',{noproc,{gen_server,call,[foo,which_children,infinity]}}}
 	= (catch supervisor:which_children(foo)),
+    ?line {'EXIT',{noproc,{gen_server,call,[foo,count_children,infinity]}}}
+	= (catch supervisor:count_children(foo)),
     ok.
 %-------------------------------------------------------------------------
 child_adm_simple(doc) ->
@@ -436,6 +466,7 @@ child_adm_simple(Config) when is_list(Config) ->
     ?line {ok, _Pid} = start({ok, {{simple_one_for_one, 2, 3600}, [Child]}}),
     %% In simple_one_for_one all children are added dynamically 
     ?line [] = supervisor:which_children(sup_test), 
+    ?line [1,0,0,0] = get_child_counts(sup_test),
     
     %% Start
     ?line {'EXIT',{noproc,{gen_server,call, _}}} =
@@ -443,12 +474,14 @@ child_adm_simple(Config) when is_list(Config) ->
     ?line {ok, CPid1} = supervisor:start_child(sup_test, []),
     ?line [{undefined, CPid1, worker, []}] = 
 	supervisor:which_children(sup_test),
+    ?line [1,1,0,1] = get_child_counts(sup_test),
     
     ?line {ok, CPid2} = supervisor:start_child(sup_test, []),
     ?line Children = supervisor:which_children(sup_test),
     ?line 2 = length(Children),
     ?line true = lists:member({undefined, CPid2, worker, []}, Children),
     ?line true = lists:member({undefined, CPid1, worker, []}, Children),
+    ?line [1,2,0,2] = get_child_counts(sup_test),
 
     %% Termination
     ?line {error, simple_one_for_one} =
@@ -541,8 +574,10 @@ permanent_normal(Config) when is_list(Config) ->
 	    ok;
 	false ->
 	    ?line test_server:fail({permanent_child_not_restarted, Child1})
-    end.
+    end,
+    ?line [1,1,0,1] = get_child_counts(sup_test),
 
+    ok.
 %------------------------------------------------------------------------- 
 transient_normal(doc) ->
     ["A transient child should not be restarted if it exits with " 
@@ -558,8 +593,10 @@ transient_normal(Config) when is_list(Config) ->
     CPid1 ! stop,
     test_server:sleep(100),
     
-    ?line [{child1,undefined,worker,[]}] = supervisor:which_children(sup_test).
+    ?line [{child1,undefined,worker,[]}] = supervisor:which_children(sup_test),
+    ?line [1,0,0,1] = get_child_counts(sup_test),
 
+    ok.
 %-------------------------------------------------------------------------    
 temporary_normal(doc) ->
     ["A temporary process should never be restarted"];
@@ -574,8 +611,10 @@ temporary_normal(Config) when is_list(Config) ->
     CPid1 ! stop,
     test_server:sleep(100),
     
-    ?line [{child1,undefined,worker,[]}] = supervisor:which_children(sup_test).
+    ?line [{child1,undefined,worker,[]}] = supervisor:which_children(sup_test),
+    ?line [1,0,0,1] = get_child_counts(sup_test),
 
+    ok.
 %-------------------------------------------------------------------------
 abnormal_termination(doc) ->
     ["Testes the supervisors behaviour if a child dies with reason abnormal"];
@@ -601,8 +640,10 @@ permanent_abnormal(Config) when is_list(Config) ->
 	    ok;
 	false ->
 	    ?line test_server:fail({permanent_child_not_restarted, Child1})
-    end.
+    end,
+    ?line [1,1,0,1] = get_child_counts(sup_test),
 
+    ok.
 %------------------------------------------------------------------------- 
 transient_abnormal(doc) ->
     ["A transient child should be restarted if it exits with " 
@@ -624,9 +665,10 @@ transient_abnormal(Config) when is_list(Config) ->
 	    ok;
 	false ->
 	    ?line test_server:fail({transient_child_not_restarted, Child1})
-    end.
-
+    end,
+    ?line [1,1,0,1] = get_child_counts(sup_test),
 
+    ok.
 %-------------------------------------------------------------------------    
 temporary_abnormal(doc) ->
     ["A temporary process should never be restarted"];
@@ -641,8 +683,10 @@ temporary_abnormal(Config) when is_list(Config) ->
     CPid1 ! die,
     test_server:sleep(100),
     
-    ?line [{child1,undefined,worker,[]}] = supervisor:which_children(sup_test).
+    ?line [{child1,undefined,worker,[]}] = supervisor:which_children(sup_test),
+    ?line [1,0,0,1] = get_child_counts(sup_test),
 
+    ok.
 %-------------------------------------------------------------------------
 restart_one_for_one(doc) ->
     ["Test that the one_for_one strategy works."];
@@ -679,6 +723,7 @@ one_for_one(Config) when is_list(Config) ->
 	    end;
        true -> ?line test_server:fail({bad_child_list, Children})
     end,
+    ?line [2,2,0,2] = get_child_counts(sup_test),
     
     %% Test restart frequency property
     CPid2 ! die,
@@ -772,6 +817,8 @@ one_for_all(Config) when is_list(Config) ->
 	true -> ?line test_server:fail(bad_child);
 	false -> ok
     end,
+    ?line [2,2,0,2] = get_child_counts(sup_test),
+
     %%% Test restart frequency property
     [{_, Pid3, _, _}|_] = supervisor:which_children(sup_test),
     Pid3 ! die,
@@ -854,6 +901,8 @@ simple_one_for_one(Config) when is_list(Config) ->
 	    end;
        true -> ?line test_server:fail({bad_child_list, Children})
     end,
+    ?line [1,2,0,2] = get_child_counts(sup_test),
+
     %% Test restart frequency property
     CPid2 ! die,
     receive
@@ -896,6 +945,8 @@ simple_one_for_one_extra(Config) when is_list(Config) ->
 	    end;
        true -> ?line test_server:fail({bad_child_list, Children})
     end,
+    ?line [1,2,0,2] = get_child_counts(sup_test),
+
     CPid2 ! die,
     receive
 	{'EXIT', CPid2, _} -> ok
@@ -962,6 +1013,8 @@ rest_for_one(Config) when is_list(Config) ->
     link(CPid2),
     ?line {ok, CPid3} = supervisor:start_child(sup_test, Child3),    
     link(CPid3),
+    ?line [3,3,0,3] = get_child_counts(sup_test),
+
     CPid2 ! die,
     receive
 	{'EXIT', CPid2, died} -> ok;
@@ -987,6 +1040,8 @@ rest_for_one(Config) when is_list(Config) ->
     if length(Children) == 3 -> ok;
        true -> ?line test_server:fail({bad_child_list, Children})
     end,
+    ?line [3,3,0,3] = get_child_counts(sup_test),
+
     %% Test that no old children is still alive
     SCh = lists:map(fun({_,P,_,_}) -> P end, Children),
     case lists:member(CPid1, SCh) of
@@ -1114,15 +1169,19 @@ tree(Config) when is_list(Config) ->
     %% Child supervisors  
     ?line {ok, Sup1} = supervisor:start_child(Pid, ChildSup1),
     ?line {ok, Sup2} = supervisor:start_child(Pid, ChildSup2),
+    ?line [2,2,2,0] = get_child_counts(Pid),
     
     %% Workers
-    
      ?line [{_, CPid2, _, _},{_, CPid1, _, _}] = 
 	supervisor:which_children(Sup1),
+    ?line [2,2,0,2] = get_child_counts(Sup1),
+    ?line [0,0,0,0] = get_child_counts(Sup2),
    
     %% Dynamic children
     ?line {ok, CPid3} = supervisor:start_child(Sup2, Child3),
     ?line {ok, CPid4} = supervisor:start_child(Sup2, Child4),
+    ?line [2,2,0,2] = get_child_counts(Sup1),
+    ?line [2,2,0,2] = get_child_counts(Sup2),
     
     link(Sup1),
     link(Sup2),
@@ -1144,9 +1203,11 @@ tree(Config) when is_list(Config) ->
     
     ?line [{_, CPid2, _, _},{_, CPid1, _, _}] = 
 	supervisor:which_children(Sup1),
+    ?line [2,2,0,2] = get_child_counts(Sup1),
     
     ?line [{_, NewCPid4, _, _},{_, CPid3, _, _}] = 
 	supervisor:which_children(Sup2),
+    ?line [2,2,0,2] = get_child_counts(Sup2),
     
     link(NewCPid4),
 
@@ -1195,9 +1256,99 @@ tree(Config) when is_list(Config) ->
         
     ?line [{supchild2, NewSup2, _, _},{supchild1, NewSup1, _, _}] =
 	supervisor:which_children(Pid),
+    ?line [2,2,2,0] = get_child_counts(Pid),
     
     ?line [{child2, _, _, _},{child1, _, _, _}]  =
 	supervisor:which_children(NewSup1),
+    ?line [2,2,0,2] = get_child_counts(NewSup1),
+
     ?line [] = supervisor:which_children(NewSup2),
+    ?line [0,0,0,0] = get_child_counts(NewSup2),
     
     ok.
+%-------------------------------------------------------------------------
+count_children_allocator_test(MemoryState) ->
+    Allocators = [temp_alloc, eheap_alloc, binary_alloc, ets_alloc,
+		  driver_alloc, sl_alloc, ll_alloc, fix_alloc, std_alloc,
+		  sys_alloc],
+    MemoryStateList = element(4, MemoryState),
+    AllocTypes = [lists:keyfind(Alloc, 1, MemoryStateList)
+		  || Alloc <- Allocators],
+    AllocStates = [lists:keyfind(e, 1, AllocValue)
+		   || {_Type, AllocValue} <- AllocTypes],
+    lists:all(fun(State) -> State == {e, true} end, AllocStates).
+
+count_children_memory(doc) ->
+    ["Test that which_children eats memory, but count_children does not."];
+count_children_memory(suite) ->
+    MemoryState = erlang:system_info(allocator),
+    case count_children_allocator_test(MemoryState) of
+	true -> [];
+	false ->
+	    {skip, "+Meamin used during test; erlang:memory/1 not available"}
+    end;
+count_children_memory(Config) when is_list(Config) ->
+    process_flag(trap_exit, true),
+    Child = {child, {supervisor_1, start_child, []}, temporary, 1000,
+	     worker, []},
+    ?line {ok, _Pid} = start({ok, {{simple_one_for_one, 2, 3600}, [Child]}}),
+    [supervisor:start_child(sup_test, []) || _Ignore <- lists:seq(1,1000)],
+
+    garbage_collect(),
+    _Size1 = erlang:memory(processes_used),
+    Children = supervisor:which_children(sup_test),
+    _Size2 = erlang:memory(processes_used),
+    ChildCount = get_child_counts(sup_test),
+    Size3 = erlang:memory(processes_used),
+
+    [supervisor:start_child(sup_test, []) || _Ignore2 <- lists:seq(1,1000)],
+
+    garbage_collect(),
+    Children2 = supervisor:which_children(sup_test),
+    Size4 = erlang:memory(processes_used),
+    ChildCount2 = get_child_counts(sup_test),
+    Size5 = erlang:memory(processes_used),
+
+    garbage_collect(),
+    Children3 = supervisor:which_children(sup_test),
+    Size6 = erlang:memory(processes_used),
+    ChildCount3 = get_child_counts(sup_test),
+    Size7 = erlang:memory(processes_used),
+
+    ?line 1000 = length(Children),
+    ?line [1,1000,0,1000] = ChildCount,
+    ?line 2000 = length(Children2),
+    ?line [1,2000,0,2000] = ChildCount2,
+    ?line Children3 = Children2,
+    ?line ChildCount3 = ChildCount2,
+
+    %% count_children consumes memory using an accumulator function,
+    %% but the space can be reclaimed incrementally, whereas
+    %% which_children generates a return list.
+    case (Size5 =< Size4) of
+	true -> ok;
+	false ->
+	    ?line test_server:fail({count_children, used_more_memory})
+    end,
+    case Size7 =< Size6 of
+	true -> ok;
+	false ->
+	    ?line test_server:fail({count_children, used_more_memory})
+    end,
+
+    case Size4 > Size3 of
+	true -> ok;
+	false ->
+	    ?line test_server:fail({which_children, used_no_memory})
+    end,
+    case Size6 > Size5 of
+	true -> ok;
+	false ->
+	    ?line test_server:fail({which_children, used_no_memory})
+    end,
+
+    [exit(Pid, kill) || {undefined, Pid, worker, _Modules} <- Children3],
+    test_server:sleep(100),
+    ?line [1,0,0,0] = get_child_counts(sup_test),
+
+    ok.