The R13B03 release.OTP_R13B03

6 files changed, 595 insertions, 0 deletions

diff --git a/lib/percept/test/Makefile b/lib/percept/test/Makefile
new file mode 100644
index 0000000000..0984b02c81
--- /dev/null
+++ b/lib/percept/test/Makefile
@@ -0,0 +1,91 @@
+#
+# %CopyrightBegin%
+# 
+# Copyright Ericsson AB 2007-2009. All Rights Reserved.
+# 
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+# 
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+# 
+# %CopyrightEnd%
+#
+
+include $(ERL_TOP)/make/target.mk
+
+include $(ERL_TOP)/make/$(TARGET)/otp.mk
+
+# ----------------------------------------------------
+# Target Specs
+# ----------------------------------------------------
+
+MODULES= \
+	ipc_tree \
+	percept_SUITE \
+	egd_SUITE 
+
+EBIN = .
+
+HRL_FILES= 
+
+ERL_FILES= $(MODULES:%=%.erl)
+
+TARGET_FILES = $(MODULES:%=$(EBIN)/%.$(EMULATOR))
+
+SOURCE = $(ERL_FILES) $(HRL_FILES)
+
+EMAKEFILE=Emakefile
+
+# ----------------------------------------------------
+# Release directory specification
+# ----------------------------------------------------
+RELSYSDIR = $(RELEASE_PATH)/percept_test
+
+# ----------------------------------------------------
+# FLAGS
+# ----------------------------------------------------
+ERL_MAKE_FLAGS += 
+ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include \
+	-I$(ERL_TOP)/lib/percept/include 
+
+# ----------------------------------------------------
+# Targets
+# ----------------------------------------------------
+
+make_emakefile:
+	$(ERL_TOP)/make/make_emakefile $(ERL_COMPILE_FLAGS) -o$(EBIN) $(MODULES)\
+	> $(EMAKEFILE)
+
+tests debug opt: make_emakefile
+	erl $(ERL_MAKE_FLAGS) -make
+
+clean:
+	rm -f $(EMAKEFILE)
+	rm -f $(TARGET_FILES)
+	rm -f core *~
+
+docs:
+
+
+# ----------------------------------------------------
+# Release Target
+# ---------------------------------------------------- 
+include $(ERL_TOP)/make/otp_release_targets.mk
+
+release_spec: opt
+
+release_tests_spec: make_emakefile
+	$(INSTALL_DIR) $(RELSYSDIR)
+	$(INSTALL_DATA) percept.spec $(EMAKEFILE) $(SOURCE) $(RELSYSDIR)
+	chmod -f -R u+w $(RELSYSDIR)
+	@tar cf - *_SUITE_data | (cd $(RELSYSDIR); tar xf -)
+
+release_docs_spec:
+
+
diff --git a/lib/percept/test/egd_SUITE.erl b/lib/percept/test/egd_SUITE.erl
new file mode 100644
index 0000000000..603ad628d3
--- /dev/null
+++ b/lib/percept/test/egd_SUITE.erl
@@ -0,0 +1,303 @@
+%%
+%% %CopyrightBegin%
+%% 
+%% Copyright Ericsson AB 2007-2009. All Rights Reserved.
+%% 
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%% 
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%% 
+%% %CopyrightEnd%
+%%
+
+-module(egd_SUITE).
+-include("test_server.hrl").
+
+%% Test server specific exports
+-export([all/1]).
+-export([init_per_suite/1, end_per_suite/1]).
+-export([init_per_testcase/2, end_per_testcase/2]).
+
+%% Test cases
+-export([
+	image_create_and_destroy/1, 
+	image_shape/1, 
+	image_colors/1, 
+	image_font/1,
+	image_png_compliant/1
+	]).
+
+%% Default timetrap timeout (set in init_per_testcase)
+-define(default_timeout, ?t:minutes(1)).
+
+init_per_suite(Config) when is_list(Config) ->
+    {A1,A2,A3} = now(),
+    random:seed(A1, A2, A3),
+    Config.
+
+end_per_suite(Config) when is_list(Config) ->
+    Config.
+
+init_per_testcase(_Case, Config) ->
+    Dog = ?t:timetrap(?default_timeout),
+    [{max_size, 800}, {watchdog,Dog} | Config].
+
+end_per_testcase(_Case, Config) ->
+    Dog = ?config(watchdog, Config),
+    ?t:timetrap_cancel(Dog),
+    ok.
+
+all(suite) ->
+    % Test cases
+    [	
+	image_create_and_destroy, 
+	image_shape, 
+	image_colors, 
+	image_font, 
+	image_png_compliant
+    ].
+
+%%----------------------------------------------------------------------
+%% Tests
+%%----------------------------------------------------------------------
+
+image_create_and_destroy(suite) ->
+    [];
+image_create_and_destroy(doc) ->
+    ["Image creation and destroy test."];
+image_create_and_destroy(Config) when is_list(Config) ->
+    {W,H} = get_size(?config(max_size, Config)),
+    ?line Image = egd:create(W, H),
+    ?line ok = egd:destroy(Image),
+    ok.
+
+image_colors(suite) ->
+    [];
+image_colors(doc) ->
+    ["Image color test."];
+image_colors(Config) when is_list(Config) ->
+    {W,H} = get_size(?config(max_size, Config)),
+    ?line Image = egd:create(W, H),
+    put(image_size, {W,H}),
+
+    RGB = get_rgb(),
+    ?line Black = egd:color({0,0,0}),
+    ?line Red = egd:color({255,0,0}),
+    ?line Green = egd:color({0,255,0}),
+    ?line Blue = egd:color({0,0,255}),
+    ?line Random = egd:color(Image, RGB),  
+
+    ?line ok = egd:line(Image, get_point(), get_point(), Random),
+    ?line ok = egd:line(Image, get_point(), get_point(), Red),
+    ?line ok = egd:line(Image, get_point(), get_point(), Green),
+    ?line ok = egd:line(Image, get_point(), get_point(), Black),
+    ?line ok = egd:line(Image, get_point(), get_point(), Blue),
+
+    HtmlDefaultNames = [black,silver,gray,white,maroon,red,
+    	purple,fuchia,green,lime,olive,yellow,navy,blue,teal,
+      	aqua],
+    
+    lists:foreach(fun
+    	(ColorName) ->
+	    ?line Color = egd:color(ColorName),
+	    ?line ok    = egd:line(Image, get_point(), get_point(), Color)
+	end, HtmlDefaultNames),
+ 
+    ?line <<_/binary>>  = egd:render(Image),
+    ?line ok = egd:destroy(Image),
+    erase(image_size),
+    ok.
+
+image_shape(suite) ->
+    [];
+image_shape(doc) ->
+    ["Image shape api test."];
+image_shape(Config) when is_list(Config) ->
+    {W,H} = get_size(?config(max_size, Config)),
+    put(image_size, {W,H}),
+    ?line Im = egd:create(W, H),
+    
+    ?line Fgc = egd:color({255,0,0}),
+
+    ?line ok = egd:line(Im, get_point(), get_point(), Fgc), 
+    ?line ok = egd:rectangle(Im, get_point(), get_point(), Fgc),
+    ?line ok = egd:filledEllipse(Im, get_point(), get_point(), Fgc),
+    ?line ok = egd:arc(Im, get_point(), get_point(), Fgc),
+    ?line ok = egd:arc(Im, get_point(), get_point(), 100, Fgc),
+    
+    Pt1 = get_point(),
+    Pt2 = get_point(), 
+
+    ?line ok = egd:filledRectangle(Im, Pt1, Pt2, Fgc),
+
+    ?line Bitmap = egd:render(Im, raw_bitmap),
+
+    ?line ok = bitmap_point_has_color(Bitmap, {W,H}, Pt2, Fgc),
+    ?line ok = bitmap_point_has_color(Bitmap, {W,H}, Pt1, Fgc),
+
+    ?line ok = egd:destroy(Im),
+    erase(image_size),
+    ok.
+     
+image_font(suite) ->
+    [];
+image_font(doc) ->
+    ["Image font test."];
+image_font(Config) when is_list(Config) ->
+    {W,H} = get_size(?config(max_size, Config)),
+    put(image_size, {W,H}),
+    ?line Im = egd:create(W, H),
+    ?line Fgc = egd:color({0,130,0}),
+  
+    ?line Filename = filename:join([code:priv_dir(percept),"fonts","6x11_latin1.wingsfont"]),
+    ?line Font = egd_font:load(Filename),
+   
+    % simple text
+    ?line ok = egd:text(Im, get_point(), Font, "Hello World", Fgc),
+    ?line <<_/binary>> = egd:render(Im, png),
+    
+    GlyphStr1   = " !\"#$%&'()*+,-./",            % Codes  32 ->  47
+    NumericStr  = "0123456789",                   % Codes  48 ->  57
+    GlyphStr2   = ":;<=>?@",                      % Codes  58 ->  64
+    AlphaBigStr = "ABCDEFGHIJKLMNOPQRSTUVWXYZ",   % Codes  65 ->  90
+    GlyphStr3   = "[\\]^_`",                      % Codes  91 ->  96
+    AlphaSmStr  = "abcdefghijklmnopqrstuvwxyz",   % Codes  97 -> 122
+    GlyphStr4   = "{|}~",                         % Codes 123 -> 126
+
+    ?line ok = egd:text(Im, get_point(), Font, GlyphStr1, Fgc),
+    ?line <<_/binary>> = egd:render(Im, png),
+
+    ?line ok = egd:text(Im, get_point(), Font, NumericStr, Fgc),
+    ?line <<_/binary>> = egd:render(Im, png),
+ 
+    ?line ok = egd:text(Im, get_point(), Font, GlyphStr2, Fgc),
+    ?line <<_/binary>> = egd:render(Im, png),
+
+    ?line ok = egd:text(Im, get_point(), Font, AlphaBigStr, Fgc),
+    ?line <<_/binary>> = egd:render(Im, png),
+    
+    ?line ok = egd:text(Im, get_point(), Font, GlyphStr3, Fgc),
+    ?line <<_/binary>> = egd:render(Im, png),
+
+    ?line ok = egd:text(Im, get_point(), Font, AlphaSmStr, Fgc),
+    ?line <<_/binary>> = egd:render(Im, png),
+    
+    ?line ok = egd:text(Im, get_point(), Font, GlyphStr4, Fgc),
+    ?line <<_/binary>> = egd:render(Im, png),
+
+    ?line ok = egd:destroy(Im),
+    erase(image_size),
+    ok.
+
+image_png_compliant(suite) ->
+    [];
+image_png_compliant(doc) ->
+    ["Image png compliant test."];
+image_png_compliant(Config) when is_list(Config) ->
+    {W,H} = get_size(?config(max_size, Config)),
+    put(image_size, {W,H}),
+    ?line Im = egd:create(W, H),
+    ?line Fgc = egd:color({0,0,0}),
+    ?line ok = egd:filledRectangle(Im, get_point(), get_point(), Fgc),
+    
+    ?line Bin = egd:render(Im, png),
+    ?line true = binary_is_png_compliant(Bin),
+    
+    ?line ok = egd:destroy(Im),
+    erase(image_size),
+    ok.
+
+%%----------------------------------------------------------------------
+%% Auxiliary tests
+%%----------------------------------------------------------------------
+    
+bitmap_point_has_color(Bitmap, {W,_}, {X,Y}, C) ->
+    {CR,CG,CB,_} = egd_primitives:rgb_float2byte(C),
+    N = W*Y*3 + X*3,
+    << _:N/binary, R,G,B, _/binary>> = Bitmap,
+    case {R,G,B} of
+	{CR,CG,CB} -> ok;
+	Other ->
+	    io:format("bitmap_point_has_color: error color was ~p, should be ~p~n", [Other, {CR,CG,CB}]),
+	    {error, {Other,{CR,CG,CB}}}
+    end.
+
+%% jfif header by specification
+%% 2 bytes, length
+%% 5 bytes, identifier ="JFIF\0"
+%% 2 bytes, version, (major, minor)
+%% 1 byte , units
+%% However, JFIF seems to start at 6 (7 with 1-index)?
+   
+binary_is_jfif_compliant(JpegBin) ->
+    ?line {Bin, _} = split_binary(JpegBin, 11),
+    List = binary_to_list(Bin),
+    case lists:sublist(List, 7, 4) of 
+	"JFIF" -> true;
+	Other ->
+	   io:format("img -> ~p~n", [Other]),
+	   false
+    end.
+
+binary_is_gif_compliant(GifBin) ->
+    ?line {Bin, _} = split_binary(GifBin, 10),
+    List = binary_to_list(Bin),
+    case lists:sublist(List, 1,5) of
+	"GIF87" -> true;
+	Other -> 
+	   io:format("img -> ~p~n", [Other]),
+	   false
+    end.
+
+binary_is_png_compliant(PngBin) ->
+    ?line {Bin, _} = split_binary(PngBin, 10),
+    List = binary_to_list(Bin),
+    case lists:sublist(List, 2,3) of
+	"PNG" -> true;
+	Other ->
+	   io:format("img -> ~p~n", [Other]),
+	   false
+    end.
+
+%%----------------------------------------------------------------------
+%% Auxiliary
+%%----------------------------------------------------------------------
+
+
+get_rgb() ->
+   R = random(255), 
+   G = random(255),   
+   B = random(255),
+   {R,G,B}.
+
+get_angle() ->
+   random(359).
+
+get_point() ->
+    get_point(get(image_size)).
+get_point({W,H}) ->
+   X = random(W - 1),
+   Y = random(H - 1),
+   {X,Y}.
+
+get_size(Max) ->
+    W = trunc(random(Max/2) + Max/2 + 1),
+    H = trunc(random(Max/2) + Max/2 + 1),
+    io:format("Image size will be ~p x ~p~n", [W,H]),
+    {W,H}.
+
+get_points(N) ->
+    get_points(N, []).
+get_points(0, Out) ->
+   Out;
+get_points(N, Out) ->
+    get_points(N - 1, [get_point() | Out]).
+
+random(N) -> trunc(random:uniform(trunc(N + 1)) - 1).
diff --git a/lib/percept/test/ipc_tree.erl b/lib/percept/test/ipc_tree.erl
new file mode 100644
index 0000000000..f7639eed1b
--- /dev/null
+++ b/lib/percept/test/ipc_tree.erl
@@ -0,0 +1,48 @@
+%% ``The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved via the world wide web at http://www.erlang.org/.
+%% 
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%% 
+%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
+%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
+%% AB. All Rights Reserved.''
+%% 
+%%     $Id$
+%% 
+
+-module(ipc_tree).
+-export([go/1, init/2]).
+
+go(N) ->
+    start(N, self()),
+    receive stop -> ok end.
+
+start(Depth, ParentPid) ->
+    spawn(?MODULE, init, [Depth, ParentPid]).
+
+init(0, ParentPid) -> 
+    workload(5000),
+    ParentPid ! stop,
+    ok;
+init(Depth, ParentPid) ->
+    Pid1 = spawn(?MODULE, init, [Depth - 1, self()]),
+    Pid2 = spawn(?MODULE, init, [Depth - 1, self()]),
+    main([Pid1,Pid2], ParentPid).
+
+main(Pids, ParentPid) ->
+    workload(5000),
+    gather(Pids),
+    ParentPid ! stop,
+    ok.
+
+gather([]) -> ok;
+gather([_|Pids]) -> receive _ -> gather(Pids) end.
+
+workload(0) -> ok;
+workload(N) -> math:sin(2), workload(N - 1).
diff --git a/lib/percept/test/percept.spec b/lib/percept/test/percept.spec
new file mode 100644
index 0000000000..75aacc1fd6
--- /dev/null
+++ b/lib/percept/test/percept.spec
@@ -0,0 +1,2 @@
+{topcase, {dir, "../percept_test"}}.
+
diff --git a/lib/percept/test/percept_SUITE.erl b/lib/percept/test/percept_SUITE.erl
new file mode 100644
index 0000000000..ff7cccdaa8
--- /dev/null
+++ b/lib/percept/test/percept_SUITE.erl
@@ -0,0 +1,151 @@
+%%
+%% %CopyrightBegin%
+%% 
+%% Copyright Ericsson AB 2007-2009. All Rights Reserved.
+%% 
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%% 
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%% 
+%% %CopyrightEnd%
+%%
+
+-module(percept_SUITE).
+-include("test_server.hrl").
+
+%% Test server specific exports
+-export([all/1]).
+-export([init_per_suite/1, end_per_suite/1]).
+-export([init_per_testcase/2, end_per_testcase/2]).
+
+%% Test cases
+-export([
+	profile/1,
+	analyze/1,
+	analyze_dist/1,
+	webserver/1
+	]).
+
+%% Default timetrap timeout (set in init_per_testcase)
+-define(default_timeout, ?t:minutes(2)).
+
+init_per_suite(Config) when is_list(Config) ->
+    Config.
+
+end_per_suite(Config) when is_list(Config) ->
+    Config.
+
+init_per_testcase(_Case, Config) ->
+    Dog = ?t:timetrap(?default_timeout),
+    [{max_size, 300}, {watchdog,Dog} | Config].
+
+end_per_testcase(_Case, Config) ->
+    Dog = ?config(watchdog, Config),
+    ?t:timetrap_cancel(Dog),
+    ok.
+
+all(suite) ->
+    % Test cases
+    [	webserver,
+	profile,
+	analyze,
+	analyze_dist].
+
+%%----------------------------------------------------------------------
+%% Tests
+%%----------------------------------------------------------------------
+
+webserver(suite) ->
+    [];
+webserver(doc) ->
+    ["Percept webserver test."];
+webserver(Config) when is_list(Config) ->
+    % Explicit start inets?
+    ?line {started, _, Port} = percept:start_webserver(),
+    ?line ok = percept:stop_webserver(Port), 
+    ?line application:stop(inets),
+    ok.
+
+profile(suite) ->
+    [];
+profile(doc) ->
+    ["Percept profile test."];
+profile(Config) when is_list(Config) ->
+    Path = ?config(data_dir, Config),
+    File = filename:join([Path,"profile_test.dat"]),
+    ?line {ok, _} = percept:profile(File, [procs]),
+    ipc_tree:go(7),
+    ?line ok = percept:stop_profile(),
+    ok.
+
+analyze(suite) ->
+    [];
+analyze(doc) ->
+    ["Percept analyze test."];
+analyze(Config) when is_list(Config) ->
+    Begin = processes(),
+    Path = ?config(data_dir, Config),
+    File = filename:join([Path,"profile_test.dat"]),
+    T0 = erlang:now(),
+    ?line ok = percept:analyze(File),
+    T1 = erlang:now(),
+    Secs = timer:now_diff(T1,T0)/1000000,
+    io:format("percept:analyze/1 took ~.2f s.~n", [Secs]),
+    ?line {stopped, _} = percept_db:stop(),
+    print_remainers(remainers(Begin, processes())),
+    ok.
+
+analyze_dist(suite) ->
+    [];
+analyze_dist(doc) ->
+    ["Percept analyze distribution test."];
+analyze_dist(Config) when is_list(Config) ->
+    Begin = processes(),
+    Path = ?config(data_dir, Config),
+    File = filename:join([Path,"ipc-dist.dat"]),
+    T0 = erlang:now(),
+    ?line ok = percept:analyze(File),
+    T1 = erlang:now(),
+    Secs = timer:now_diff(T1,T0)/1000000,
+    io:format("percept:analyze/1 took ~.2f s.~n", [Secs]),
+    ?line {stopped, _} = percept_db:stop(),
+    print_remainers(remainers(Begin, processes())),
+    ok.
+
+%%----------------------------------------------------------------------
+%% Auxiliary tests
+%%----------------------------------------------------------------------
+
+%%----------------------------------------------------------------------
+%% Auxiliary
+%%----------------------------------------------------------------------
+
+print_remainers([])   -> ok;
+print_remainers([Pid|Pids]) ->
+    io:format("[Pid ~p] [Entry ~p] [Name ~p]~n", [
+	Pid,
+	erlang:process_info(Pid, initial_call),
+	erlang:process_info(Pid, registered_name)
+    ]),
+    print_remainers(Pids).
+
+remainers(Begin, End) -> remainers(Begin, End, []).
+remainers(_, [], Out) -> lists:reverse(Out);
+remainers(Begin, [Pid|End], Out) ->
+    case lists:member(Pid, Begin) of
+	true  -> remainers(Begin, End, Out);
+	false -> remainers(Begin, End, [Pid|Out])
+    end.
+
+
+
+    
+
+
diff --git a/lib/percept/test/percept_SUITE_data/ipc-dist.dat b/lib/percept/test/percept_SUITE_data/ipc-dist.dat
new file mode 100755
index 0000000000..14ab6c0c5d
--- /dev/null
+++ b/lib/percept/test/percept_SUITE_data/ipc-dist.dat