← Back to branch summary

~ubuntu-branches/ubuntu/lucid/erlang/lucid-updates

« back to all changes in this revision

Viewing changes to erts/emulator/test/save_calls_SUITE.erl

  • Committer: Elliot Murphy
  • Date: 2009-12-22 02:56:21 UTC
  • mfrom: (3.3.5 sid)
  • Revision ID: elliot@elliotmurphy.com-20091222025621-qv3rja8gbpiabkbe
Tags: 1:13.b.3-dfsg-2ubuntu1
* Merge with Debian testing; remaining Ubuntu changes:
  - Drop libwxgtk2.8-dev build dependency. Wx isn't in main, and not
    supposed to. (LP #438365)
  - Drop erlang-wx binary.
  - Drop erlang-wx dependency from -megaco, -common-test, and -reltool, they
    do not really need wx. Also drop it from -debugger; the GUI needs wx,
    but it apparently has CLI bits as well, and is also needed by -megaco,
    so let's keep the package for now.
* Fixed dialyzer(1) manpage which was placed into section 3 and conflicted
  with dialyzer(3erl).
* New upstream release (it adds a new binary package erlang-erl-docgen).
* Refreshed patches, removed most of emacs.patch which is applied upstream.
* Linked run_test binary from erlang-common-test package to /usr/bin.
* Fixed VCS headers in debian/control.
* Moved from prebuilt manpages to generated from sources. This adds
  erlang-manpages binary package and xsltproc build dependency.

Show diffs side-by-side

added added

removed removed

Lines of Context:
erts/emulator/test/save_calls_SUITE.erl
 
1
%%
 
2
%% %CopyrightBegin%
 
3
%% 
 
4
%% Copyright Ericsson AB 1999-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
 
 
20
-module(save_calls_SUITE).
 
21
 
 
22
-include("test_server.hrl").
 
23
 
 
24
-export([all/1]).
 
25
 
 
26
-export([save_calls_1/1,dont_break_reductions/1]).
 
27
 
 
28
-export([do_bopp/1, do_bipp/0, do_bepp/0]).
 
29
 
 
30
all(suite) ->
 
31
    [save_calls_1, dont_break_reductions].
 
32
 
 
33
dont_break_reductions(suite) ->
 
34
    [];
 
35
dont_break_reductions(doc) ->
 
36
    ["Check that save_calls dont break reduction-based scheduling"];
 
37
dont_break_reductions(Config) when is_list(Config) ->
 
38
    ?line RPS1 = reds_per_sched(0),
 
39
    ?line RPS2 = reds_per_sched(20),
 
40
    ?line Diff = abs(RPS1 - RPS2),
 
41
    ?line true = (Diff < (0.05 * RPS1)),
 
42
    ok.
 
43
 
 
44
 
 
45
reds_per_sched(SaveCalls) ->
 
46
    ?line Parent = self(),
 
47
    ?line HowMany = 10000,
 
48
    ?line Pid = spawn(fun() -> 
 
49
                        process_flag(save_calls,SaveCalls), 
 
50
                        receive 
 
51
                            go -> 
 
52
                                carmichaels_below(HowMany), 
 
53
                                Parent ! erlang:process_info(self(),reductions)
 
54
                        end 
 
55
                end),
 
56
    ?line TH = spawn(fun() -> trace_handler(0,Parent,Pid) end),
 
57
    ?line erlang:trace(Pid, true,[running,procs,{tracer,TH}]),
 
58
    ?line Pid ! go,
 
59
    ?line {Sched,Reds} = receive 
 
60
                       {accumulated,X} -> 
 
61
                           receive {reductions,Y} -> 
 
62
                                   {X,Y} 
 
63
                           after 30000 -> 
 
64
                                   timeout 
 
65
                           end 
 
66
                   after 30000 -> 
 
67
                           timeout 
 
68
                   end,
 
69
    ?line Reds div Sched.
 
70
 
 
71
 
 
72
 
 
73
trace_handler(Acc,Parent,Client) ->
 
74
    receive
 
75
        {trace,Client,out,_} ->
 
76
            trace_handler(Acc+1,Parent,Client);
 
77
        {trace,Client,exit,_} ->
 
78
            Parent ! {accumulated, Acc};
 
79
        _ ->
 
80
            trace_handler(Acc,Parent,Client)
 
81
    after 10000 ->
 
82
            ok
 
83
    end.
 
84
 
 
85
save_calls_1(doc) -> "Test call saving.";
 
86
save_calls_1(Config) when is_list(Config) ->
 
87
    case test_server:is_native(?MODULE) of
 
88
        true -> {skipped,"Native code"};
 
89
        false -> save_calls_1()
 
90
    end.
 
91
            
 
92
save_calls_1() ->
 
93
    ?line erlang:process_flag(self(), save_calls, 0),
 
94
    ?line {last_calls, false} = process_info(self(), last_calls),
 
95
 
 
96
    ?line erlang:process_flag(self(), save_calls, 10),
 
97
    ?line {last_calls, _L1} = process_info(self(), last_calls),
 
98
    ?line ?MODULE:do_bipp(),
 
99
    ?line {last_calls, L2} = process_info(self(), last_calls),
 
100
    ?line L21 = lists:filter(fun is_local_function/1, L2),
 
101
    ?line case L21 of
 
102
              [{?MODULE,do_bipp,0},
 
103
               timeout,
 
104
               'send',
 
105
               {?MODULE,do_bopp,1},
 
106
               'receive',
 
107
               timeout,
 
108
               {?MODULE,do_bepp,0}] ->
 
109
                  ok;
 
110
              X ->
 
111
                  test_server:fail({l21, X})
 
112
          end,
 
113
 
 
114
    ?line erlang:process_flag(self(), save_calls, 10),
 
115
    ?line {last_calls, L3} = process_info(self(), last_calls),
 
116
    ?line L31 = lists:filter(fun is_local_function/1, L3),
 
117
    ?line [] = L31,
 
118
    ok.
 
119
 
 
120
do_bipp() ->
 
121
    do_bopp(0),
 
122
    do_bapp(),
 
123
    ?MODULE:do_bopp(0),
 
124
    do_bopp(3),
 
125
    apply(?MODULE, do_bepp, []).
 
126
 
 
127
do_bapp() ->
 
128
    self() ! heffaklump.
 
129
 
 
130
do_bopp(T) ->
 
131
    receive
 
132
        X -> X
 
133
    after T -> ok
 
134
    end.
 
135
 
 
136
do_bepp() ->
 
137
    ok.
 
138
 
 
139
is_local_function({?MODULE, _, _}) ->
 
140
    true;
 
141
is_local_function({_, _, _}) ->
 
142
    false;
 
143
is_local_function(_) ->
 
144
    true.
 
145
 
 
146
 
 
147
% Number crunching for reds test.
 
148
carmichaels_below(N) ->
 
149
    random:seed(3172,9814,20125),
 
150
    carmichaels_below(1,N).
 
151
 
 
152
carmichaels_below(N,N2) when N >= N2 ->
 
153
    0;
 
154
carmichaels_below(N,N2) ->
 
155
    X = case fast_prime(N,10) of
 
156
        false -> 0;
 
157
        true ->
 
158
            case fast_prime2(N,10) of
 
159
                true ->
 
160
                    %io:format("Prime: ~p~n",[N]),
 
161
                    0;
 
162
                false ->
 
163
                    io:format("Carmichael: ~p (dividable by ~p)~n",
 
164
                              [N,smallest_divisor(N)]),
 
165
                    1
 
166
            end
 
167
    end,
 
168
    X+carmichaels_below(N+2,N2).
 
169
 
 
170
expmod(_,E,_) when E == 0 ->
 
171
    1;
 
172
expmod(Base,Exp,Mod) when (Exp rem 2) == 0 ->
 
173
    X = expmod(Base,Exp div 2,Mod),
 
174
    (X*X) rem Mod;
 
175
expmod(Base,Exp,Mod) -> 
 
176
    (Base * expmod(Base,Exp - 1,Mod)) rem Mod.
 
177
 
 
178
uniform(N) ->
 
179
    random:uniform(N-1).
 
180
 
 
181
fermat(N) ->    
 
182
    R = uniform(N),
 
183
    expmod(R,N,N) == R.
 
184
 
 
185
do_fast_prime(1,_) ->
 
186
    true;
 
187
do_fast_prime(_N,0) ->
 
188
    true;
 
189
do_fast_prime(N,Times) ->
 
190
    case fermat(N) of
 
191
        true ->
 
192
            do_fast_prime(N,Times-1);
 
193
        false ->
 
194
            false
 
195
    end.
 
196
    
 
197
fast_prime(N,T) ->
 
198
    do_fast_prime(N,T).
 
199
 
 
200
expmod2(_,E,_) when E == 0 ->
 
201
    1;
 
202
expmod2(Base,Exp,Mod) when (Exp rem 2) == 0 ->
 
203
%% Uncomment the code below to simulate scheduling bug!
 
204
%     case erlang:process_info(self(),last_calls) of
 
205
%       {last_calls,false} -> ok;
 
206
%       _ -> erlang:yield()
 
207
%     end,
 
208
    X = expmod2(Base,Exp div 2,Mod),
 
209
    Y=(X*X) rem Mod,
 
210
    if 
 
211
        Y == 1, X =/= 1, X =/= (Mod - 1) ->
 
212
            0;
 
213
        true ->
 
214
            Y rem Mod
 
215
    end;
 
216
expmod2(Base,Exp,Mod) -> 
 
217
    (Base * expmod2(Base,Exp - 1,Mod)) rem Mod.
 
218
 
 
219
miller_rabbin(N) ->
 
220
    R = uniform(N),
 
221
    expmod2(R,N,N) == R.
 
222
 
 
223
do_fast_prime2(1,_) ->
 
224
    true;
 
225
do_fast_prime2(_N,0) ->
 
226
    true;
 
227
do_fast_prime2(N,Times) ->
 
228
    case miller_rabbin(N) of
 
229
        true ->
 
230
            do_fast_prime2(N,Times-1);
 
231
        false ->
 
232
            false
 
233
    end.
 
234
    
 
235
fast_prime2(N,T) ->
 
236
    do_fast_prime2(N,T).
 
237
 
 
238
smallest_divisor(N) ->
 
239
    find_divisor(N,2).
 
240
 
 
241
find_divisor(N,TD) ->
 
242
    if 
 
243
        TD*TD > N ->
 
244
            N;
 
245
        true ->
 
246
            case divides(TD,N) of
 
247
                true ->
 
248
                    TD;
 
249
                false ->
 
250
                    find_divisor(N,TD+1)
 
251
            end
 
252
    end.
 
253
 
 
254
divides(A,B) ->
 
255
    (B rem A) == 0.
 
256