~ubuntu-branches/debian/squeeze/erlang/squeeze

« back to all changes in this revision

Viewing changes to lib/wx/test/wx_xtra_SUITE.erl

  • Committer: Bazaar Package Importer
  • Author(s): Sergei Golovan
  • Date: 2009-05-07 15:07:37 UTC
  • mfrom: (1.2.1 upstream) (5.1.2 sid)
  • Revision ID: james.westby@ubuntu.com-20090507150737-i4yb5elwinm7r0hc
Tags: 1:13.b-dfsg1-1
* Removed another bunch of non-free RFCs from original tarball
  (closes: #527053).
* Fixed build-dependencies list by adding missing comma. This requires
  libsctp-dev again. Also, added libsctp1 dependency to erlang-base and
  erlang-base-hipe packages because the shared library is loaded via
  dlopen now and cannot be added using dh_slibdeps (closes: #526682).
* Weakened dependency of erlang-webtool on erlang-observer to recommends
  to avoid circular dependencies (closes: #526627).
* Added solaris-i386 to HiPE enabled architectures.
* Made script sources in /usr/lib/erlang/erts-*/bin directory executable,
  which is more convenient if a user wants to create a target Erlang system.
* Shortened extended description line for erlang-dev package to make it
  fit 80x25 terminals.

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
%%
 
2
%% %CopyrightBegin%
 
3
%% 
 
4
%% Copyright Ericsson AB 2009. All Rights Reserved.
 
5
%% 
 
6
%% The contents of this file are subject to the Erlang Public License,
 
7
%% Version 1.1, (the "License"); you may not use this file except in
 
8
%% compliance with the License. You should have received a copy of the
 
9
%% Erlang Public License along with this software. If not, it can be
 
10
%% retrieved online at http://www.erlang.org/.
 
11
%% 
 
12
%% Software distributed under the License is distributed on an "AS IS"
 
13
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
 
14
%% the License for the specific language governing rights and limitations
 
15
%% under the License.
 
16
%% 
 
17
%% %CopyrightEnd%
 
18
%%%-------------------------------------------------------------------
 
19
%%% File    : wx_basic_SUITE.erl
 
20
%%% Author  : Dan Gudmundsson <dan.gudmundsson@ericsson.com>
 
21
%%% Description : Basic SUITE, some simple tests to show that the basics 
 
22
%%%               are working.
 
23
%%% Created :  3 Nov 2008 by Dan Gudmundsson <dan.gudmundsson@ericsson.com>
 
24
%%%-------------------------------------------------------------------
 
25
-module(wx_xtra_SUITE).
 
26
-export([all/0, init_per_suite/1, end_per_suite/1, 
 
27
         init_per_testcase/2, fin_per_testcase/2, end_per_testcase/2]).
 
28
 
 
29
-compile(export_all).
 
30
 
 
31
-include("wx_test_lib.hrl").
 
32
 
 
33
%% Initialization functions.
 
34
init_per_suite(Config) ->
 
35
    wx_test_lib:init_per_suite(Config).
 
36
 
 
37
end_per_suite(Config) ->
 
38
    wx_test_lib:end_per_suite(Config).
 
39
 
 
40
init_per_testcase(Func,Config) ->
 
41
    wx_test_lib:init_per_testcase(Func,Config).
 
42
end_per_testcase(Func,Config) -> 
 
43
    wx_test_lib:end_per_testcase(Func,Config).
 
44
fin_per_testcase(Func,Config) -> %% For test_server
 
45
    wx_test_lib:end_per_testcase(Func,Config).
 
46
 
 
47
%% SUITE specification
 
48
all() ->
 
49
    all(suite).
 
50
all(suite) ->
 
51
    [
 
52
     destroy_app,
 
53
     multiple_add_in_sizer,
 
54
     app_dies
 
55
    ].
 
56
 
 
57
%% The test cases
 
58
 
 
59
%%  Verify that everything is handled on the queue first
 
60
%%  before wx:destroy is called.
 
61
destroy_app(TestInfo) when is_atom(TestInfo) -> wx_test_lib:tc_info(TestInfo);
 
62
destroy_app(_Config) ->
 
63
    %% This is timing releated but we test a couple of times
 
64
    wx_test_lib:flush(),
 
65
    ?m(ok, destroy_app_test(15)).
 
66
 
 
67
destroy_app_test(N) when N > 0 ->
 
68
    Wx = ?mr(wx_ref, wx:new()),    
 
69
    Frame = wxFrame:new(Wx, 1, "Destroy"),
 
70
    ?m(ok, wxFrame:destroy(Frame)),
 
71
    wx:destroy(),
 
72
    receive 
 
73
        Msg -> Msg
 
74
    after 150 -> destroy_app_test(N-1)
 
75
    end;
 
76
destroy_app_test(_) -> 
 
77
    receive 
 
78
        Msg -> Msg
 
79
    after 1000 ->  ok
 
80
    end.
 
81
 
 
82
 
 
83
%% This should work, and does but not when run automaticly on windows 
 
84
%% for some strange reason (it just hangs), run it last.
 
85
app_dies(TestInfo) when is_atom(TestInfo) -> wx_test_lib:tc_info(TestInfo);
 
86
app_dies(_Config) ->
 
87
    Tester = fun(Die0) ->
 
88
                     Die = (Die0*2) + ?LINE,
 
89
                     Wx = wx:new(),
 
90
                     oops(Die,?LINE),
 
91
                     Frame = wxFrame:new(Wx, 1, ?MODULE_STRING ++ integer_to_list(?LINE)),
 
92
                     oops(Die,?LINE),
 
93
                     wxFrame:createStatusBar(Frame, []),
 
94
                     oops(Die,?LINE),
 
95
                     Win=wxWindow:new(Frame, ?wxID_ANY),
 
96
                     oops(Die,?LINE),
 
97
                     _Pen  = wxPen:new({0,0,0}, [{width, 3}]),
 
98
                     oops(Die,?LINE),
 
99
                     _Font = wxFont:new(10, ?wxSWISS, ?wxNORMAL, ?wxNORMAL,[]),
 
100
                     oops(Die,?LINE), 
 
101
                     wxWindow:connect(Win, key_up),  
 
102
                     oops(Die,?LINE),
 
103
                     wxWindow:connect(Win, key_up, [{callback, fun(_,_) -> callback end}]),
 
104
                     oops(Die,?LINE),
 
105
                     wxFrame:show(Frame),
 
106
                     oops(Die,?LINE),
 
107
                     DC0  = wxClientDC:new(Win),
 
108
                     oops(Die,?LINE),
 
109
                     DC   = wxBufferedDC:new(DC0),
 
110
                     oops(Die,?LINE),
 
111
                     _Size = wxWindow:getSize(Win),
 
112
                     oops(Die,?LINE),               %% redraw(DC, Size, G),
 
113
                     wxBufferedDC:destroy(DC),
 
114
                     oops(Die,?LINE),
 
115
                     wxClientDC:destroy(DC0),
 
116
                     oops(last,?LINE)
 
117
             end,
 
118
    process_flag(trap_exit,true),
 
119
    app_dies2(Tester, 1),
 
120
    ok.
 
121
 
 
122
app_dies2(Test, N) ->
 
123
    spawn_link(fun() -> Test(N) end),
 
124
    receive 
 
125
        {'EXIT', _, {oops, last}} -> ok;
 
126
        {'EXIT', _, {oops, _}} -> app_dies2(Test, N+1)
 
127
    end.
 
128
 
 
129
oops(Die, Line) when (Die =:= last) orelse (Die =< Line) ->
 
130
    timer:sleep(500),
 
131
    ?log(" Exits at line ~p~n",[Line]),
 
132
    exit({oops, Die});
 
133
oops(_,_) -> ok.
 
134
 
 
135
 
 
136
%% This have happend often enough that I have special code to handle 
 
137
%% this user error (i.e. using the a window twice in an sizer).
 
138
multiple_add_in_sizer(TestInfo) when is_atom(TestInfo) -> wx_test_lib:tc_info(TestInfo);
 
139
multiple_add_in_sizer(Config) ->
 
140
    Wx = wx:new(),
 
141
    Frame = wxFrame:new(Wx, -1, "Button Fix"),
 
142
    wxFrame:connect(Frame, close_window),
 
143
 
 
144
    FramePanel = wxPanel:new(Frame),
 
145
    Sizer = wxBoxSizer:new(?wxVERTICAL),
 
146
    wxPanel:setSizer(FramePanel, Sizer),
 
147
    wxSizer:setSizeHints(Sizer, Frame),
 
148
 
 
149
    Panel = wxPanel:new(FramePanel),
 
150
    Button = wxButton:new(Panel, -1, [{label, "Centre Me!"}]),
 
151
 
 
152
    PanelSizer = wxBoxSizer:new(?wxVERTICAL),
 
153
 
 
154
%%%%%%%%%%% THIS CALL CRASHES BEAM AT DESTROY TIME %%%%%%%%%%%%%
 
155
    wxPanel:setSizer(Panel, PanelSizer),
 
156
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
157
    
 
158
    ButtonSizer = wxBoxSizer:new(?wxVERTICAL),
 
159
 
 
160
    SizerFlags = wxSizerFlags:new(),
 
161
    wxSizerFlags:align(SizerFlags, ?wxALIGN_CENTRE),
 
162
 
 
163
    wxSizer:add(ButtonSizer, Button, SizerFlags), %% no tricks
 
164
 
 
165
    wxSizerFlags:expand(SizerFlags), %
 
166
    wxSizer:add(PanelSizer, ButtonSizer, SizerFlags),
 
167
 
 
168
    %% PanelSizer is added to a size twice
 
169
    wxSizer:add(Sizer, PanelSizer, SizerFlags),
 
170
 
 
171
    wxFrame:setSize(Frame, 400, 300),
 
172
    io:format("Panel ~p PSizer ~p ~n",[Panel, PanelSizer]),
 
173
    %% io:format("F
 
174
    wxWindow:show(Frame),
 
175
    wx_test_lib:wx_destroy(Frame, Config).
 
176