aboutsummaryrefslogtreecommitdiffstats
path: root/lib/percept/test
diff options
context:
space:
mode:
Diffstat (limited to 'lib/percept/test')
-rw-r--r--lib/percept/test/Makefile91
-rw-r--r--lib/percept/test/egd_SUITE.erl303
-rw-r--r--lib/percept/test/ipc_tree.erl48
-rw-r--r--lib/percept/test/percept.spec2
-rw-r--r--lib/percept/test/percept_SUITE.erl151
-rwxr-xr-xlib/percept/test/percept_SUITE_data/ipc-dist.datbin0 -> 2098105 bytes
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
Binary files differ
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-17 16:11:54 +0000