aboutsummaryrefslogtreecommitdiffstats
path: root/lib/dialyzer/test/small_tests_SUITE_data/src
diff options
context:
space:
mode:
Diffstat (limited to 'lib/dialyzer/test/small_tests_SUITE_data/src')
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/app_call.erl17
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/appmon_place.erl71
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/areq.erl12
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/atom_call.erl14
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/atom_guard.erl9
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/atom_widen.erl24
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/bs_fail_constr.erl16
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/bs_utf8.erl27
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/cerl_hipeify.erl684
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/comm_layer/comm_acceptor.erl120
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/comm_layer/comm_connection.erl206
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/comm_layer/comm_layer.erl83
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/comm_layer/comm_layer.hrl30
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/comm_layer/comm_logger.erl143
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/comm_layer/comm_port.erl240
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/comm_layer/comm_port_sup.erl90
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/compare1.erl21
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/confusing_warning.erl22
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/contract2.erl18
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/contract3.erl34
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/contract5.erl15
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/disj_norm_form.erl23
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/eqeq.erl16
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/ets_select.erl12
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/exhaust_case.erl24
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/failing_guard1.erl16
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/flatten.erl18
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/fun_app.erl42
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/fun_ref_match.erl21
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/fun_ref_record.erl17
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/gencall.erl12
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/gs_make.erl261
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/inf_loop2.erl23
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/letrec1.erl13
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/list_match.erl20
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/lzip.erl8
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/make_tuple.erl5
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/minus_minus.erl8
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/mod_info.erl5
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/my_filter.erl17
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/my_sofs.erl83
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/no_match.erl9
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/no_unused_fun.erl20
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/no_unused_fun2.erl20
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/non_existing.erl13
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/not_guard_crash.erl49
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/or_bug.erl24
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/orelsebug.erl17
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/orelsebug2.erl23
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/overloaded1.erl31
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/port_info_test.erl34
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/process_info_test.erl21
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/pubsub/pubsub_api.erl99
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/pubsub/pubsub_publish.erl50
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/receive1.erl17
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/record_construct.erl22
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/record_pat.erl19
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/record_send_test.erl33
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/record_test.erl24
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/recursive_types1.erl10
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/recursive_types2.erl12
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/recursive_types3.erl15
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/recursive_types4.erl13
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/recursive_types5.erl13
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/recursive_types6.erl17
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/recursive_types7.erl13
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/refine_bug1.erl11
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/toth.erl99
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/trec.erl37
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/try1.erl27
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/tuple1.erl29
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/unsafe_beamcode_bug.erl15
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/unused_cases.erl41
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/unused_clauses.erl18
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/zero_tuple.erl13
75 files changed, 3448 insertions, 0 deletions
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/app_call.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/app_call.erl
new file mode 100644
index 0000000000..54d178d29a
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/app_call.erl
@@ -0,0 +1,17 @@
+-module(app_call).
+-export([test/1]).
+
+test(m) ->
+ M = get_mod(),
+ M:foo();
+test(f) ->
+ F = get_fun(),
+ mod:F();
+test(_) ->
+ ok.
+
+get_mod() ->
+ 42.
+
+get_fun() ->
+ {gazonk, []}.
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/appmon_place.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/appmon_place.erl
new file mode 100644
index 0000000000..8371cab233
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/appmon_place.erl
@@ -0,0 +1,71 @@
+%%---------------------------------------------------------------------
+%% This is added as a test because it was giving a false positive
+%% (function move/4 will nevr be called) due to the strange use of
+%% self-recursive fun construction in placex/3.
+%%
+%% The analysis was getting confused that the foldl call will never
+%% terminate (due to a wrong hard-coded type for foldl) and inferred
+%% that the remaining calls in the body of placex/3 will not be
+%% reached. Fixed 11 March 2005.
+%%---------------------------------------------------------------------
+
+-module(appmon_place).
+-export([place/2]).
+
+place(DG, Root) ->
+ case appmon_dg:get(data, DG, Root) of
+ false -> [0];
+ _Other ->
+ placey(DG, Root, 1),
+ placex(DG, Root, [])
+ end.
+
+placey(DG, V, Y) ->
+ appmon_dg:set(y, DG, V, Y),
+ Y1 = Y+1,
+ lists:foreach(fun(C) -> placey(DG, C, Y1) end, appmon_dg:get(out, DG, V)).
+
+placex(DG, V, LastX) ->
+ Ch = appmon_dg:get(out, DG, V),
+ ChLX = lists:foldl(fun(C, Accu) -> placex(DG, C, Accu) end,
+ tll(LastX),
+ Ch),
+ Width = appmon_dg:get(w, DG, V),
+ MyX = calc_mid(DG, Width, Ch),
+ DeltaX = calc_delta(MyX, hdd(LastX)+20),
+ appmon_dg:set(x, DG, V, MyX),
+ move(DG, V, [MyX+Width | ChLX], DeltaX).
+
+move(_DG, _L, LastX, 0) -> LastX;
+move(DG, V, LastX, DeltaX) -> move2(DG, V, LastX, DeltaX).
+
+move2(DG, V, LastX, DeltaX) ->
+ NewX = appmon_dg:get(x, DG, V)+DeltaX,
+ appmon_dg:set(x, DG, V, NewX),
+ ChLX = lists:foldl(fun(C, LX) -> move2(DG, C, LX, DeltaX) end,
+ tll(LastX),
+ appmon_dg:get(out, DG, V)),
+ [max(NewX+appmon_dg:get(w, DG, V), hdd(LastX)) | ChLX].
+
+max(A, B) when A>B -> A;
+max(_, B) -> B.
+
+calc_mid(_DG, _Width, []) -> 0;
+calc_mid(DG, Width, ChList) ->
+ LeftMostX = appmon_dg:get(x, DG, hd(ChList)),
+ Z2 = lists:last(ChList),
+ RightMostX = appmon_dg:get(x, DG, Z2)+appmon_dg:get(w, DG, Z2),
+ trunc((LeftMostX+RightMostX)/2)-trunc(Width/2).
+
+calc_delta(Mid, Right) ->
+ if Right>Mid -> Right-Mid;
+ true -> 0
+ end.
+
+%% Special head and tail
+%% Handles empty list in a non-standard way
+tll([]) -> [];
+tll([_|T]) -> T.
+hdd([]) -> 0;
+hdd([H|_]) -> H.
+
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/areq.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/areq.erl
new file mode 100644
index 0000000000..1b4eea8511
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/areq.erl
@@ -0,0 +1,12 @@
+-module(areq).
+
+-export([t/0]).
+
+t() ->
+ ar_comp(3.0, 3),
+ ex_comp(3.0, 3).
+
+ar_comp(X, Y) -> X == Y.
+
+ex_comp(X, Y) -> X =:= Y.
+
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/atom_call.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/atom_call.erl
new file mode 100644
index 0000000000..bf0646eadc
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/atom_call.erl
@@ -0,0 +1,14 @@
+%%%-------------------------------------------------------------------
+%%% File : atom_call.erl
+%%% Author : Tobias Lindahl <[email protected]>
+%%% Description :
+%%%
+%%% Created : 10 Dec 2007 by Tobias Lindahl <[email protected]>
+%%%-------------------------------------------------------------------
+-module(atom_call).
+
+-export([f/0,g/0]).
+
+f() -> ok.
+
+g() -> F = f, F().
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/atom_guard.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/atom_guard.erl
new file mode 100644
index 0000000000..67d97f8e29
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/atom_guard.erl
@@ -0,0 +1,9 @@
+-module(atom_guard).
+-export([test/0]).
+
+test() ->
+ foo(42).
+
+foo(X) when is_atom(x) ->
+ X.
+
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/atom_widen.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/atom_widen.erl
new file mode 100644
index 0000000000..81bfac9d56
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/atom_widen.erl
@@ -0,0 +1,24 @@
+%%---------------------------------------------------------------------
+%% Tests that the set widening limit is at least as big as 13,
+%% which allows for the following discrepancy to be detected.
+%%---------------------------------------------------------------------
+
+-module(atom_widen).
+-export([test/0, foo/1]).
+
+test() ->
+ foo(z).
+
+foo(a) -> 1;
+foo(b) -> 2;
+foo(c) -> 3;
+foo(d) -> 4;
+foo(e) -> 5;
+foo(f) -> 6;
+foo(g) -> 7;
+foo(h) -> 8;
+foo(i) -> 9;
+foo(k) -> 10;
+foo(l) -> 11;
+foo(m) -> 12;
+foo(n) -> 13.
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/bs_fail_constr.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/bs_fail_constr.erl
new file mode 100644
index 0000000000..20fd1cbf64
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/bs_fail_constr.erl
@@ -0,0 +1,16 @@
+-module(bs_fail_constr).
+
+-export([w1/1, w2/1, w3/1, w4/1]).
+
+w1(V) when is_float(V) ->
+ <<V/integer>>.
+
+w2(V) when is_atom(V) ->
+ <<V/binary>>.
+
+w3(S) when is_integer(S), S < 0 ->
+ <<42:S/integer>>.
+
+w4(V) when is_float(V) ->
+ <<V/utf32>>.
+
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/bs_utf8.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/bs_utf8.erl
new file mode 100644
index 0000000000..5fe28f1da1
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/bs_utf8.erl
@@ -0,0 +1,27 @@
+%%--------------------------------------------------------------------
+%% Test case that exposed a bug (bogus warning) in dialyzer_dataflow
+%% when refining binaries containing UTF-based segments. Reported by
+%% Patrik Nyblom on 4/3/2009 and fixed by Kostis Sagonas on 31/3/2009.
+%%--------------------------------------------------------------------
+
+-module(bs_utf8).
+
+-export([doit/2]).
+
+doit(N, Bin) when is_integer(N), N > 0 ->
+ count_and_find(Bin, N).
+
+count_and_find(Bin, N) when is_binary(Bin) ->
+ cafu(Bin, N, 0, 0, no_pos).
+
+cafu(<<>>, _N, Count, _ByteCount, SavePos) ->
+ {Count, SavePos};
+cafu(<<_/utf8, Rest/binary>>, 0, Count, ByteCount, _SavePos) ->
+ cafu(Rest, -1, Count+1, 0, ByteCount);
+cafu(<<_/utf8, Rest/binary>>, N, Count, _ByteCount, SavePos) when N < 0 ->
+ cafu(Rest, -1, Count+1, 0, SavePos);
+cafu(<<_/utf8, Rest/binary>> = Whole, N, Count, ByteCount, SavePos) ->
+ Delta = byte_size(Whole) - byte_size(Rest),
+ cafu(Rest, N-1, Count+1, ByteCount+Delta, SavePos);
+cafu(_Other, _N, Count, ByteCount, _SavePos) -> % Non Unicode character at end
+ {Count, ByteCount}.
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/cerl_hipeify.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/cerl_hipeify.erl
new file mode 100644
index 0000000000..3ccadec4d0
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/cerl_hipeify.erl
@@ -0,0 +1,684 @@
+%% =====================================================================
+%% This library is free software; you can redistribute it and/or modify
+%% it under the terms of the GNU Lesser General Public License as
+%% published by the Free Software Foundation; either version 2 of the
+%% License, or (at your option) any later version.
+%%
+%% This library is distributed in the hope that it will be useful, but
+%% WITHOUT ANY WARRANTY; without even the implied warranty of
+%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+%% Lesser General Public License for more details.
+%%
+%% You should have received a copy of the GNU Lesser General Public
+%% License along with this library; if not, write to the Free Software
+%% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
+%% USA
+%%
+%% $Id: cerl_hipeify.erl,v 1.1 2008/12/17 09:53:49 mikpe Exp $
+%%
+%% @author Richard Carlsson <[email protected]>
+%% @copyright 2000-2004 Richard Carlsson
+%% @doc HiPE-ification of Core Erlang code. Prepares Core Erlang code
+%% for translation to ICode.
+%% @see cerl_to_icode
+
+-module(cerl_hipeify).
+
+-export([transform/2]).
+
+-define(PRIMOP_IDENTITY, identity). % arity 1
+-define(PRIMOP_NOT, 'not'). % arity 1
+-define(PRIMOP_AND, 'and'). % arity 2
+-define(PRIMOP_OR, 'or'). % arity 2
+-define(PRIMOP_XOR, 'xor'). % arity 2
+-define(PRIMOP_ADD, '+'). % arity 2
+-define(PRIMOP_SUB, '-'). % arity 2
+-define(PRIMOP_NEG, neg). % arity 1
+-define(PRIMOP_MUL, '*'). % arity 2
+-define(PRIMOP_DIV, '/'). % arity 2
+-define(PRIMOP_INTDIV, 'div'). % arity 2
+-define(PRIMOP_REM, 'rem'). % arity 2
+-define(PRIMOP_BAND, 'band'). % arity 2
+-define(PRIMOP_BOR, 'bor'). % arity 2
+-define(PRIMOP_BXOR, 'bxor'). % arity 2
+-define(PRIMOP_BNOT, 'bnot'). % arity 1
+-define(PRIMOP_BSL, 'bsl'). % arity 2
+-define(PRIMOP_BSR, 'bsr'). % arity 2
+-define(PRIMOP_EQ, '=='). % arity 2
+-define(PRIMOP_NE, '/='). % arity 2
+-define(PRIMOP_EXACT_EQ, '=:='). % arity 2
+-define(PRIMOP_EXACT_NE, '=/='). % arity 2
+-define(PRIMOP_LT, '<'). % arity 2
+-define(PRIMOP_GT, '>'). % arity 2
+-define(PRIMOP_LE, '=<'). % arity 2
+-define(PRIMOP_GE, '>='). % arity 2
+-define(PRIMOP_IS_ATOM, 'is_atom'). % arity 1
+-define(PRIMOP_IS_BIGNUM, 'is_bignum'). % arity 1
+-define(PRIMOP_IS_BINARY, 'is_binary'). % arity 1
+-define(PRIMOP_IS_CONSTANT, 'is_constant'). % arity 1
+-define(PRIMOP_IS_FIXNUM, 'is_fixnum'). % arity 1
+-define(PRIMOP_IS_FLOAT, 'is_float'). % arity 1
+-define(PRIMOP_IS_FUNCTION, 'is_function'). % arity 1
+-define(PRIMOP_IS_INTEGER, 'is_integer'). % arity 1
+-define(PRIMOP_IS_LIST, 'is_list'). % arity 1
+-define(PRIMOP_IS_NUMBER, 'is_number'). % arity 1
+-define(PRIMOP_IS_PID, 'is_pid'). % arity 1
+-define(PRIMOP_IS_PORT, 'is_port'). % arity 1
+-define(PRIMOP_IS_REFERENCE, 'is_reference'). % arity 1
+-define(PRIMOP_IS_TUPLE, 'is_tuple'). % arity 1
+-define(PRIMOP_IS_RECORD, 'is_record'). % arity 3
+-define(PRIMOP_EXIT, exit). % arity 1
+-define(PRIMOP_THROW, throw). % arity 1
+-define(PRIMOP_ERROR, error). % arity 1,2
+-define(PRIMOP_RETHROW, raise). % arity 2
+-define(PRIMOP_RECEIVE_SELECT, receive_select). % arity 0
+-define(PRIMOP_RECEIVE_NEXT, receive_next). % arity 0
+-define(PRIMOP_ELEMENT, element). % arity 2
+-define(PRIMOP_DSETELEMENT, dsetelement). % arity 3
+-define(PRIMOP_MAKE_FUN, make_fun). % arity 6
+-define(PRIMOP_APPLY_FUN, apply_fun). % arity 2
+-define(PRIMOP_FUN_ELEMENT, closure_element). % arity 2
+-define(PRIMOP_SET_LABEL, set_label). % arity 1
+-define(PRIMOP_GOTO_LABEL, goto_label). % arity 1
+-define(PRIMOP_REDUCTION_TEST, reduction_test). % arity 0
+
+-record(ctxt, {class = expr}).
+
+
+%% @spec transform(Module::cerl(), Options::[term()]) -> cerl()
+%%
+%% cerl() = cerl:cerl()
+%%
+%% @doc Rewrites a Core Erlang module to a form suitable for further
+%% translation to HiPE Icode. See module <code>cerl_to_icode</code> for
+%% details.
+%%
+%% @see cerl_to_icode
+%% @see cerl_cconv
+
+transform(E, Opts) ->
+ %% Start by closure converting the code
+ module(cerl_cconv:transform(E, Opts), Opts).
+
+module(E, Opts) ->
+ {Ds, Env, Ren} = add_defs(cerl:module_defs(E), env__new(),
+ ren__new()),
+ M = cerl:module_name(E),
+ S0 = s__new(cerl:atom_val(M)),
+ S = s__set_pmatch(proplists:get_value(pmatch, Opts), S0),
+ {Ds1, _} = defs(Ds, true, Env, Ren, S),
+ cerl:update_c_module(E, M, cerl:module_exports(E),
+ cerl:module_attrs(E), Ds1).
+
+%% Note that the environment is defined on the renamed variables.
+
+expr(E0, Env, Ren, Ctxt, S0) ->
+ %% Do peephole optimizations as we traverse the code.
+ E = cerl_lib:reduce_expr(E0),
+ case cerl:type(E) of
+ literal ->
+ {E, S0};
+ var ->
+ variable(E, Env, Ren, Ctxt, S0);
+ values ->
+ {Es, S1} = expr_list(cerl:values_es(E), Env, Ren, Ctxt, S0),
+ {cerl:update_c_values(E, Es), S1};
+ cons ->
+ {E1, S1} = expr(cerl:cons_hd(E), Env, Ren, Ctxt, S0),
+ {E2, S2} = expr(cerl:cons_tl(E), Env, Ren, Ctxt, S1),
+ {cerl:update_c_cons(E, E1, E2), S2};
+ tuple ->
+ {Es, S1} = expr_list(cerl:tuple_es(E), Env, Ren, Ctxt, S0),
+ {cerl:update_c_tuple(E, Es), S1};
+ 'let' ->
+ let_expr(E, Env, Ren, Ctxt, S0);
+ seq ->
+ {A, S1} = expr(cerl:seq_arg(E), Env, Ren, Ctxt, S0),
+ {B, S2} = expr(cerl:seq_body(E), Env, Ren, Ctxt, S1),
+ {cerl:update_c_seq(E, A, B), S2};
+ apply ->
+ {Op, S1} = expr(cerl:apply_op(E), Env, Ren, Ctxt, S0),
+ {As, S2} = expr_list(cerl:apply_args(E), Env, Ren, Ctxt, S1),
+ {cerl:update_c_apply(E, Op, As), S2};
+ call ->
+ {M, S1} = expr(cerl:call_module(E), Env, Ren, Ctxt, S0),
+ {N, S2} = expr(cerl:call_name(E), Env, Ren, Ctxt, S1),
+ {As, S3} = expr_list(cerl:call_args(E), Env, Ren, Ctxt, S2),
+ {rewrite_call(E, M, N, As, S3), S3};
+ primop ->
+ {As, S1} = expr_list(cerl:primop_args(E), Env, Ren, Ctxt, S0),
+ N = cerl:primop_name(E),
+ {rewrite_primop(E, N, As, S1), S1};
+ 'case' ->
+ {A, S1} = expr(cerl:case_arg(E), Env, Ren, Ctxt, S0),
+ {E1, Vs, S2} = clauses(cerl:case_clauses(E), Env, Ren, Ctxt, S1),
+ {cerl:c_let(Vs, A, E1), S2};
+ 'fun' ->
+ Vs = cerl:fun_vars(E),
+ {Vs1, Env1, Ren1} = add_vars(Vs, Env, Ren),
+ {B, S1} = expr(cerl:fun_body(E), Env1, Ren1, Ctxt, S0),
+ {cerl:update_c_fun(E, Vs1, B), S1};
+ 'receive' ->
+ receive_expr(E, Env, Ren, Ctxt, S0);
+ 'try' ->
+ {A, S1} = expr(cerl:try_arg(E), Env, Ren, Ctxt, S0),
+ Vs = cerl:try_vars(E),
+ {Vs1, Env1, Ren1} = add_vars(Vs, Env, Ren),
+ {B, S2} = expr(cerl:try_body(E), Env1, Ren1, Ctxt, S1),
+ Evs = cerl:try_evars(E),
+ {Evs1, Env2, Ren2} = add_vars(Evs, Env, Ren),
+ {H, S3} = expr(cerl:try_handler(E), Env2, Ren2, Ctxt, S2),
+ {cerl:update_c_try(E, A, Vs1, B, Evs1, H), S3};
+ 'catch' ->
+ catch_expr(E, Env, Ren, Ctxt, S0);
+ letrec ->
+ {Ds, Env1, Ren1} = add_defs(cerl:letrec_defs(E), Env, Ren),
+ {Ds1, S1} = defs(Ds, false, Env1, Ren1, S0),
+ {B, S2} = expr(cerl:letrec_body(E), Env1, Ren1, Ctxt, S1),
+ {cerl:update_c_letrec(E, Ds1, B), S2};
+ binary ->
+ {Segs, S1}=expr_list(cerl:binary_segments(E), Env, Ren,
+ Ctxt, S0),
+ {cerl:update_c_binary(E, Segs), S1};
+ bitstr ->
+ {E1,S1} = expr(cerl:bitstr_val(E), Env, Ren, Ctxt, S0),
+ {E2,S2} = expr(cerl:bitstr_size(E), Env, Ren, Ctxt, S1),
+ E3 = cerl:bitstr_unit(E),
+ E4 = cerl:bitstr_type(E),
+ E5 = cerl:bitstr_flags(E),
+ {cerl:update_c_bitstr(E, E1, E2, E3, E4, E5), S2}
+ end.
+
+guard_expr(E, Env, Ren, Ctxt, S) ->
+ expr(E, Env, Ren, Ctxt#ctxt{class = guard}, S).
+
+expr_list(Es, Env, Ren, Ctxt, S0) ->
+ list(Es, Env, Ren, Ctxt, S0, fun expr/5).
+
+list([E | Es], Env, Ren, Ctxt, S0, F) ->
+ {E1, S1} = F(E, Env, Ren, Ctxt, S0),
+ {Es1, S2} = list(Es, Env, Ren, Ctxt, S1, F),
+ {[E1 | Es1], S2};
+list([], _, _, _, S, _) ->
+ {[], S}.
+
+pattern(E, Env, Ren) ->
+ case cerl:type(E) of
+ literal ->
+ E;
+ var ->
+ cerl:update_c_var(E, ren__map(cerl:var_name(E), Ren));
+ values ->
+ Es = pattern_list(cerl:values_es(E), Env, Ren),
+ cerl:update_c_values(E, Es);
+ cons ->
+ E1 = pattern(cerl:cons_hd(E), Env, Ren),
+ E2 = pattern(cerl:cons_tl(E), Env, Ren),
+ cerl:update_c_cons(E, E1, E2);
+ tuple ->
+ Es = pattern_list(cerl:tuple_es(E), Env, Ren),
+ cerl:update_c_tuple(E, Es);
+ alias ->
+ V = pattern(cerl:alias_var(E), Env, Ren),
+ P = pattern(cerl:alias_pat(E), Env, Ren),
+ cerl:update_c_alias(E, V, P);
+ binary ->
+ Segs=pattern_list(cerl:binary_segments(E), Env, Ren),
+ cerl:update_c_binary(E, Segs);
+ bitstr ->
+ E1 = pattern(cerl:bitstr_val(E), Env, Ren),
+ E2 = pattern(cerl:bitstr_size(E), Env, Ren),
+ E3 = cerl:bitstr_unit(E),
+ E4 = cerl:bitstr_type(E),
+ E5 = cerl:bitstr_flags(E),
+ cerl:update_c_bitstr(E, E1, E2, E3, E4, E5)
+ end.
+
+
+
+pattern_list([E | Es], Env, Ren) ->
+ [pattern(E, Env, Ren) | pattern_list(Es, Env, Ren)];
+pattern_list([], _, _) ->
+ [].
+
+%% Visit the function body of each definition. We insert an explicit
+%% reduction test at the start of each function.
+
+defs(Ds, Top, Env, Ren, S) ->
+ defs(Ds, [], Top, Env, Ren, S).
+
+defs([{V, F} | Ds], Ds1, Top, Env, Ren, S0) ->
+ S1 = case Top of
+ true -> s__enter_function(cerl:var_name(V), S0);
+ false -> S0
+ end,
+ {B, S2} = expr(cerl:fun_body(F), Env, Ren, #ctxt{}, S1),
+ B1 = cerl:c_seq(cerl:c_primop(cerl:c_atom(?PRIMOP_REDUCTION_TEST),
+ []),
+ B),
+ F1 = cerl:update_c_fun(F, cerl:fun_vars(F), B1),
+ defs(Ds, [{V, F1} | Ds1], Top, Env, Ren, S2);
+defs([], Ds, _Top, _Env, _Ren, S) ->
+ {lists:reverse(Ds), S}.
+
+clauses([C|_]=Cs, Env, Ren, Ctxt, S) ->
+ {Cs1, S1} = clause_list(Cs, Env, Ren, Ctxt, S),
+ %% Perform pattern matching compilation on the clauses.
+ {E, Vs} = case s__get_pmatch(S) of
+ true ->
+ cerl_pmatch:clauses(Cs1, Env);
+ no_duplicates ->
+ put('cerl_pmatch_duplicate_code', never),
+ cerl_pmatch:clauses(Cs1, Env);
+ duplicate_all ->
+ put('cerl_pmatch_duplicate_code', always),
+ cerl_pmatch:clauses(Cs1, Env);
+ Other when Other == false; Other == undefined ->
+ Vs0 = new_vars(cerl:clause_arity(C), Env),
+ {cerl:c_case(cerl:c_values(Vs0), Cs1), Vs0}
+ end,
+ %% We must make sure that we also visit any clause guards generated
+ %% by the pattern matching compilation. We pass an empty renaming,
+ %% so we do not rename any variables twice.
+ {E1, S2} = revisit_expr(E, Env, ren__new(), Ctxt, S1),
+ {E1, Vs, S2}.
+
+clause_list(Cs, Env, Ren, Ctxt, S) ->
+ list(Cs, Env, Ren, Ctxt, S, fun clause/5).
+
+clause(E, Env, Ren, Ctxt, S0) ->
+ Vs = cerl:clause_vars(E),
+ {_, Env1, Ren1} = add_vars(Vs, Env, Ren),
+ %% Visit patterns to rename variables.
+ Ps = pattern_list(cerl:clause_pats(E), Env1, Ren1),
+ {G, S1} = guard_expr(cerl:clause_guard(E), Env1, Ren1, Ctxt, S0),
+ {B, S2} = expr(cerl:clause_body(E), Env1, Ren1, Ctxt, S1),
+ {cerl:update_c_clause(E, Ps, G, B), S2}.
+
+%% This does what 'expr' does, but only recurses into clause guard
+%% expressions, 'case'-expressions, and the bodies of lets and letrecs.
+%% Note that revisiting should not add further renamings, and we simply
+%% ignore making any bindings at all at this level.
+
+revisit_expr(E, Env, Ren, Ctxt, S0) ->
+ %% Also enable peephole optimizations here.
+ revisit_expr_1(cerl_lib:reduce_expr(E), Env, Ren, Ctxt, S0).
+
+revisit_expr_1(E, Env, Ren, Ctxt, S0) ->
+ case cerl:type(E) of
+ 'case' ->
+ {Cs, S1} = revisit_clause_list(cerl:case_clauses(E), Env,
+ Ren, Ctxt, S0),
+ {cerl:update_c_case(E, cerl:case_arg(E), Cs), S1};
+ 'let' ->
+ {B, S1} = revisit_expr(cerl:let_body(E), Env, Ren, Ctxt, S0),
+ {cerl:update_c_let(E, cerl:let_vars(E), cerl:let_arg(E), B),
+ S1};
+ 'letrec' ->
+ {B, S1} = revisit_expr(cerl:letrec_body(E), Env, Ren, Ctxt, S0),
+ {cerl:update_c_letrec(E, cerl:letrec_defs(E), B), S1};
+ _ ->
+ {E, S0}
+ end.
+
+revisit_clause_list(Cs, Env, Ren, Ctxt, S) ->
+ list(Cs, Env, Ren, Ctxt, S, fun revisit_clause/5).
+
+revisit_clause(E, Env, Ren, Ctxt, S0) ->
+ %% Ignore the bindings.
+ {G, S1} = guard_expr(cerl:clause_guard(E), Env, Ren, Ctxt, S0),
+ {B, S2} = revisit_expr(cerl:clause_body(E), Env, Ren, Ctxt, S1),
+ {cerl:update_c_clause(E, cerl:clause_pats(E), G, B), S2}.
+
+%% We use the no-shadowing strategy, renaming variables on the fly and
+%% only when necessary to uphold the invariant.
+
+add_vars(Vs, Env, Ren) ->
+ add_vars(Vs, [], Env, Ren).
+
+add_vars([V | Vs], Vs1, Env, Ren) ->
+ Name = cerl:var_name(V),
+ {Name1, Ren1} = rename(Name, Env, Ren),
+ add_vars(Vs, [cerl:update_c_var(V, Name1) | Vs1],
+ env__bind(Name1, variable, Env), Ren1);
+add_vars([], Vs, Env, Ren) ->
+ {lists:reverse(Vs), Env, Ren}.
+
+rename(Name, Env, Ren) ->
+ case env__is_defined(Name, Env) of
+ false ->
+ {Name, Ren};
+ true ->
+ New = env__new_name(Env),
+ {New, ren__add(Name, New, Ren)}
+ end.
+
+%% Setting up the environment for a list of letrec-bound definitions.
+
+add_defs(Ds, Env, Ren) ->
+ add_defs(Ds, [], Env, Ren).
+
+add_defs([{V, F} | Ds], Ds1, Env, Ren) ->
+ Name = cerl:var_name(V),
+ {Name1, Ren1} =
+ case env__is_defined(Name, Env) of
+ false ->
+ {Name, Ren};
+ true ->
+ {N, A} = Name,
+ S = atom_to_list(N) ++ "_",
+ F = fun (Num) -> %% XXX: BUG: This should be F1
+ {list_to_atom(S ++ integer_to_list(Num)), A}
+ end,
+ New = env__new_function_name(F, Env),
+ {New, ren__add(Name, New, Ren)}
+ end,
+ add_defs(Ds, [{cerl:update_c_var(V, Name1), F} | Ds1],
+ env__bind(Name1, function, Env), Ren1);
+add_defs([], Ds, Env, Ren) ->
+ {lists:reverse(Ds), Env, Ren}.
+
+%% We change remote calls to important built-in functions into primop
+%% calls. In some cases (e.g., for the boolean operators), this is
+%% mainly to allow the cerl_to_icode module to handle them more
+%% straightforwardly. In most cases however, it is simply because they
+%% are supposed to be represented as primop calls on the Icode level.
+
+rewrite_call(E, M, F, As, S) ->
+ case cerl:is_c_atom(M) and cerl:is_c_atom(F) of
+ true ->
+ case call_to_primop(cerl:atom_val(M),
+ cerl:atom_val(F),
+ length(As))
+ of
+ {yes, N} ->
+ %% The primop might need further handling
+ N1 = cerl:c_atom(N),
+ E1 = cerl:update_c_primop(E, N1, As),
+ rewrite_primop(E1, N1, As, S);
+ no ->
+ cerl:update_c_call(E, M, F, As)
+ end;
+ false ->
+ cerl:update_c_call(E, M, F, As)
+ end.
+
+call_to_primop(erlang, 'not', 1) -> {yes, ?PRIMOP_NOT};
+call_to_primop(erlang, 'and', 2) -> {yes, ?PRIMOP_AND};
+call_to_primop(erlang, 'or', 2) -> {yes, ?PRIMOP_OR};
+call_to_primop(erlang, 'xor', 2) -> {yes, ?PRIMOP_XOR};
+call_to_primop(erlang, '+', 2) -> {yes, ?PRIMOP_ADD};
+call_to_primop(erlang, '+', 1) -> {yes, ?PRIMOP_IDENTITY};
+call_to_primop(erlang, '-', 2) -> {yes, ?PRIMOP_SUB};
+call_to_primop(erlang, '-', 1) -> {yes, ?PRIMOP_NEG};
+call_to_primop(erlang, '*', 2) -> {yes, ?PRIMOP_MUL};
+call_to_primop(erlang, '/', 2) -> {yes, ?PRIMOP_DIV};
+call_to_primop(erlang, 'div', 2) -> {yes, ?PRIMOP_INTDIV};
+call_to_primop(erlang, 'rem', 2) -> {yes, ?PRIMOP_REM};
+call_to_primop(erlang, 'band', 2) -> {yes, ?PRIMOP_BAND};
+call_to_primop(erlang, 'bor', 2) -> {yes, ?PRIMOP_BOR};
+call_to_primop(erlang, 'bxor', 2) -> {yes, ?PRIMOP_BXOR};
+call_to_primop(erlang, 'bnot', 1) -> {yes, ?PRIMOP_BNOT};
+call_to_primop(erlang, 'bsl', 2) -> {yes, ?PRIMOP_BSL};
+call_to_primop(erlang, 'bsr', 2) -> {yes, ?PRIMOP_BSR};
+call_to_primop(erlang, '==', 2) -> {yes, ?PRIMOP_EQ};
+call_to_primop(erlang, '/=', 2) -> {yes, ?PRIMOP_NE};
+call_to_primop(erlang, '=:=', 2) -> {yes, ?PRIMOP_EXACT_EQ};
+call_to_primop(erlang, '=/=', 2) -> {yes, ?PRIMOP_EXACT_NE};
+call_to_primop(erlang, '<', 2) -> {yes, ?PRIMOP_LT};
+call_to_primop(erlang, '>', 2) -> {yes, ?PRIMOP_GT};
+call_to_primop(erlang, '=<', 2) -> {yes, ?PRIMOP_LE};
+call_to_primop(erlang, '>=', 2) -> {yes, ?PRIMOP_GE};
+call_to_primop(erlang, is_atom, 1) -> {yes, ?PRIMOP_IS_ATOM};
+call_to_primop(erlang, is_binary, 1) -> {yes, ?PRIMOP_IS_BINARY};
+call_to_primop(erlang, is_constant, 1) -> {yes, ?PRIMOP_IS_CONSTANT};
+call_to_primop(erlang, is_float, 1) -> {yes, ?PRIMOP_IS_FLOAT};
+call_to_primop(erlang, is_function, 1) -> {yes, ?PRIMOP_IS_FUNCTION};
+call_to_primop(erlang, is_integer, 1) -> {yes, ?PRIMOP_IS_INTEGER};
+call_to_primop(erlang, is_list, 1) -> {yes, ?PRIMOP_IS_LIST};
+call_to_primop(erlang, is_number, 1) -> {yes, ?PRIMOP_IS_NUMBER};
+call_to_primop(erlang, is_pid, 1) -> {yes, ?PRIMOP_IS_PID};
+call_to_primop(erlang, is_port, 1) -> {yes, ?PRIMOP_IS_PORT};
+call_to_primop(erlang, is_reference, 1) -> {yes, ?PRIMOP_IS_REFERENCE};
+call_to_primop(erlang, is_tuple, 1) -> {yes, ?PRIMOP_IS_TUPLE};
+call_to_primop(erlang, internal_is_record, 3) -> {yes, ?PRIMOP_IS_RECORD};
+call_to_primop(erlang, element, 2) -> {yes, ?PRIMOP_ELEMENT};
+call_to_primop(erlang, exit, 1) -> {yes, ?PRIMOP_EXIT};
+call_to_primop(erlang, throw, 1) -> {yes, ?PRIMOP_THROW};
+call_to_primop(erlang, error, 1) -> {yes, ?PRIMOP_ERROR};
+call_to_primop(erlang, error, 2) -> {yes, ?PRIMOP_ERROR};
+call_to_primop(erlang, fault, 1) -> {yes, ?PRIMOP_ERROR};
+call_to_primop(erlang, fault, 2) -> {yes, ?PRIMOP_ERROR};
+call_to_primop(_, _, _) -> no.
+
+%% Also, some primops (introduced by Erlang to Core Erlang translation
+%% and possibly other stages) must be recognized and rewritten.
+
+rewrite_primop(E, N, As, S) ->
+ case {cerl:atom_val(N), As} of
+ {match_fail, [R]} ->
+ M = s__get_module_name(S),
+ {F, A} = s__get_function_name(S),
+ Stack = cerl:abstract([{M, F, A}]),
+ case cerl:type(R) of
+ tuple ->
+ %% Function clause failures have a special encoding
+ %% as '{function_clause, Arg1, ..., ArgN}'.
+ case cerl:tuple_es(R) of
+ [X | Xs] ->
+ case cerl:is_c_atom(X) of
+ true ->
+ case cerl:atom_val(X) of
+ function_clause ->
+ FStack = cerl:make_list(
+ [cerl:c_tuple(
+ [cerl:c_atom(M),
+ cerl:c_atom(F),
+ cerl:make_list(Xs)])]),
+ match_fail(E, X, FStack);
+ _ ->
+ match_fail(E, R, Stack)
+ end;
+ false ->
+ match_fail(E, R, Stack)
+ end;
+ _ ->
+ match_fail(E, R, Stack)
+ end;
+ _ ->
+ match_fail(E, R, Stack)
+ end;
+ _ ->
+ cerl:update_c_primop(E, N, As)
+ end.
+
+match_fail(E, R, Stack) ->
+ cerl:update_c_primop(E, cerl:c_atom(?PRIMOP_ERROR), [R, Stack]).
+
+%% Simple let-definitions (of degree 1) in guard context are always
+%% inline expanded. This is allowable, since they cannot have side
+%% effects, and it makes it easy to generate good code for boolean
+%% expressions. It could cause repeated evaluations, but typically,
+%% local definitions within guards are used exactly once.
+
+let_expr(E, Env, Ren, Ctxt, S) ->
+ if Ctxt#ctxt.class == guard ->
+ case cerl:let_vars(E) of
+ [V] ->
+ {Name, Ren1} = rename(cerl:var_name(V), Env, Ren),
+ Env1 = env__bind(Name, {expr, cerl:let_arg(E)}, Env),
+ expr(cerl:let_body(E), Env1, Ren1, Ctxt, S);
+ _ ->
+ let_expr_1(E, Env, Ren, Ctxt, S)
+ end;
+ true ->
+ let_expr_1(E, Env, Ren, Ctxt, S)
+ end.
+
+let_expr_1(E, Env, Ren, Ctxt, S0) ->
+ {A, S1} = expr(cerl:let_arg(E), Env, Ren, Ctxt, S0),
+ Vs = cerl:let_vars(E),
+ {Vs1, Env1, Ren1} = add_vars(Vs, Env, Ren),
+ {B, S2} = expr(cerl:let_body(E), Env1, Ren1, Ctxt, S1),
+ {cerl:update_c_let(E, Vs1, A, B), S2}.
+
+variable(E, Env, Ren, Ctxt, S) ->
+ V = ren__map(cerl:var_name(E), Ren),
+ if Ctxt#ctxt.class == guard ->
+ case env__lookup(V, Env) of
+ {ok, {expr, E1}} ->
+ expr(E1, Env, Ren, Ctxt, S); % inline
+ _ ->
+ %% Since we don't track all bindings when we revisit
+ %% guards, some names will not be in the environment.
+ variable_1(E, V, S)
+ end;
+ true ->
+ variable_1(E, V, S)
+ end.
+
+variable_1(E, V, S) ->
+ {cerl:update_c_var(E, V), S}.
+
+%% A catch-expression 'catch Expr' is rewritten as:
+%%
+%% try Expr
+%% of (V) -> V
+%% catch (T, V, E) ->
+%% letrec 'wrap'/1 = fun (V) -> {'EXIT', V}
+%% in case T of
+%% 'throw' when 'true' -> V
+%% 'exit' when 'true' -> 'wrap'/1(V)
+%% V when 'true' ->
+%% 'wrap'/1({V, erlang:get_stacktrace()})
+%% end
+
+catch_expr(E, Env, Ren, Ctxt, S) ->
+ T = cerl:c_var('T'),
+ V = cerl:c_var('V'),
+ X = cerl:c_var('X'),
+ W = cerl:c_var({wrap,1}),
+ G = cerl:c_call(cerl:c_atom('erlang'),cerl:c_atom('get_stacktrace'),[]),
+ Cs = [cerl:c_clause([cerl:c_atom('throw')], V),
+ cerl:c_clause([cerl:c_atom('exit')], cerl:c_apply(W, [V])),
+ cerl:c_clause([T], cerl:c_apply(W, [cerl:c_tuple([V,G])]))
+ ],
+ C = cerl:c_case(T, Cs),
+ F = cerl:c_fun([V], cerl:c_tuple([cerl:c_atom('EXIT'), V])),
+ H = cerl:c_letrec([{W,F}], C),
+ As = cerl:get_ann(E),
+ {B, S1} = expr(cerl:catch_body(E),Env, Ren, Ctxt, S),
+ {cerl:ann_c_try(As, B, [V], V, [T,V,X], H), S1}.
+
+%% Receive-expressions are rewritten as follows:
+%%
+%% receive
+%% P1 when G1 -> B1
+%% ...
+%% Pn when Gn -> Bn
+%% after T -> A end
+%% becomes:
+%% receive
+%% M when 'true' ->
+%% case M of
+%% P1 when G1 -> do primop RECEIVE_SELECT B1
+%% ...
+%% Pn when Gn -> do primop RECEIVE_SELECT Bn
+%% Pn+1 when 'true' -> primop RECEIVE_NEXT()
+%% end
+%% after T -> A end
+
+receive_expr(E, Env, Ren, Ctxt, S0) ->
+ Cs = cerl:receive_clauses(E),
+ {B, Vs, S1} = clauses(receive_clauses(Cs), Env, Ren, Ctxt, S0),
+ {T, S2} = expr(cerl:receive_timeout(E), Env, Ren, Ctxt, S1),
+ {A, S3} = expr(cerl:receive_action(E), Env, Ren, Ctxt, S2),
+ Cs1 = [cerl:c_clause(Vs, B)],
+ {cerl:update_c_receive(E, Cs1, T, A), S3}.
+
+receive_clauses([C | Cs]) ->
+ Call = cerl:c_primop(cerl:c_atom(?PRIMOP_RECEIVE_SELECT),
+ []),
+ B = cerl:c_seq(Call, cerl:clause_body(C)),
+ C1 = cerl:update_c_clause(C, cerl:clause_pats(C),
+ cerl:clause_guard(C), B),
+ [C1 | receive_clauses(Cs)];
+receive_clauses([]) ->
+ Call = cerl:c_primop(cerl:c_atom(?PRIMOP_RECEIVE_NEXT),
+ []),
+ V = cerl:c_var('X'), % any name is ok
+ [cerl:c_clause([V], Call)].
+
+
+new_vars(N, Env) ->
+ [cerl:c_var(V) || V <- env__new_names(N, Env)].
+
+
+%% ---------------------------------------------------------------------
+%% Environment
+
+env__new() ->
+ rec_env:empty().
+
+env__bind(Key, Value, Env) ->
+ rec_env:bind(Key, Value, Env).
+
+%% env__get(Key, Env) ->
+%% rec_env:get(Key, Env).
+
+env__lookup(Key, Env) ->
+ rec_env:lookup(Key, Env).
+
+env__is_defined(Key, Env) ->
+ rec_env:is_defined(Key, Env).
+
+env__new_name(Env) ->
+ rec_env:new_key(Env).
+
+env__new_names(N, Env) ->
+ rec_env:new_keys(N, Env).
+
+env__new_function_name(F, Env) ->
+ rec_env:new_key(F, Env).
+
+
+%% ---------------------------------------------------------------------
+%% Renaming
+
+ren__new() ->
+ dict:new().
+
+ren__add(Key, Value, Ren) ->
+ dict:store(Key, Value, Ren).
+
+ren__map(Key, Ren) ->
+ case dict:find(Key, Ren) of
+ {ok, Value} ->
+ Value;
+ error ->
+ Key
+ end.
+
+
+%% ---------------------------------------------------------------------
+%% State
+
+-record(state, {module, function, pmatch=true}).
+
+s__new(Module) ->
+ #state{module = Module}.
+
+s__get_module_name(S) ->
+ S#state.module.
+
+s__enter_function(F, S) ->
+ S#state{function = F}.
+
+s__get_function_name(S) ->
+ S#state.function.
+
+s__set_pmatch(V, S) ->
+ S#state{pmatch = V}.
+
+s__get_pmatch(S) ->
+ S#state.pmatch.
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/comm_layer/comm_acceptor.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/comm_layer/comm_acceptor.erl
new file mode 100644
index 0000000000..2aef625dc6
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/comm_layer/comm_acceptor.erl
@@ -0,0 +1,120 @@
+% Copyright 2008 Konrad-Zuse-Zentrum für Informationstechnik Berlin
+%
+% Licensed under the Apache License, Version 2.0 (the "License");
+% you may not use this file except in compliance with the License.
+% You may obtain a copy of the License at
+%
+% http://www.apache.org/licenses/LICENSE-2.0
+%
+% Unless required by applicable law or agreed to in writing, software
+% distributed under the License is distributed on an "AS IS" BASIS,
+% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+% See the License for the specific language governing permissions and
+% limitations under the License.
+%%%-------------------------------------------------------------------
+%%% File : comm_acceptor.erl
+%%% Author : Thorsten Schuett <[email protected]>
+%%% Description : Acceptor
+%%% This module accepts new connections and starts corresponding
+%%% comm_connection processes.
+%%%
+%%% Created : 18 Apr 2008 by Thorsten Schuett <[email protected]>
+%%%-------------------------------------------------------------------
+%% @author Thorsten Schuett <[email protected]>
+%% @copyright 2008 Konrad-Zuse-Zentrum für Informationstechnik Berlin
+%% @version $Id $
+-module(comm_layer_dir.comm_acceptor).
+
+-export([start_link/1, init/2]).
+
+-import(config).
+-import(gen_tcp).
+-import(inet).
+-import(log).
+-import(lists).
+-import(process_dictionary).
+
+start_link(InstanceId) ->
+ Pid = spawn_link(comm_layer_dir.comm_acceptor, init, [InstanceId, self()]),
+ receive
+ {started} ->
+ {ok, Pid}
+ end.
+
+init(InstanceId, Supervisor) ->
+ process_dictionary:register_process(InstanceId, acceptor, self()),
+ erlang:register(comm_layer_acceptor, self()),
+ log:log(info,"[ CC ] listening on ~p:~p", [config:listenIP(), config:listenPort()]),
+ LS = case config:listenIP() of
+ undefined ->
+ open_listen_port(config:listenPort(), first_ip());
+ _ ->
+ open_listen_port(config:listenPort(), config:listenIP())
+ end,
+ {ok, {_LocalAddress, LocalPort}} = inet:sockname(LS),
+ comm_port:set_local_address(undefined, LocalPort),
+ %io:format("this() == ~w~n", [{LocalAddress, LocalPort}]),
+ Supervisor ! {started},
+ server(LS).
+
+server(LS) ->
+ case gen_tcp:accept(LS) of
+ {ok, S} ->
+ case comm_port:get_local_address_port() of
+ {undefined, LocalPort} ->
+ {ok, {MyIP, _LocalPort}} = inet:sockname(S),
+ comm_port:set_local_address(MyIP, LocalPort);
+ _ ->
+ ok
+ end,
+ receive
+ {tcp, S, Msg} ->
+ {endpoint, Address, Port} = binary_to_term(Msg),
+ % auto determine remote address, when not sent correctly
+ NewAddress = if Address =:= {0,0,0,0} orelse Address =:= {127,0,0,1} ->
+ case inet:peername(S) of
+ {ok, {PeerAddress, _Port}} ->
+ % io:format("Sent Address ~p\n",[Address]),
+ % io:format("Peername is ~p\n",[PeerAddress]),
+ PeerAddress;
+ {error, _Why} ->
+ % io:format("Peername error ~p\n",[Why]).
+ Address
+ end;
+ true ->
+ % io:format("Address is ~p\n",[Address]),
+ Address
+ end,
+ NewPid = comm_connection:new(NewAddress, Port, S),
+ gen_tcp:controlling_process(S, NewPid),
+ inet:setopts(S, [{active, once}, {send_timeout, config:read(tcp_send_timeout)}]),
+ comm_port:register_connection(NewAddress, Port, NewPid, S)
+ end,
+ server(LS);
+ Other ->
+ log:log(warn,"[ CC ] unknown message ~p", [Other])
+ end.
+
+open_listen_port({From, To}, IP) ->
+ open_listen_port(lists:seq(From, To), IP);
+open_listen_port([Port | Rest], IP) ->
+ case gen_tcp:listen(Port, [binary, {packet, 4}, {reuseaddr, true},
+ {active, once}, {ip, IP}]) of
+ {ok, Socket} ->
+ Socket;
+ {error, Reason} ->
+ log:log(error,"[ CC ] can't listen on ~p: ~p~n", [Port, Reason]),
+ open_listen_port(Rest, IP)
+ end;
+open_listen_port([], _) ->
+ abort;
+open_listen_port(Port, IP) ->
+ open_listen_port([Port], IP).
+
+-include_lib("kernel/include/inet.hrl").
+
+first_ip() ->
+ {ok, Hostname} = inet:gethostname(),
+ {ok, HostEntry} = inet:gethostbyname(Hostname),
+ erlang:hd(HostEntry#hostent.h_addr_list).
+
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/comm_layer/comm_connection.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/comm_layer/comm_connection.erl
new file mode 100644
index 0000000000..8dca647f6d
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/comm_layer/comm_connection.erl
@@ -0,0 +1,206 @@
+% Copyright 2008 Konrad-Zuse-Zentrum f�r Informationstechnik Berlin
+%
+% Licensed under the Apache License, Version 2.0 (the "License");
+% you may not use this file except in compliance with the License.
+% You may obtain a copy of the License at
+%
+% http://www.apache.org/licenses/LICENSE-2.0
+%
+% Unless required by applicable law or agreed to in writing, software
+% distributed under the License is distributed on an "AS IS" BASIS,
+% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+% See the License for the specific language governing permissions and
+% limitations under the License.
+%%%-------------------------------------------------------------------
+%%% File : comm_connection.erl
+%%% Author : Thorsten Schuett <[email protected]>
+%%% Description : creates and destroys connections and represents the
+%%% endpoint of a connection where messages are received and
+%% send from/to the network.
+%%%
+%%% Created : 18 Apr 2008 by Thorsten Schuett <[email protected]>
+%%%-------------------------------------------------------------------
+%% @author Thorsten Schuett <[email protected]>
+%% @copyright 2008 Konrad-Zuse-Zentrum f�r Informationstechnik Berlin
+%% @version $Id $
+-module(comm_layer_dir.comm_connection).
+
+-export([send/3, open_new/4, new/3, open_new_async/4]).
+
+-import(config).
+-import(gen_tcp).
+-import(inet).
+-import(io).
+-import(io_lib).
+-import(log).
+-import(timer).
+
+-include("comm_layer.hrl").
+
+%% @doc new accepted connection. called by comm_acceptor
+%% @spec new(inet:ip_address(), int(), socket()) -> pid()
+new(Address, Port, Socket) ->
+ spawn(fun () -> loop(Socket, Address, Port) end).
+
+%% @doc open new connection
+%% @spec open_new(inet:ip_address(), int(), inet:ip_address(), int()) ->
+%% {local_ip, inet:ip_address(), int(), pid(), inet:socket()}
+%% | fail
+%% | {connection, pid(), inet:socket()}
+open_new(Address, Port, undefined, MyPort) ->
+ Myself = self(),
+ LocalPid = spawn(fun () ->
+ case new_connection(Address, Port, MyPort) of
+ fail ->
+ Myself ! {new_connection_failed};
+ Socket ->
+ {ok, {MyIP, _MyPort}} = inet:sockname(Socket),
+ Myself ! {new_connection_started, MyIP, MyPort, Socket},
+ loop(Socket, Address, Port)
+ end
+ end),
+ receive
+ {new_connection_failed} ->
+ fail;
+ {new_connection_started, MyIP, MyPort, S} ->
+ {local_ip, MyIP, MyPort, LocalPid, S}
+ end;
+open_new(Address, Port, _MyAddress, MyPort) ->
+ Owner = self(),
+ LocalPid = spawn(fun () ->
+ case new_connection(Address, Port, MyPort) of
+ fail ->
+ Owner ! {new_connection_failed};
+ Socket ->
+ Owner ! {new_connection_started, Socket},
+ loop(Socket, Address, Port)
+ end
+ end),
+ receive
+ {new_connection_failed} ->
+ fail;
+ {new_connection_started, Socket} ->
+ {connection, LocalPid, Socket}
+ end.
+
+% ===============================================================================
+% @doc open a new connection asynchronously
+% ===============================================================================
+-spec(open_new_async/4 :: (any(), any(), any(), any()) -> pid()).
+open_new_async(Address, Port, _MyAddr, MyPort) ->
+ Pid = spawn(fun () ->
+ case new_connection(Address, Port, MyPort) of
+ fail ->
+ comm_port:unregister_connection(Address, Port),
+ ok;
+ Socket ->
+ loop(Socket, Address, Port)
+ end
+ end),
+ Pid.
+
+
+send({Address, Port, Socket}, Pid, Message) ->
+ BinaryMessage = term_to_binary({deliver, Pid, Message}),
+ SendTimeout = config:read(tcp_send_timeout),
+ {Time, Result} = timer:tc(gen_tcp, send, [Socket, BinaryMessage]),
+ if
+ Time > 1200 * SendTimeout ->
+ log:log(error,"[ CC ] send to ~p took ~p: ~p",
+ [Address, Time, inet:getopts(Socket, [keep_alive, send_timeout])]);
+ true ->
+ ok
+ end,
+ case Result of
+ ok ->
+ ?LOG_MESSAGE(erlang:element(1, Message), byte_size(BinaryMessage)),
+ ok;
+ {error, closed} ->
+ comm_port:unregister_connection(Address, Port),
+ close_connection(Socket);
+ {error, _Reason} ->
+ %log:log(error,"[ CC ] couldn't send to ~p:~p (~p)", [Address, Port, Reason]),
+ comm_port:unregister_connection(Address, Port),
+ close_connection(Socket)
+ end.
+
+loop(fail, Address, Port) ->
+ comm_port:unregister_connection(Address, Port),
+ ok;
+loop(Socket, Address, Port) ->
+ receive
+ {send, Pid, Message} ->
+ case send({Address, Port, Socket}, Pid, Message) of
+ ok -> loop(Socket, Address, Port);
+ _ -> ok
+ end;
+ {tcp_closed, Socket} ->
+ comm_port:unregister_connection(Address, Port),
+ gen_tcp:close(Socket);
+ {tcp, Socket, Data} ->
+ case binary_to_term(Data) of
+ {deliver, Process, Message} ->
+ Process ! Message,
+ inet:setopts(Socket, [{active, once}]),
+ loop(Socket, Address, Port);
+ {user_close} ->
+ comm_port:unregister_connection(Address, Port),
+ gen_tcp:close(Socket);
+ {youare, _Address, _Port} ->
+ %% @TODO what do we get from this information?
+ inet:setopts(Socket, [{active, once}]),
+ loop(Socket, Address, Port);
+ Unknown ->
+ log:log(warn,"[ CC ] unknown message ~p", [Unknown]),
+ inet:setopts(Socket, [{active, once}]),
+ loop(Socket, Address, Port)
+ end;
+
+ {youare, _IP, _Port} ->
+ loop(Socket, Address, Port);
+
+ Unknown ->
+ log:log(warn,"[ CC ] unknown message2 ~p", [Unknown]) ,
+ loop(Socket, Address, Port)
+ end.
+
+% ===============================================================================
+
+-spec(new_connection(inet:ip_address(), integer(), integer()) -> inet:socket() | fail).
+new_connection(Address, Port, MyPort) ->
+ case gen_tcp:connect(Address, Port, [binary, {packet, 4}, {nodelay, true}, {active, once},
+ {send_timeout, config:read(tcp_send_timeout)}],
+ config:read(tcp_connect_timeout)) of
+ {ok, Socket} ->
+ % send end point data
+ case inet:sockname(Socket) of
+ {ok, {MyAddress, _MyPort}} ->
+ Message = term_to_binary({endpoint, MyAddress, MyPort}),
+ gen_tcp:send(Socket, Message),
+ case inet:peername(Socket) of
+ {ok, {RemoteIP, RemotePort}} ->
+ YouAre = term_to_binary({youare, RemoteIP, RemotePort}),
+ gen_tcp:send(Socket, YouAre),
+ Socket;
+ {error, _Reason} ->
+ %log:log(error,"[ CC ] reconnect to ~p because socket is ~p",
+ % [Address, Reason]),
+ close_connection(Socket),
+ new_connection(Address, Port, MyPort)
+ end;
+ {error, _Reason} ->
+ %log:log(error,"[ CC ] reconnect to ~p because socket is ~p",
+ % [Address, Reason]),
+ close_connection(Socket),
+ new_connection(Address, Port, MyPort)
+ end;
+ {error, _Reason} ->
+ %log:log(error,"[ CC ] couldn't connect to ~p:~p (~p)",
+ %[Address, Port, Reason]),
+ fail
+ end.
+
+close_connection(Socket) ->
+ spawn( fun () ->
+ gen_tcp:close(Socket)
+ end ).
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/comm_layer/comm_layer.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/comm_layer/comm_layer.erl
new file mode 100644
index 0000000000..f48324e49c
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/comm_layer/comm_layer.erl
@@ -0,0 +1,83 @@
+% Copyright 2008 Konrad-Zuse-Zentrum für Informationstechnik Berlin
+%
+% Licensed under the Apache License, Version 2.0 (the "License");
+% you may not use this file except in compliance with the License.
+% You may obtain a copy of the License at
+%
+% http://www.apache.org/licenses/LICENSE-2.0
+%
+% Unless required by applicable law or agreed to in writing, software
+% distributed under the License is distributed on an "AS IS" BASIS,
+% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+% See the License for the specific language governing permissions and
+% limitations under the License.
+%%%-------------------------------------------------------------------
+%%% File : comm_layer.erl
+%%% Author : Thorsten Schuett <[email protected]>
+%%% Description : Public interface to Communication Layer.
+%%% Generic functions to send messages.
+%%% Distinguishes on runtime whether the destination is in the
+%%% same Erlang virtual machine (use ! for sending) or on a remote
+%%% site (use comm_port:send()).
+%%%
+%%% Created : 04 Feb 2008 by Thorsten Schuett <[email protected]>
+%%%-------------------------------------------------------------------
+%% @author Thorsten Schuett <[email protected]>
+%% @copyright 2008 Konrad-Zuse-Zentrum für Informationstechnik Berlin
+%% @version $Id $
+-module(comm_layer_dir.comm_layer).
+
+-author('[email protected]').
+-vsn('$Id: comm_layer.erl,v 1.1 2009/11/06 12:41:36 maria Exp $ ').
+
+-export([start_link/0, send/2, this/0, here/1]).
+
+-import(io).
+-import(util).
+-import(log).
+
+-include("comm_layer.hrl").
+
+
+% @TODO: should be ip
+-type(process_id() :: {any(), integer(), pid()}).
+%%====================================================================
+%% public functions
+%%====================================================================
+
+%% @doc starts the communication port (for supervisor)
+%% @spec start_link() -> {ok,Pid} | ignore | {error,Error}
+start_link() ->
+ comm_port_sup:start_link().
+
+%% @doc a process descriptor has to specify the erlang vm
+%% + the process inside. {IP address, port, pid}
+%% @type process_id() = {inet:ip_address(), int(), pid()}.
+%% @spec send(process_id(), term()) -> ok
+
+send({{_IP1, _IP2, _IP3, _IP4} = _IP, _Port, _Pid} = Target, Message) ->
+ {MyIP,MyPort} = comm_port:get_local_address_port(),
+ %io:format("send: ~p:~p -> ~p:~p(~p) : ~p\n", [MyIP, MyPort, _IP, _Port, _Pid, Message]),
+ IsLocal = (MyIP == _IP) and (MyPort == _Port),
+ if
+ IsLocal ->
+ ?LOG_MESSAGE(erlang:element(1, Message), byte_size(term_to_binary(Message))),
+ _Pid ! Message;
+ true ->
+ comm_port:send(Target, Message)
+ end;
+
+send(Target, Message) ->
+ log:log(error,"[ CC ] wrong call to cs_send:send: ~w ! ~w", [Target, Message]),
+ log:log(error,"[ CC ] stacktrace: ~w", [util:get_stacktrace()]),
+ ok.
+
+%% @doc returns process descriptor for the calling process
+-spec(this/0 :: () -> atom()).%process_id()).
+this() ->
+ here(self()).
+
+-spec(here/1 :: (pid()) -> process_id()).
+here(Pid) ->
+ {LocalIP, LocalPort} = comm_port:get_local_address_port(),
+ {LocalIP, LocalPort, Pid}.
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/comm_layer/comm_layer.hrl b/lib/dialyzer/test/small_tests_SUITE_data/src/comm_layer/comm_layer.hrl
new file mode 100644
index 0000000000..f4e4d560f7
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/comm_layer/comm_layer.hrl
@@ -0,0 +1,30 @@
+% Copyright 2008 Konrad-Zuse-Zentrum für Informationstechnik Berlin
+%
+% Licensed under the Apache License, Version 2.0 (the "License");
+% you may not use this file except in compliance with the License.
+% You may obtain a copy of the License at
+%
+% http://www.apache.org/licenses/LICENSE-2.0
+%
+% Unless required by applicable law or agreed to in writing, software
+% distributed under the License is distributed on an "AS IS" BASIS,
+% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+% See the License for the specific language governing permissions and
+% limitations under the License.
+%%%-------------------------------------------------------------------
+%%% File : comm_layer.hrl
+%%% Author : Thorsten Schuett <[email protected]>
+%%% Description :
+%%%
+%%% Created : 31 Jul 2008 by Thorsten Schuett <[email protected]>
+%%%-------------------------------------------------------------------
+%% @author Thorsten Schuett <[email protected]>
+%% @copyright 2008 Konrad-Zuse-Zentrum für Informationstechnik Berlin
+%% @version $Id: comm_layer.hrl,v 1.1 2009/11/06 12:41:36 maria Exp $
+-author('[email protected]').
+-vsn('$Id: comm_layer.hrl,v 1.1 2009/11/06 12:41:36 maria Exp $ ').
+
+% enable logging of message statistics
+%-define(LOG_MESSAGE(TAG, SIZE), comm_layer.comm_logger:log(TAG, SIZE)).
+-define(LOG_MESSAGE(TAG, SIZE), ok).
+
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/comm_layer/comm_logger.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/comm_layer/comm_logger.erl
new file mode 100644
index 0000000000..c70b0d3438
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/comm_layer/comm_logger.erl
@@ -0,0 +1,143 @@
+% Copyright 2008 Konrad-Zuse-Zentrum für Informationstechnik Berlin
+%
+% Licensed under the Apache License, Version 2.0 (the "License");
+% you may not use this file except in compliance with the License.
+% You may obtain a copy of the License at
+%
+% http://www.apache.org/licenses/LICENSE-2.0
+%
+% Unless required by applicable law or agreed to in writing, software
+% distributed under the License is distributed on an "AS IS" BASIS,
+% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+% See the License for the specific language governing permissions and
+% limitations under the License.
+%%%-------------------------------------------------------------------
+%%% File : comm_logger.erl
+%%% Author : Thorsten Schuett <[email protected]>
+%%% Description :
+%%%
+%%% Created : 31 Jul 2008 by Thorsten Schuett <[email protected]>
+%%%-------------------------------------------------------------------
+%% @author Thorsten Schuett <[email protected]>
+%% @copyright 2008 Konrad-Zuse-Zentrum für Informationstechnik Berlin
+%% @version $Id: comm_logger.erl,v 1.1 2009/11/06 12:41:36 maria Exp $
+-module(comm_layer_dir.comm_logger).
+
+-author('[email protected]').
+-vsn('$Id: comm_logger.erl,v 1.1 2009/11/06 12:41:36 maria Exp $ ').
+
+-behaviour(gen_server).
+
+-import(gb_trees).
+-import(gen_server).
+
+%% API
+-export([start_link/0]).
+
+-export([log/2, dump/0]).
+
+%% gen_server callbacks
+-export([init/1, handle_call/3, handle_cast/2, handle_info/2,
+ terminate/2, code_change/3]).
+
+-record(state, {start, map}).
+
+%%====================================================================
+%% API
+%%====================================================================
+%%--------------------------------------------------------------------
+%% Function: start_link() -> {ok,Pid} | ignore | {error,Error}
+%% Description: Starts the server
+%%--------------------------------------------------------------------
+start_link() ->
+ gen_server:start_link({local, ?MODULE}, ?MODULE, [], []).
+
+%%--------------------------------------------------------------------
+%% Function: log(Tag, Size) -> ok
+%% Description: logs a message type with its size
+%%--------------------------------------------------------------------
+log(Tag, Size) ->
+ gen_server:cast(?MODULE, {log, Tag, Size}).
+
+%%--------------------------------------------------------------------
+%% Function: dump() -> {gb_tree:gb_trees(), {Date, Time}}
+%% Description: gets the logging state
+%%--------------------------------------------------------------------
+dump() ->
+ gen_server:call(?MODULE, {dump}).
+
+%%====================================================================
+%% gen_server callbacks
+%%====================================================================
+
+%%--------------------------------------------------------------------
+%% Function: init(Args) -> {ok, State} |
+%% {ok, State, Timeout} |
+%% ignore |
+%% {stop, Reason}
+%% Description: Initiates the server
+%%--------------------------------------------------------------------
+init([]) ->
+ {ok, #state{start=erlang:now(), map=gb_trees:empty()}}.
+
+%%--------------------------------------------------------------------
+%% Function: %% handle_call(Request, From, State) -> {reply, Reply, State} |
+%% {reply, Reply, State, Timeout} |
+%% {noreply, State} |
+%% {noreply, State, Timeout} |
+%% {stop, Reason, Reply, State} |
+%% {stop, Reason, State}
+%% Description: Handling call messages
+%%--------------------------------------------------------------------
+handle_call({dump}, _From, State) ->
+ Reply = {State#state.map, State#state.start},
+ {reply, Reply, State};
+handle_call(_Request, _From, State) ->
+ Reply = ok,
+ {reply, Reply, State}.
+
+%%--------------------------------------------------------------------
+%% Function: handle_cast(Msg, State) -> {noreply, State} |
+%% {noreply, State, Timeout} |
+%% {stop, Reason, State}
+%% Description: Handling cast messages
+%%--------------------------------------------------------------------
+handle_cast({log, Tag, Size}, State) ->
+ case gb_trees:lookup(Tag, State#state.map) of
+ none ->
+ {noreply, State#state{map=gb_trees:insert(Tag, {Size, 1}, State#state.map)}};
+ {value, {OldSize, OldCount}} ->
+ {noreply, State#state{map=gb_trees:update(Tag, {Size + OldSize, OldCount + 1}, State#state.map)}}
+ end;
+handle_cast(_Msg, State) ->
+ {noreply, State}.
+
+%%--------------------------------------------------------------------
+%% Function: handle_info(Info, State) -> {noreply, State} |
+%% {noreply, State, Timeout} |
+%% {stop, Reason, State}
+%% Description: Handling all non call/cast messages
+%%--------------------------------------------------------------------
+handle_info(_Info, State) ->
+ {noreply, State}.
+
+%%--------------------------------------------------------------------
+%% Function: terminate(Reason, State) -> void()
+%% Description: This function is called by a gen_server when it is about to
+%% terminate. It should be the opposite of Module:init/1 and do any necessary
+%% cleaning up. When it returns, the gen_server terminates with Reason.
+%% The return value is ignored.
+%%--------------------------------------------------------------------
+terminate(_Reason, _State) ->
+ ok.
+
+%%--------------------------------------------------------------------
+%% Func: code_change(OldVsn, State, Extra) -> {ok, NewState}
+%% Description: Convert process state when code is changed
+%%--------------------------------------------------------------------
+code_change(_OldVsn, State, _Extra) ->
+ {ok, State}.
+
+%%--------------------------------------------------------------------
+%%% Internal functions
+%%--------------------------------------------------------------------
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/comm_layer/comm_port.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/comm_layer/comm_port.erl
new file mode 100644
index 0000000000..5eded48750
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/comm_layer/comm_port.erl
@@ -0,0 +1,240 @@
+% Copyright 2008 Konrad-Zuse-Zentrum f�r Informationstechnik Berlin
+%
+% Licensed under the Apache License, Version 2.0 (the "License");
+% you may not use this file except in compliance with the License.
+% You may obtain a copy of the License at
+%
+% http://www.apache.org/licenses/LICENSE-2.0
+%
+% Unless required by applicable law or agreed to in writing, software
+% distributed under the License is distributed on an "AS IS" BASIS,
+% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+% See the License for the specific language governing permissions and
+% limitations under the License.
+%%%-------------------------------------------------------------------
+%%% File : comm_port.erl
+%%% Author : Thorsten Schuett <[email protected]>
+%%% Description : Main CommLayer Interface
+%%% Maps remote addresses to comm_connection PIDs.
+%%%
+%%% Created : 18 Apr 2008 by Thorsten Schuett <[email protected]>
+%%%-------------------------------------------------------------------
+%% @author Thorsten Schuett <[email protected]>
+%% @copyright 2008 Konrad-Zuse-Zentrum f�r Informationstechnik Berlin
+%% @version $Id $
+-module(comm_layer_dir.comm_port).
+
+-author('[email protected]').
+-vsn('$Id: comm_port.erl,v 1.1 2009/11/06 12:41:36 maria Exp $ ').
+
+-behaviour(gen_server).
+
+-import(ets).
+-import(gen_server).
+-import(io).
+-import(log).
+
+-define(ASYNC, true).
+%-define(SYNC, true).
+
+%% API
+-export([start_link/0,
+ send/2,
+ unregister_connection/2, register_connection/4,
+ set_local_address/2, get_local_address_port/0]).
+
+%% gen_server callbacks
+-export([init/1, handle_call/3, handle_cast/2, handle_info/2,
+ terminate/2, code_change/3]).
+
+%%====================================================================
+%% API
+%%====================================================================
+
+%% @doc
+%% @spec send({inet:ip_address(), int(), pid()}, term()) -> ok
+-ifdef(ASYNC).
+send({Address, Port, Pid}, Message) ->
+ gen_server:call(?MODULE, {send, Address, Port, Pid, Message}, 20000).
+-endif.
+-ifdef(SYNC).
+send({Address, Port, Pid}, Message) ->
+ case ets:lookup(?MODULE, {Address, Port}) of
+ [{{Address, Port}, {_LPid, Socket}}] ->
+ comm_connection:send({Address, Port, Socket}, Pid, Message),
+ ok;
+ [] ->
+ gen_server:call(?MODULE, {send, Address, Port, Pid, Message}, 20000)
+ end.
+-endif.
+
+
+%% @doc
+%% @spec unregister_connection(inet:ip_address(), int()) -> ok
+unregister_connection(Adress, Port) ->
+ gen_server:call(?MODULE, {unregister_conn, Adress, Port}, 20000).
+
+%% @doc
+%% @spec register_connection(inet:ip_address(), int(), pid(), gen_tcp:socket()) -> ok | duplicate
+register_connection(Adress, Port, Pid, Socket) ->
+ gen_server:call(?MODULE, {register_conn, Adress, Port, Pid, Socket}, 20000).
+
+%% @doc
+%% @spec set_local_address(inet:ip_address(), int()) -> ok
+set_local_address(Address, Port) ->
+ gen_server:call(?MODULE, {set_local_address, Address, Port}, 20000).
+
+
+%% @doc
+%% @spec get_local_address_port() -> {inet:ip_address(),int()}
+get_local_address_port() ->
+ case ets:lookup(?MODULE, local_address_port) of
+ [{local_address_port, Value}] ->
+ Value;
+ [] ->
+ undefined
+ end.
+
+%%--------------------------------------------------------------------
+%% Function: start_link() -> {ok,Pid} | ignore | {error,Error}
+%% Description: Starts the server
+%%--------------------------------------------------------------------
+start_link() ->
+ gen_server:start_link({local, ?MODULE}, ?MODULE, [], []).
+
+%%====================================================================
+%% gen_server callbacks
+%%====================================================================
+
+%%--------------------------------------------------------------------
+%% Function: init(Args) -> {ok, State} |
+%% {ok, State, Timeout} |
+%% ignore |
+%% {stop, Reason}
+%% Description: Initiates the server
+%%--------------------------------------------------------------------
+init([]) ->
+ ets:new(?MODULE, [set, protected, named_table]),
+ {ok, ok}. % empty state.
+
+%%--------------------------------------------------------------------
+%% Function: %% handle_call(Request, From, State) -> {reply, Reply, State} |
+%% {reply, Reply, State, Timeout} |
+%% {noreply, State} |
+%% {noreply, State, Timeout} |
+%% {stop, Reason, Reply, State} |
+%% {stop, Reason, State}
+%% Description: Handling call messages
+%%--------------------------------------------------------------------
+handle_call({send, Address, Port, Pid, Message}, _From, State) ->
+ send(Address, Port, Pid, Message, State);
+
+handle_call({unregister_conn, Address, Port}, _From, State) ->
+ ets:delete(?MODULE, {Address, Port}),
+ {reply, ok, State};
+
+handle_call({register_conn, Address, Port, Pid, Socket}, _From, State) ->
+ case ets:lookup(?MODULE, {Address, Port}) of
+ [{{Address, Port}, _}] ->
+ {reply, duplicate, State};
+ [] ->
+ ets:insert(?MODULE, {{Address, Port}, {Pid, Socket}}),
+ {reply, ok, State}
+ end;
+
+handle_call({set_local_address, Address, Port}, _From, State) ->
+ ets:insert(?MODULE, {local_address_port, {Address,Port}}),
+ {reply, ok, State}.
+
+%%--------------------------------------------------------------------
+%% Function: handle_cast(Msg, State) -> {noreply, State} |
+%% {noreply, State, Timeout} |
+%% {stop, Reason, State}
+%% Description: Handling cast messages
+%%--------------------------------------------------------------------
+handle_cast(_Msg, State) ->
+ {noreply, State}.
+
+%%--------------------------------------------------------------------
+%% Function: handle_info(Info, State) -> {noreply, State} |
+%% {noreply, State, Timeout} |
+%% {stop, Reason, State}
+%% Description: Handling all non call/cast messages
+%%--------------------------------------------------------------------
+handle_info(_Info, State) ->
+ {noreply, State}.
+
+%%--------------------------------------------------------------------
+%% Function: terminate(Reason, State) -> void()
+%% Description: This function is called by a gen_server when it is about to
+%% terminate. It should be the opposite of Module:init/1 and do any necessary
+%% cleaning up. When it returns, the gen_server terminates with Reason.
+%% The return value is ignored.
+%%--------------------------------------------------------------------
+terminate(_Reason, _State) ->
+ ok.
+
+%%--------------------------------------------------------------------
+%% Func: code_change(OldVsn, State, Extra) -> {ok, NewState}
+%% Description: Convert process state when code is changed
+%%--------------------------------------------------------------------
+code_change(_OldVsn, State, _Extra) ->
+ {ok, State}.
+
+%%--------------------------------------------------------------------
+%%% Internal functions
+%%--------------------------------------------------------------------
+
+-ifdef(ASYNC).
+send(Address, Port, Pid, Message, State) ->
+ {DepAddr,DepPort} = get_local_address_port(),
+ if
+ DepAddr == undefined ->
+ open_sync_connection(Address, Port, Pid, Message, State);
+ true ->
+ case ets:lookup(?MODULE, {Address, Port}) of
+ [{{Address, Port}, {ConnPid, _Socket}}] ->
+ ConnPid ! {send, Pid, Message},
+ {reply, ok, State};
+ [] ->
+ ConnPid = comm_connection:open_new_async(Address, Port,
+ DepAddr, DepPort),
+ ets:insert(?MODULE, {{Address, Port}, {ConnPid, undef}}),
+ ConnPid ! {send, Pid, Message},
+ {reply, ok, State}
+ end
+ end.
+-endif.
+
+-ifdef(SYNC).
+send(Address, Port, Pid, Message, State) ->
+ case ets:lookup(?MODULE, {Address, Port}) of
+ [{{Address, Port}, {_LPid, Socket}}] ->
+ comm_connection:send({Address, Port, Socket}, Pid, Message),
+ {reply, ok, State};
+ [] ->
+ open_sync_connection(Address, Port, Pid, Message, State)
+ end.
+-endif.
+
+
+open_sync_connection(Address, Port, Pid, Message, State) ->
+ {DepAddr,DepPort} = get_local_address_port(),
+ case comm_connection:open_new(Address, Port, DepAddr, DepPort) of
+ {local_ip, MyIP, MyPort, MyPid, MySocket} ->
+ comm_connection:send({Address, Port, MySocket}, Pid, Message),
+ log:log(info,"[ CC ] this() == ~w", [{MyIP, MyPort}]),
+ % set_local_address(t, {MyIP,MyPort}}),
+ % register_connection(Address, Port, MyPid, MySocket),
+ ets:insert(?MODULE, {local_address_port, {MyIP,MyPort}}),
+ ets:insert(?MODULE, {{Address, Port}, {MyPid, MySocket}}),
+ {reply, ok, State};
+ fail ->
+ % drop message (remote node not reachable, failure detector will notice)
+ {reply, ok, State};
+ {connection, LocalPid, NewSocket} ->
+ comm_connection:send({Address, Port, NewSocket}, Pid, Message),
+ ets:insert(?MODULE, {{Address, Port}, {LocalPid, NewSocket}}),
+ % register_connection(Address, Port, LPid, NewSocket),
+ {reply, ok, State}
+ end.
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/comm_layer/comm_port_sup.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/comm_layer/comm_port_sup.erl
new file mode 100644
index 0000000000..622d0a8c06
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/comm_layer/comm_port_sup.erl
@@ -0,0 +1,90 @@
+% Copyright 2008 Konrad-Zuse-Zentrum für Informationstechnik Berlin
+%
+% Licensed under the Apache License, Version 2.0 (the "License");
+% you may not use this file except in compliance with the License.
+% You may obtain a copy of the License at
+%
+% http://www.apache.org/licenses/LICENSE-2.0
+%
+% Unless required by applicable law or agreed to in writing, software
+% distributed under the License is distributed on an "AS IS" BASIS,
+% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+% See the License for the specific language governing permissions and
+% limitations under the License.
+%%%-------------------------------------------------------------------
+%%% File : comm_port_sup.erl
+%%% Author : Thorsten Schuett <[email protected]>
+%%% Description :
+%%%
+%%% Created : 04 Feb 2008 by Thorsten Schuett <[email protected]>
+%%%-------------------------------------------------------------------
+%% @author Thorsten Schuett <[email protected]>
+%% @copyright 2008 Konrad-Zuse-Zentrum für Informationstechnik Berlin
+%% @version $Id: comm_port_sup.erl,v 1.1 2009/11/06 12:41:36 maria Exp $
+-module(comm_layer_dir.comm_port_sup).
+
+-author('[email protected]').
+-vsn('$Id: comm_port_sup.erl,v 1.1 2009/11/06 12:41:36 maria Exp $ ').
+
+-behaviour(supervisor).
+
+-import(supervisor).
+-import(randoms).
+-import(string).
+-import(config).
+
+-export([start_link/0, init/1]).
+
+%%====================================================================
+%% API functions
+%%====================================================================
+%%--------------------------------------------------------------------
+%% Function: start_link() -> {ok,Pid} | ignore | {error,Error}
+%% Description: Starts the supervisor
+%%--------------------------------------------------------------------
+start_link() ->
+ supervisor:start_link(?MODULE, []).
+
+%%====================================================================
+%% Supervisor callbacks
+%%====================================================================
+%%--------------------------------------------------------------------
+%% Func: init(Args) -> {ok, {SupFlags, [ChildSpec]}} |
+%% ignore |
+%% {error, Reason}
+%% Description: Whenever a supervisor is started using
+%% supervisor:start_link/[2,3], this function is called by the new process
+%% to find out about restart strategy, maximum restart frequency and child
+%% specifications.
+%%--------------------------------------------------------------------
+init([]) ->
+ InstanceId = string:concat("comm_port_", randoms:getRandomId()),
+ CommPort =
+ {comm_port,
+ {comm_layer_dir.comm_port, start_link, []},
+ permanent,
+ brutal_kill,
+ worker,
+ []},
+ CommAcceptor =
+ {comm_acceptor,
+ {comm_layer_dir.comm_acceptor, start_link, [InstanceId]},
+ permanent,
+ brutal_kill,
+ worker,
+ []},
+ CommLogger =
+ {comm_logger,
+ {comm_layer_dir.comm_logger, start_link, []},
+ permanent,
+ brutal_kill,
+ worker,
+ []},
+ {ok, {{one_for_all, 10, 1},
+ [
+ CommPort,
+ CommLogger,
+ CommAcceptor
+ ]}}.
+
+
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/compare1.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/compare1.erl
new file mode 100644
index 0000000000..2626d2ebea
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/compare1.erl
@@ -0,0 +1,21 @@
+%%%-------------------------------------------------------------------
+%%% File : compare1.erl
+%%% Author : Tobias Lindahl <[email protected]>
+%%% Description :
+%%%
+%%% Created : 20 Apr 2007 by Tobias Lindahl <[email protected]>
+%%%-------------------------------------------------------------------
+-module(compare1).
+
+-export([t/0]).
+
+t() ->
+ t(42).
+
+t(X) when X > 42 ->
+ error;
+t(X) when X < 42 ->
+ error;
+t(X) when X =/= 42 ->
+ error;
+t(X) -> ok.
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/confusing_warning.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/confusing_warning.erl
new file mode 100644
index 0000000000..c82df0f056
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/confusing_warning.erl
@@ -0,0 +1,22 @@
+%% Test case that results in a confusing warning -- created from a
+%% very stripped down actual application. The second case clause of
+%% test/1 cannot possibly match because all a-pairs match with the
+%% first clause. Dialyzer complains that the second argument of the
+%% second 2-tuple has type 'aaa' | 'bbb'. This is mucho confusing
+%% since there is no 'a'-pair whose second element is 'aaa' | 'bbb'.
+%% Pattern matching compilation is of course what's to blame here.
+
+-module(confusing_warning).
+-export([test/1]).
+
+test(N) when is_integer(N) ->
+ case foo(N) of
+ {a, I} when is_integer(I) ->
+ I;
+ {a, {_, L}} -> % this clause cannot possibly match
+ L
+ end.
+
+foo(1) -> {a, 42};
+foo(2) -> {b, aaa}; % this is really unused
+foo(3) -> {b, bbb}. % this is really unused
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/contract2.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/contract2.erl
new file mode 100644
index 0000000000..83ee5910f2
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/contract2.erl
@@ -0,0 +1,18 @@
+-module(contract2).
+-export([test/2]).
+
+-spec test(list(), list()) -> ok.
+
+test([], []) ->
+ ok;
+test([], L) ->
+ raise(L);
+test([H|T], L) ->
+ case H of
+ true -> test(T, L);
+ false -> test(T, [H|L])
+ end.
+
+-spec raise(_) -> no_return().
+raise(X) ->
+ throw(X).
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/contract3.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/contract3.erl
new file mode 100644
index 0000000000..c135b72d45
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/contract3.erl
@@ -0,0 +1,34 @@
+%%%-------------------------------------------------------------------
+%%% File : contract3.erl
+%%% Author : Tobias Lindahl <[email protected]>
+%%% Description : Check overloaded domains
+%%%
+%%% Created : 2 Nov 2007 by Tobias Lindahl <[email protected]>
+%%%-------------------------------------------------------------------
+-module(contract3).
+
+-export([t/3]).
+
+t(X, Y, Z) ->
+ t1(X),
+ t2(X, Y),
+ t3(X, Y, Z).
+
+-spec t1(atom()|integer()) -> integer();
+ (atom()|list()) -> atom().
+
+t1(X) ->
+ foo:bar(X).
+
+-spec t2(atom(), integer()) -> integer();
+ (atom(), list()) -> atom().
+
+t2(X, Y) ->
+ foo:bar(X, Y).
+
+-spec t3(atom(), integer(), list()) -> integer();
+ (X, integer(), list()) -> X.
+
+t3(X, Y, Z) ->
+ X.
+
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/contract5.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/contract5.erl
new file mode 100644
index 0000000000..6385473c20
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/contract5.erl
@@ -0,0 +1,15 @@
+%%%-------------------------------------------------------------------
+%%% File : contract5.erl
+%%% Author : Tobias Lindahl <[email protected]>
+%%% Description : Excercise modified record types.
+%%%
+%%% Created : 15 Apr 2008 by Tobias Lindahl <[email protected]>
+%%%-------------------------------------------------------------------
+-module(contract5).
+-export([t/0]).
+
+-record(bar, {baz}).
+
+-spec t() -> #bar{baz :: boolean()}.
+
+t() -> #bar{baz = not_a_boolean}.
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/disj_norm_form.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/disj_norm_form.erl
new file mode 100644
index 0000000000..313c2e8b86
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/disj_norm_form.erl
@@ -0,0 +1,23 @@
+%%%-------------------------------------------------------------------
+%%% File : disj_norm_form.erl
+%%% Author : Tobias Lindahl <[email protected]>
+%%% Description : Exposes a bad behavior in expansion to
+%%% disjunctive normal form of guards.
+%%%
+%%% Created : 24 Aug 2007 by Tobias Lindahl <[email protected]>
+%%%-------------------------------------------------------------------
+-module(disj_norm_form).
+
+-export([t/1]).
+
+-record(foo, {bar}).
+
+t(R) ->
+ if R#foo.bar =:= 1;
+ R#foo.bar =:= 2;
+ R#foo.bar =:= 3;
+ R#foo.bar =:= 4;
+ R#foo.bar =:= 5;
+ R#foo.bar =:= 6 -> ok;
+ true -> error
+ end.
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/eqeq.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/eqeq.erl
new file mode 100644
index 0000000000..6767023e3a
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/eqeq.erl
@@ -0,0 +1,16 @@
+%%%-------------------------------------------------------------------
+%%% File : eqeq.erl
+%%% Author : Tobias Lindahl <[email protected]>
+%%% Description :
+%%%
+%%% Created : 12 Nov 2007 by Tobias Lindahl <[email protected]>
+%%%-------------------------------------------------------------------
+-module(eqeq).
+
+-export([t/0]).
+
+t() ->
+ comp(3.14, foo).
+
+comp(X, Y) -> X =:= Y.
+
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/ets_select.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/ets_select.erl
new file mode 100644
index 0000000000..2b3c38cd59
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/ets_select.erl
@@ -0,0 +1,12 @@
+-module(ets_select).
+-export([test/0]).
+
+test() ->
+ Table = ets:new(table, [set,{keypos,1}]),
+ ets:insert(Table, {foo, bar, baz}),
+ foo(Table). % ets:select(Table, [{{'_', '$1', '$2'}, [], ['$$']}]).
+
+foo(Table) ->
+ Tuples = ets:select(Table, [{{'_', '$1', '$2'}, [], ['$$']}]),
+ [list_to_tuple(Tuple) || Tuple <- Tuples].
+
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/exhaust_case.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/exhaust_case.erl
new file mode 100644
index 0000000000..6b20c7c98c
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/exhaust_case.erl
@@ -0,0 +1,24 @@
+%%-------------------------------------------------------------------
+%% File : exhaust_case.erl
+%% Author : Kostis Sagonas <[email protected]>
+%% Description : Tests that Dialyzer warns when it finds an unreachable
+%% case clause (independently of whether ground vs. var).
+%%
+%% Created : 15 Dec 2004 by Kostis Sagonas <[email protected]>
+%%-------------------------------------------------------------------
+
+-module(exhaust_case).
+-export([t/1]).
+
+t(X) when is_integer(X) ->
+ case ret(X) of
+ foo -> ok;
+ bar -> ok;
+ 42 -> ok;
+ _other -> error %% unreachable clause (currently no warning)
+ %% other -> error %% but contrast this with this clause... hmm
+ end.
+
+ret(1) -> foo;
+ret(2) -> bar.
+
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/failing_guard1.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/failing_guard1.erl
new file mode 100644
index 0000000000..8fa1ce9ce0
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/failing_guard1.erl
@@ -0,0 +1,16 @@
+%%-----------------------------------------------------------------------
+%% Author: Kostis Sagonas (Wed Aug 23 14:54:25 CEST 2006)
+%%
+%% Program to test failing arithmetic comparisons with a number of the
+%% wrong type. The first case is handled properly; the second one is not.
+%% Why?
+%%-----------------------------------------------------------------------
+
+-module(failing_guard1).
+-export([n/1]).
+
+n(N) when (N / 2) =:= 2 -> multiple_of_four;
+n(N) when (N div 3) =:= 2.0 -> multiple_of_six;
+n(N) when (N rem 3) =:= 2.0 -> multiple_of_six;
+n(N) when is_number(N) -> other_number.
+
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/flatten.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/flatten.erl
new file mode 100644
index 0000000000..ac28fe27c9
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/flatten.erl
@@ -0,0 +1,18 @@
+%%%-------------------------------------------------------------------
+%%% File : flatten.erl
+%%% Author : Tobias Lindahl <[email protected]>
+%%% Description :
+%%%
+%%% Created : 4 Nov 2007 by Tobias Lindahl <[email protected]>
+%%%-------------------------------------------------------------------
+-module(flatten).
+
+-export([t/1]).
+
+t(Dir) ->
+ case file:list_dir(Dir) of
+ {ok,FileList} ->
+ FileList;
+ {error,Reason} ->
+ {error,lists:flatten("Can't open directory "++Dir++": "++Reason)}
+ end.
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/fun_app.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/fun_app.erl
new file mode 100644
index 0000000000..605b0799d1
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/fun_app.erl
@@ -0,0 +1,42 @@
+%% This is taken from the code of distel.
+
+-module(fun_app).
+-export([html_index/2]). % , lines/3, curry/2]).
+
+html_index(file,Dir) ->
+ fold_file(curry(fun lines/3,Dir),[],filename:join([Dir,"doc","man_index.html"])).
+
+fold_file(Fun,Acc0,File) ->
+ {ok, FD} = file:open(File, [read]),
+ Acc = fold_file_lines(FD,Fun,Acc0),
+ file:close(FD),
+ Acc.
+
+fold_file_lines(FD,Fun,Acc) ->
+ case io:get_line(FD, "") of
+ eof -> Acc;
+ Line -> fold_file_lines(FD,Fun,Fun(trim_nl(Line),Acc))
+ end.
+
+trim_nl(Str) -> lists:reverse(tl(lists:reverse(Str))).
+
+lines(Line,_,Dir) ->
+ case string:tokens(Line, "<> \"") of
+ ["TD", "A", "HREF=", "../"++Href, M|_] ->
+ case filename:basename(Href, ".html") of
+ "index" -> ok;
+ M -> e_set({file,M}, filename:join([Dir,Href]))
+ end;
+ _ -> ok
+ end.
+
+e_set(Key,Val) -> ets:insert(?MODULE, {Key,Val}).
+
+curry(F, Arg) ->
+ case erlang:fun_info(F,arity) of
+ {_,1} -> fun() -> F(Arg) end;
+ {_,2} -> fun(A) -> F(A,Arg) end;
+ {_,3} -> fun(A,B) -> F(A,B,Arg) end;
+ {_,4} -> fun(A,B,C) -> F(A,B,C,Arg) end
+ end.
+
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/fun_ref_match.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/fun_ref_match.erl
new file mode 100644
index 0000000000..c15226ba6e
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/fun_ref_match.erl
@@ -0,0 +1,21 @@
+%%%-------------------------------------------------------------------
+%%% File : fun_ref_match.erl
+%%% Author : Tobias Lindahl <[email protected]>
+%%% Description : Find that newly created funs and references cannot
+%%% match on earlier bound variables.
+%%%
+%%% Created : 10 Mar 2005 by Tobias Lindahl <[email protected]>
+%%%-------------------------------------------------------------------
+-module(fun_ref_match).
+
+-export([t1/1, t2/1]).
+
+t1(X) ->
+ X = fun(Y) -> Y end,
+ ok.
+
+t2(X) ->
+ case make_ref() of
+ X -> error;
+ _ -> ok
+ end.
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/fun_ref_record.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/fun_ref_record.erl
new file mode 100644
index 0000000000..eace7a4332
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/fun_ref_record.erl
@@ -0,0 +1,17 @@
+%%%-------------------------------------------------------------------
+%%% File : fun_ref_record.erl
+%%% Author : Tobias Lindahl <[email protected]>
+%%% Description : Exposes a bug when referring to a fun in a record.
+%%%
+%%% Created : 25 Sep 2007 by Tobias Lindahl <[email protected]>
+%%%-------------------------------------------------------------------
+-module(fun_ref_record).
+
+-export([t1/0, t2/0]).
+
+-record(foo, {bar}).
+
+t1() ->
+ #foo{bar=fun t2/0}.
+
+t2() -> ok.
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/gencall.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/gencall.erl
new file mode 100644
index 0000000000..d2875c9df1
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/gencall.erl
@@ -0,0 +1,12 @@
+%% Error: gen_server:handle_cast/2 is not logged as an unexported func
+%% but unknown function.
+-module(gencall).
+
+-export([f/0]).
+
+f() ->
+ gen_server:call(1,2,3),
+ ets:lookup(1,2,3),
+ gencall2:foo(),
+ gencall:foo(),
+ gen_server:handle_cast(1,2).
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/gs_make.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/gs_make.erl
new file mode 100644
index 0000000000..cbf3ef5dcb
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/gs_make.erl
@@ -0,0 +1,261 @@
+%% ``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: gs_make.erl,v 1.1 2008/12/17 09:53:50 mikpe Exp $
+%%
+-module(gs_make).
+
+-export([start/0]).
+
+start() ->
+ Terms = the_config(),
+ DB=fill_ets(Terms),
+ {ok,OutFd} = file:open("gstk_generic.hrl", [write]),
+ put(stdout,OutFd),
+% io:format("terms: ~p ~n ets:~p~n",[Terms,ets:tab2list(DB)]),
+ p("% Don't edit this file. It was generated by gs_make:start/0 "),
+ p("at ~p-~p-~p, ~p:~p:~p.\n\n",
+ lists:append(tuple_to_list(date()),tuple_to_list(time()))),
+ gen_out_opts(DB),
+ gen_read(DB),
+ file:close(OutFd),
+ {ok,"gstk_generic.hrl",DB}.
+
+fill_ets(Terms) ->
+ DB = ets:new(gs_mapping,[bag,public]),
+ fill_ets(DB,Terms).
+
+fill_ets(DB,[]) -> DB;
+fill_ets(DB,[{Objs,Opt,Fun,Access}|Terms]) ->
+ fill_ets(DB,lists:flatten(Objs),Opt,Fun,Access),
+ fill_ets(DB,Terms).
+
+fill_ets(_DB,[],_,_,_) -> done;
+fill_ets(DB,[Obj|Objs],Opt,Fun,rw) ->
+ ets:insert(DB,{Obj,Opt,Fun,read}),
+ ets:insert(DB,{Obj,Opt,Fun,write}),
+ fill_ets(DB,Objs,Opt,Fun,rw);
+fill_ets(DB,[Obj|Objs],Opt,Fun,r) ->
+ ets:insert(DB,{Obj,Opt,Fun,read}),
+ fill_ets(DB,Objs,Opt,Fun,r);
+fill_ets(DB,[Obj|Objs],Opt,Fun,w) ->
+ ets:insert(DB,{Obj,Opt,Fun,write}),
+ fill_ets(DB,Objs,Opt,Fun,w).
+
+
+
+gen_out_opts(DB) ->
+ ObjTypes = lists:flatten(ordsets:from_list(ets:match(DB,{'$1','_','_',write}))),
+ p("out_opts([Option|Options],Gstkid,TkW,DB,ExtraArg,S,P,C) ->\n"),
+ p(" {Opt,Val} =\n"),
+ p(" case Option of \n"),
+ p(" {{default,Cat,Key},V} -> {default,{Cat,{Key,V}}};\n"),
+ p(" {_Key,_V} -> Option;\n"),
+ p(" {default,Cat,Opti} -> {default,{Cat,Opti}};\n"),
+ p(" Atom when atom(Atom) -> {Atom,undefined};\n"),
+ p(" _ -> {error, {invalid_option,Option}}\n"),
+ p(" end,\n"),
+ p(" case Gstkid#gstkid.objtype of\n"),
+ gen_out_type_case_clauses(merge_types(ObjTypes),DB),
+ p(" Q -> exit({internal_error,unknown_objtype,Q})\n"),
+ p(" end;\n"),
+ p("out_opts([],_Gstkid,_TkW,_DB,_ExtraArg,S,P,C) -> \n"),
+ p(" {S,P,C}.\n").
+
+
+gen_out_type_case_clauses([],_DB) -> done;
+gen_out_type_case_clauses([Objtype|Objtypes],DB) ->
+ OptsFuns = lists:map(fun (L) -> list_to_tuple(L) end,
+ ets:match(DB,{Objtype,'$1','$2',write})),
+ p(" ~p -> \ncase Opt of\n",[Objtype]),
+ gen_opt_case_clauses(merge_opts(opt_prio(),OptsFuns)),
+ p(" _ -> \n"),
+ p(" handle_external_opt_call([Option|Options],Gstkid,TkW,DB,ExtraArg,"
+ " gstk_~p:option(Option,Gstkid,TkW,DB,ExtraArg),S,P,C)\n",
+ [Objtype]),
+ p(" end;\n"),
+ gen_out_type_case_clauses(Objtypes,DB).
+
+gen_opt_case_clauses([]) ->
+ done;
+gen_opt_case_clauses([{Opt,Fun}|OptFuncs]) ->
+ p(" ~p ->\n",[Opt]),
+ p(" ~p(Val,Options,Gstkid,TkW,DB,ExtraArg,S,P,C);\n",[Fun]),
+ gen_opt_case_clauses(OptFuncs).
+
+gen_read(DB) ->
+ ObjTypes = lists:flatten(ordsets:from_list(ets:match(DB,{'$1','_','_',read}))),
+ p("read_option(DB,Gstkid,TkW,Option,ExtraArg) ->\n"),
+ p(" Key = case Option of\n"),
+ p(" Atom when atom(Atom) -> Atom;\n"),
+ p(" Opt when tuple(Opt) -> element(1,Opt)\n"),
+ p(" end,\n"),
+ p(" case Gstkid#gstkid.objtype of\n"),
+ gen_read_type_clauses(merge_types(ObjTypes),DB),
+ p(" Q -> exit({internal_error,unknown_objtype,Q})\n"),
+ p(" end.\n").
+
+
+gen_read_type_clauses([],_) -> done;
+gen_read_type_clauses([Objtype|Objtypes],DB) ->
+ OptsFuns = lists:map(fun (L) -> list_to_tuple(L) end,
+ ets:match(DB,{Objtype,'$1','$2',read})),
+ p(" ~p -> \ncase Key of\n",[Objtype]),
+ gen_readopt_case_clauses(merge_opts(opt_prio(),OptsFuns)),
+ p(" _ -> \nhandle_external_read(gstk_~p:read_option(Option,Gstkid,TkW,DB,ExtraArg))\n",[Objtype]),
+ p(" end;\n"),
+ gen_read_type_clauses(Objtypes,DB).
+
+gen_readopt_case_clauses([]) ->
+ done;
+gen_readopt_case_clauses([{Opt,Fun}|OptFuncs]) ->
+ p(" ~p -> \n~p(Option,Gstkid,TkW,DB,ExtraArg);\n",[Opt,Fun]),
+ gen_readopt_case_clauses(OptFuncs).
+
+
+p(Str) ->
+ ok = io:format(get(stdout),Str,[]).
+
+p(Format,Data) ->
+ ok = io:format(get(stdout),Format,Data).
+
+%%----------------------------------------------------------------------
+%% There items should be placed early in a case statement.
+%%----------------------------------------------------------------------
+obj_prio() -> [rectangle,line,gridline,image,button,canvas,checkbutton,radiobutton].
+opt_prio() -> [x,y,width,height,move,coords,data].
+
+merge_types(Types) ->
+ T2 = ordsets:from_list(Types),
+ P2 = ordsets:from_list(obj_prio()),
+ obj_prio() ++ ordsets:subtract(T2, P2).
+
+merge_opts([],L) -> L;
+merge_opts([Opt|Opts],Dict) ->
+ case gs:assq(Opt,Dict) of
+ {value,V} -> [{Opt,V}|merge_opts(Opts,lists:keydelete(Opt,1,Dict))];
+ false -> merge_opts(Opts,Dict)
+ end.
+
+the_config() ->
+ Buttons=[button,checkbutton,radiobutton],
+ AllPureTk = [Buttons,canvas,editor,entry,frame,label,listbox,
+ menubar,menubutton,scale,window],
+ CanvasObj = [arc,image,line,oval,polygon,rectangle,text],
+ All = [AllPureTk,CanvasObj,grid,gridline,menu,menuitem,gs],
+ Containers = [canvas,frame,grid,menu,menubar,menubutton,menuitem,window],
+ Ob1 = [Buttons,canvas,grid,frame,label,entry,editor,listbox,scale],
+ Ob2 = [button,checkbutton,radiobutton,label,menubutton],
+ Ob3 = [Buttons,frame,label,entry,editor,listbox,scale,menubutton,
+ menubar,menu],
+ Ob4 = [canvas,editor,listbox],
+ [{[Buttons,entry,scale,menubutton],enable,gen_enable,rw},
+ {[Buttons,label,entry,scale,menubutton,menu],fg,gen_fg,rw},
+ {[Buttons,label,entry,scale,menubutton,menu],bg,gen_bg,rw},
+ {Ob1,anchor,gen_anchor,rw},
+ {Ob1,height,gen_height,r},
+ {Ob1--[frame],height,gen_height,w},
+ {Ob1,width,gen_width,r},
+ {Ob1--[frame],width,gen_width,w},
+ {Ob1,pack_x,gen_pack_x,rw},
+ {Ob1,pack_y,gen_pack_y,rw},
+ {Ob1,pack_xy,gen_pack_xy,w},
+ {Ob1,x,gen_x,rw},
+ {Ob1,y,gen_y,rw},
+ {Ob1,raise,gen_raise,w},
+ {Ob1,lower,gen_lower,w},
+ {Ob2,align,gen_align,rw},
+ {Ob2,font,gen_font,rw},
+ {Ob2,justify,gen_justify,rw},
+ {Ob2,padx,gen_padx,rw},
+ {Ob2,pady,gen_pady,rw},
+ {Containers,default,gen_default,w},
+ {[AllPureTk,menu],relief,gen_relief,rw},
+ {[AllPureTk,menu],bw,gen_bw,rw},
+ {[Buttons,canvas,frame,label,entry,scale,menubutton,menu,menubar],
+ setfocus,gen_setfocus,rw},
+ {Ob3,buttonpress,gen_buttonpress,rw},
+ {Ob3,buttonrelease,gen_buttonrelease,rw},
+ {Ob3,configure,gen_configure,rw},
+ {[Ob3,window],destroy,gen_destroy,rw},
+ {[Ob3,window],enter,gen_enter,rw},
+ {[Ob3,window],leave,gen_leave,rw},
+ {[Ob3,window],focus,gen_focus_ev,rw},
+ {[Ob3,window],keypress,gen_keypress,rw},
+ {[Ob3,window],keyrelease,gen_keyrelease,rw},
+ {Ob3,motion,gen_motion,rw},
+ %% events containing x,y are special
+ {[window],buttonpress,gen_buttonpress,r},
+ {[window],buttonrelease,gen_buttonrelease,r},
+ {[window],motion,gen_motion,r},
+ {All,font_wh,gen_font_wh,r},
+ {All,choose_font,gen_choose_font,r},
+ {All,data,gen_data,rw},
+ {All,children,gen_children,r},
+ {All,id,gen_id,r},
+ {All,parent,gen_parent,r},
+ {All,type,gen_type,r},
+ {All,beep,gen_beep,w},
+ {All,keep_opt,gen_keep_opt,w},
+ {All,flush,gen_flush,rw},
+ {AllPureTk,highlightbw,gen_highlightbw,rw},
+ {AllPureTk,highlightbg,gen_highlightbg,rw},
+ {AllPureTk,highlightfg,gen_highlightfg,rw},
+ {AllPureTk,cursor,gen_cursor,rw}, % bug
+ {[Buttons,label,menubutton],label,gen_label,rw},
+ {[Buttons,menubutton,menu],activebg,gen_activebg,rw},
+ {[Buttons,menubutton,menu],activefg,gen_activefg,rw},
+ {[entry],selectbg,gen_selectbg,rw},
+ {[entry],selectbw,gen_selectbw,rw},
+ {[entry],selectfg,gen_selectfg,rw},
+ {Ob4,activebg,gen_so_activebg,rw},
+ {Ob4,bc,gen_so_bc,rw},
+ {Ob4,bg,gen_so_bg,rw},
+ {Ob4,hscroll,gen_so_hscroll,r},
+ {Ob4,scrollbg,gen_so_scrollbg,rw},
+ {Ob4,scrollfg,gen_so_scrollfg,rw},
+ {Ob4,scrolls,gen_so_scrolls,w},
+ {Ob4,selectbg,gen_so_selectbg,rw},
+ {Ob4,selectbg,gen_so_selectbg,rw},
+ {Ob4,selectbw,gen_so_selectbw,rw},
+ {Ob4,selectbw,gen_so_selectbw,rw},
+ {Ob4,selectfg,gen_so_selectfg,rw},
+ {Ob4,selectfg,gen_so_selectfg,rw},
+ {Ob4,vscroll,gen_so_vscroll,r},
+ {CanvasObj,coords,gen_citem_coords,rw},
+ {CanvasObj,lower,gen_citem_lower,w},
+ {CanvasObj,raise,gen_citem_raise,w},
+ {CanvasObj,move,gen_citem_move,w},
+ {CanvasObj,setfocus,gen_citem_setfocus,rw},
+ {CanvasObj,buttonpress,gen_citem_buttonpress,w}, % should be rw
+ {CanvasObj,buttonrelease,gen_citem_buttonrelease,w},
+ {CanvasObj,enter,gen_citem_enter,w},
+ {CanvasObj,focus,gen_citem_setfocus,w},
+ {CanvasObj,keypress,gen_citem_keypress,w},
+ {CanvasObj,keyrelease,gen_citem_keyrelease,w},
+ {CanvasObj,leave,gen_citem_leave,w},
+ {CanvasObj,motion,gen_citem_motion,w},
+ {CanvasObj,buttonpress,gen_buttonpress,r},
+ {CanvasObj,buttonrelease,gen_buttonrelease,r},
+ {CanvasObj,configure,gen_configure,r},
+ {CanvasObj,destroy,gen_destroy,r},
+ {CanvasObj,enter,gen_enter,r},
+ {CanvasObj,leave,gen_leave,r},
+ {CanvasObj,focus,gen_focus_ev,r},
+ {CanvasObj,keypress,gen_keypress,r},
+ {CanvasObj,keyrelease,gen_keyrelease,r},
+ {CanvasObj,motion,gen_motion,r},
+ {[arc,oval,polygon,rectangle],fill,gen_citem_fill,rw}].
+
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/inf_loop2.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/inf_loop2.erl
new file mode 100644
index 0000000000..fbbec10a55
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/inf_loop2.erl
@@ -0,0 +1,23 @@
+%%---------------------------------------------------------------------
+%% Module that went into an infinite loop when trying to assign types.
+%%
+%% What was happening is that for functions which are in an SCC but all
+%% return none(), a second chance was given to them by the analysis to
+%% see whether they return none() because they are involved in an loop
+%% (presumably server-related) and could be assigned the type unit()
+%% instead. The problem is that when the really return none() for some
+%% other reason (an error such in this case) then we will again find
+%% none() and try again for unit(), thereby entering an infinite loop.
+%% The issue was resolved on May 17th by adding an appropriate boolean
+%% parameter to dialyzer_typesig:solve_scc() function.
+%%---------------------------------------------------------------------
+-module(inf_loop2).
+
+-export([test/0]).
+
+test() ->
+ lists:reverse(gazonk),
+ loop().
+
+loop() ->
+ test().
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/letrec1.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/letrec1.erl
new file mode 100644
index 0000000000..f5c265cc60
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/letrec1.erl
@@ -0,0 +1,13 @@
+%%%-------------------------------------------------------------------
+%%% File : letrec1.erl
+%%% Author : Tobias Lindahl <[email protected]>
+%%% Description :
+%%%
+%%% Created : 9 Mar 2007 by Tobias Lindahl <[email protected]>
+%%%-------------------------------------------------------------------
+-module(letrec1).
+
+-export([t/1]).
+
+t(Opts) ->
+ [Opt || Opt <- Opts, Opt =/= compressed].
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/list_match.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/list_match.erl
new file mode 100644
index 0000000000..77de6d7dee
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/list_match.erl
@@ -0,0 +1,20 @@
+%%%-------------------------------------------------------------------
+%%% File : list_match.erl
+%%% Author : Tobias Lindahl <[email protected]>
+%%% Description :
+%%%
+%%% Created : 12 Mar 2007 by Tobias Lindahl <[email protected]>
+%%%-------------------------------------------------------------------
+-module(list_match).
+
+-export([t/0]).
+
+t() ->
+ t([1,2,3,4]).
+
+t([]) ->
+ ok;
+t([H|T]) when is_integer(H) ->
+ t(T);
+t([_|T]) ->
+ t(T).
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/lzip.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/lzip.erl
new file mode 100644
index 0000000000..753d2939d8
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/lzip.erl
@@ -0,0 +1,8 @@
+-module(lzip).
+-export([test/0, test/1]).
+
+test() ->
+ lists:zip([],[]).
+
+test(L) ->
+ lists:zip(L, []).
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/make_tuple.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/make_tuple.erl
new file mode 100644
index 0000000000..0a5edf8c24
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/make_tuple.erl
@@ -0,0 +1,5 @@
+-module(make_tuple).
+-export([test/0]).
+
+test() ->
+ {_,_} = erlang:make_tuple(3, []).
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/minus_minus.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/minus_minus.erl
new file mode 100644
index 0000000000..f1e9483c40
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/minus_minus.erl
@@ -0,0 +1,8 @@
+%%------------------------------------------------------------------------
+%% Test file which gave a bogus warning when analyzed with Dialyzer 1.6.1.
+%%------------------------------------------------------------------------
+-module(minus_minus).
+-export([test/0]).
+
+test() ->
+ [] -- [].
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/mod_info.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/mod_info.erl
new file mode 100644
index 0000000000..a24e4276ad
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/mod_info.erl
@@ -0,0 +1,5 @@
+-module(mod_info).
+-export([test/0]).
+
+test() ->
+ {module_info(), module_info(compile)}.
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/my_filter.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/my_filter.erl
new file mode 100644
index 0000000000..a67c4bd432
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/my_filter.erl
@@ -0,0 +1,17 @@
+-module(my_filter).
+-export([test/0]).
+
+test() ->
+ filter(fun mystery/1, [1,2,3,4]).
+
+filter(Pred, List) when is_function(Pred, 1) ->
+ [ E || E <- List, Pred(E) ].
+
+mystery(X) ->
+ case (X rem 3) of
+ 0 -> true;
+ 1 -> false;
+ 2 -> gazonk
+ end.
+
+%% mystery(_X,_Y) -> true.
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/my_sofs.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/my_sofs.erl
new file mode 100644
index 0000000000..32252071d2
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/my_sofs.erl
@@ -0,0 +1,83 @@
+%% Program showing the problems with record field accesses.
+
+-module(my_sofs).
+-export([ordset_of_sets/3, is_equal/2]).
+
+-define(TAG, 'Set').
+-define(ORDTAG, 'OrdSet').
+
+-record(?TAG, {data = [], type = type}).
+-record(?ORDTAG, {orddata = {}, ordtype = type}).
+
+-define(LIST(S), (S)#?TAG.data).
+-define(TYPE(S), (S)#?TAG.type).
+-define(SET(L, T), #?TAG{data = L, type = T}).
+-define(IS_SET(S), record(S, ?TAG)).
+
+%% Ordered sets and atoms:
+-define(ORDDATA(S), (S)#?ORDTAG.orddata).
+-define(ORDTYPE(S), (S)#?ORDTAG.ordtype).
+-define(ORDSET(L, T), #?ORDTAG{orddata = L, ordtype = T}).
+-define(IS_ORDSET(S), record(S, ?ORDTAG)).
+
+%% When IS_SET is true:
+-define(ANYTYPE, '_').
+-define(REL_TYPE(I, R), element(I, R)).
+-define(SET_OF(X), [X]).
+
+is_equal(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
+ case match_types(?TYPE(S1), ?TYPE(S2)) of
+ true -> ?LIST(S1) == ?LIST(S2);
+ false -> erlang:error(type_mismatch, [S1, S2])
+ end;
+is_equal(S1, S2) when ?IS_ORDSET(S1), ?IS_ORDSET(S2) ->
+ case match_types(?TYPE(S1), ?TYPE(S2)) of
+ true -> ?ORDDATA(S1) == ?ORDDATA(S2);
+ false -> erlang:error(type_mismatch, [S1, S2])
+ end;
+is_equal(S1, S2) when ?IS_SET(S1), ?IS_ORDSET(S2) ->
+ erlang:error(type_mismatch, [S1, S2]);
+is_equal(S1, S2) when ?IS_ORDSET(S1), ?IS_SET(S2) ->
+ erlang:error(type_mismatch, [S1, S2]).
+
+%% Type = OrderedSetType
+%% | SetType
+%% | atom() except '_'
+%% OrderedSetType = {Type, ..., Type}
+%% SetType = [ElementType] % list of exactly one element
+%% ElementType = '_' % any type (implies empty set)
+%% | Type
+
+ordset_of_sets([S | Ss], L, T) when ?IS_SET(S) ->
+ ordset_of_sets(Ss, [?LIST(S) | L], [[?TYPE(S)] | T]);
+ordset_of_sets([S | Ss], L, T) when ?IS_ORDSET(S) ->
+ ordset_of_sets(Ss, [?LIST(S) | L], [?ORDTYPE(S) | T]);
+ordset_of_sets([], L, T) ->
+ ?ORDSET(list_to_tuple(lists:reverse(L)), list_to_tuple(lists:reverse(T)));
+ordset_of_sets(_, _L, _T) ->
+ error.
+
+%% inlined.
+match_types(T, T) -> true;
+match_types(Type1, Type2) -> match_types1(Type1, Type2).
+
+match_types1(Atom, Atom) when is_atom(Atom) ->
+ true;
+match_types1(?ANYTYPE, _) ->
+ true;
+match_types1(_, ?ANYTYPE) ->
+ true;
+match_types1(?SET_OF(Type1), ?SET_OF(Type2)) ->
+ match_types1(Type1, Type2);
+match_types1(T1, T2) when tuple(T1), tuple(T2), size(T1) =:= size(T2) ->
+ match_typesl(size(T1), T1, T2);
+match_types1(_T1, _T2) ->
+ false.
+
+match_typesl(0, _T1, _T2) ->
+ true;
+match_typesl(N, T1, T2) ->
+ case match_types1(?REL_TYPE(N, T1), ?REL_TYPE(N, T2)) of
+ true -> match_typesl(N-1, T1, T2);
+ false -> false
+ end.
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/no_match.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/no_match.erl
new file mode 100644
index 0000000000..e3e7a4b2d1
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/no_match.erl
@@ -0,0 +1,9 @@
+-module(no_match).
+-export([t1/1, t2/1, t3/1]).
+-record(rec, {field}).
+
+t1(#rec{} = {_}) -> no_match1.
+
+t2(42 = gazonk) -> no_match2.
+
+t3(X) when false -> X.
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/no_unused_fun.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/no_unused_fun.erl
new file mode 100644
index 0000000000..0bd8ba402c
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/no_unused_fun.erl
@@ -0,0 +1,20 @@
+-module(no_unused_fun).
+-export([main/2]).
+
+main(X, Bool) ->
+ case Bool of
+ true ->
+ F = fun foo/1;
+ false ->
+ F = fun foobar/1
+ end,
+ calc(X, F).
+
+calc(X, Fun) ->
+ Fun(X).
+
+foo(A) ->
+ A+42.
+
+foobar(A) ->
+ A-42.
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/no_unused_fun2.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/no_unused_fun2.erl
new file mode 100644
index 0000000000..e287c4de5f
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/no_unused_fun2.erl
@@ -0,0 +1,20 @@
+-module(no_unused_fun2).
+-export([main/2]).
+
+main(X, Bool) ->
+ case Bool of
+ true ->
+ F = fun foo/1;
+ false ->
+ F = fun foobar/1
+ end,
+ spawn(fun()->calc(X, F)end).
+
+calc(X, Fun) ->
+ Fun(X).
+
+foo(A) ->
+ A+42.
+
+foobar(A) ->
+ A-42.
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/non_existing.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/non_existing.erl
new file mode 100644
index 0000000000..5701b8a745
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/non_existing.erl
@@ -0,0 +1,13 @@
+%%--------------------------------------------------------------------------
+%% Module which contains direct and indirect calls to remote functions
+%% which do not exist. Their treatment should be the same.
+%%--------------------------------------------------------------------------
+-module(non_existing).
+-export([t_call/0, t_fun/0]).
+
+t_call() ->
+ lists:non_existing_call(42).
+
+t_fun() ->
+ Fun = fun lists:non_existing_fun/1,
+ Fun(42).
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/not_guard_crash.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/not_guard_crash.erl
new file mode 100644
index 0000000000..0350864dce
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/not_guard_crash.erl
@@ -0,0 +1,49 @@
+%% From: Matthias Radestock <[email protected]>
+%% Date: 19 August 2007
+%%
+%% when I run dialyzer on my code it throws the following error:
+%%
+%% Analysis failed with error report:
+%% {{case_clause,any},
+%% [{dialyzer_dataflow,bind_guard,5},
+%% {dialyzer_dataflow,bind_guard_case_clauses,6},
+%% {dialyzer_dataflow,bind_guard,5},
+%% {dialyzer_dataflow,bind_guard_case_clauses,6},
+%% {dialyzer_dataflow,bind_guard,5},
+%% {dialyzer_dataflow,bind_eqeq_guard_lit_other,6},
+%% {dialyzer_dataflow,bind_guard,...},
+%% {dialyzer_dataflow,...}]}
+%%
+%% This is happening with the R11B-5 version of dialyzer when
+%% analyzing the attached file.
+%%--------------------------------------------------------------------
+
+-module(not_guard_crash).
+
+-export([match_ticket/2]).
+
+-record(ticket, {passive_flag, active_flag, write_flag, read_flag}).
+
+%%--------------------------------------------------------------------
+
+match_ticket(#ticket{passive_flag = PP,
+ active_flag = PA,
+ write_flag = PW,
+ read_flag = PR},
+ #ticket{passive_flag = TP,
+ active_flag = TA,
+ write_flag = TW,
+ read_flag = TR}) ->
+ if
+ %% Matches if either we're not requesting passive access, or
+ %% passive access is permitted, and ...
+ (not(TP) orelse PP) andalso
+ (not(TA) orelse PA) andalso
+ (not(TW) orelse PW) andalso
+ (not(TR) orelse PR) ->
+ match;
+ true ->
+ no_match
+ end.
+
+%%--------------------------------------------------------------------
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/or_bug.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/or_bug.erl
new file mode 100644
index 0000000000..fb8f6558b8
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/or_bug.erl
@@ -0,0 +1,24 @@
+%%---------------------------------------------------------------------------
+%% From: Per Hedeland <[email protected]>
+%% Date: 11 Feb 2010
+%%
+%% The code below demonstrates a bug in dialyzer - it produces the warning:
+%% Clause guard cannot succeed.
+%% The variable Cs was matched against the type any()
+%% for the first test/1 clause, but of course the claim can easily be easily
+%% refuted by calling test(#cs{}).
+%%---------------------------------------------------------------------------
+
+-module(or_bug).
+
+-export([test/1]).
+
+-record(cs, {children = [], actions = []}).
+
+-define(is_internal(X), ((X#cs.children =/= []) or
+ (X#cs.actions =/= []))).
+-define(has_children(X), (X#cs.children /= [])).
+
+test(Cs) when not ?is_internal(Cs) -> foo;
+test(Cs) when not ?has_children(Cs) -> bar;
+test(Cs) when Cs#cs.children =/= [] -> baz.
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/orelsebug.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/orelsebug.erl
new file mode 100644
index 0000000000..626f2b7f03
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/orelsebug.erl
@@ -0,0 +1,17 @@
+%%%-------------------------------------------------------------------
+%%% File : orelsebug.erl
+%%% Author : Tobias Lindahl <[email protected]>
+%%% Description :
+%%%
+%%% Created : 14 Nov 2006 by Tobias Lindahl <[email protected]>
+%%%-------------------------------------------------------------------
+-module(orelsebug).
+
+-export([t/1, t1/1]).
+
+t(Format) when is_list(Format) ->
+ t1(Format).
+
+t1(Format) when is_list(Format) orelse is_binary(Format) ->
+ Format.
+
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/orelsebug2.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/orelsebug2.erl
new file mode 100644
index 0000000000..52b1b3b5a9
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/orelsebug2.erl
@@ -0,0 +1,23 @@
+%%%-------------------------------------------------------------------
+%%% File : orelsebug2.erl
+%%% Author : Tobias Lindahl <[email protected]>
+%%% Description :
+%%%
+%%% Created : 21 Nov 2006 by Tobias Lindahl <[email protected]>
+%%%-------------------------------------------------------------------
+-module(orelsebug2).
+
+-export([t/1]).
+
+-record(eventdata, {
+ expires
+ }).
+
+t(L) ->
+ L2 = [E1 || E1 <- L, E1#eventdata.expires == x
+ orelse E1#eventdata.expires == y],
+
+ case L2 of
+ [_E] -> x;
+ [] -> y
+ end.
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/overloaded1.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/overloaded1.erl
new file mode 100644
index 0000000000..0af4f7446f
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/overloaded1.erl
@@ -0,0 +1,31 @@
+%%-----------------------------------------------------------------------------
+%% Test that tests overloaded contratcs.
+%% In December 2008 it works as far as intersection types are concerned (test1)
+%% However, it does NOT work as far as type variables are concerned (test2)
+%%-----------------------------------------------------------------------------
+-module(overloaded1).
+-export([test1/0, test2/0, foo/2]).
+
+test1() ->
+ {ok, gazonk} = foo({a,b,1}, atom_to_list(gazonk)),
+ ok.
+
+test2() ->
+ {ok, gazonk} = foo(baz, []),
+ ok.
+
+-type mod() :: atom().
+
+-spec foo(ATM, list()) -> {'ok', ATM} | {'error', _} when is_subtype(ATM, mod())
+ ; (MFA, list()) -> {'ok', MFA} | {'error', _} when is_subtype(MFA, mfa()).
+
+foo(F, _) when is_atom(F) ->
+ case atom_to_list(F) of
+ [42|_] -> {ok, F};
+ _Other -> {error, mod:bar(F)}
+ end;
+foo({M,F,A}, _) ->
+ case A =:= 0 of
+ false -> {ok, {M,F,A}};
+ true -> {error, M}
+ end.
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/port_info_test.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/port_info_test.erl
new file mode 100644
index 0000000000..d8a5e15caf
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/port_info_test.erl
@@ -0,0 +1,34 @@
+%%
+%% Tests hardcoded dependent type info
+%% and the quality of the warnings that Dialyzer spits out
+%%
+-module(port_info_test).
+-export([t1/1, t2/1, t3/1, t4/1, t5/2, buggy/1]).
+
+%% The following errors are correctly caught, but the messages are a bit weird
+t1(X) when is_port(X) ->
+ {connected, 42} = erlang:port_info(X, connected);
+t1(_) -> ok.
+
+t2(X) when is_port(X) ->
+ {registered_name, "42"} = erlang:port_info(X, registered_name);
+t2(_) -> ok.
+
+%% Here only one od the two errors is reported...
+t3(X) when is_atom(X) ->
+ {output, 42} = erlang:port_info(X, connected);
+t3(_) -> ok.
+
+t4(X) when is_atom(X) ->
+ {Atom, _} = erlang:port_info(X, connected),
+ Atom = links;
+t4(_) -> ok.
+
+t5(X, Atom) when is_port(X) ->
+ {gazonk, _} = erlang:port_info(X, Atom);
+t5(_, _) -> ok.
+
+%% The type system is not strong enough to catch the following errors
+buggy(X) when is_atom(X) ->
+ {links, X} = erlang:port_info(foo, X).
+
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/process_info_test.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/process_info_test.erl
new file mode 100644
index 0000000000..d098884f4d
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/process_info_test.erl
@@ -0,0 +1,21 @@
+%%
+%% Tests hardcoded dependent type info for process_info/1
+%%
+-module(process_info_test).
+-export([pinfo/1]).
+
+pinfo(P) when node(P) == node() -> % On same node
+ case process_info(P) of
+ undefined ->
+ exit(dead);
+ Info -> Info
+ end;
+pinfo(P) -> % On different node
+ case rpc:call(node(P), erlang, process_info, [P]) of
+ {badrpc, _} ->
+ exit(badrpc);
+ undefined -> % This does happen
+ exit(dead);
+ Info -> Info
+ end.
+
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/pubsub/pubsub_api.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/pubsub/pubsub_api.erl
new file mode 100644
index 0000000000..c30233b8f5
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/pubsub/pubsub_api.erl
@@ -0,0 +1,99 @@
+% Copyright 2007-2008 Konrad-Zuse-Zentrum für Informationstechnik Berlin
+%
+% Licensed under the Apache License, Version 2.0 (the "License");
+% you may not use this file except in compliance with the License.
+% You may obtain a copy of the License at
+%
+% http://www.apache.org/licenses/LICENSE-2.0
+%
+% Unless required by applicable law or agreed to in writing, software
+% distributed under the License is distributed on an "AS IS" BASIS,
+% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+% See the License for the specific language governing permissions and
+% limitations under the License.
+%%%-------------------------------------------------------------------
+%%% File : pubsub_api.erl
+%%% Author : Thorsten Schuett <[email protected]>
+%%% Description : Publish API function
+%%%
+%%% Created : 17 Sep 2007 by Thorsten Schuett <[email protected]>
+%%%-------------------------------------------------------------------
+%% @author Thorsten Schuett <[email protected]>
+%% @copyright 2007-2008 Konrad-Zuse-Zentrum für Informationstechnik Berlin
+%% @version $Id $
+-module(pubsub_dir.pubsub_api).
+
+-author('[email protected]').
+-vsn('$Id: pubsub_api.erl,v 1.1 2009/11/06 12:39:55 maria Exp $ ').
+
+-export([publish/2, subscribe/2, unsubscribe/2, get_subscribers/1]).
+
+-import(transstore.transaction_api).
+-import(io).
+-import(lists).
+
+%%====================================================================
+%% public functions
+%%====================================================================
+
+%% @doc publishs an event under a given topic.
+%% called e.g. from the java-interface
+%% @spec publish(string(), string()) -> ok
+publish(Topic, Content) ->
+ Subscribers = get_subscribers(Topic),
+ io:format("calling subscribers ~p~n", [Subscribers]),
+ lists:foreach(fun (Subscriber) ->
+ io:format("calling ~p~n", [Subscriber]),
+ pubsub_publish:publish(Subscriber, Topic, Content)
+ end,
+ Subscribers),
+ ok.
+
+%% @doc subscribes a url for a topic.
+%% called e.g. from the java-interface
+%% @spec subscribe(string(), string()) -> ok | {fail, term()}
+subscribe(Topic, URL) ->
+ TFun = fun(TransLog) ->
+ {{Success, _ValueOrReason} = Result, TransLog1} = transaction_api:read(Topic, TransLog),
+ {Result2, TransLog2} = if
+ Success == fail ->
+ transaction_api:write(Topic, [URL], TransLog); %obacht: muss TransLog sein!
+ true ->
+ {value, Subscribers} = Result,
+ transaction_api:write(Topic, [URL | Subscribers], TransLog1)
+ end,
+ if
+ Result2 == ok ->
+ {{ok, ok}, TransLog2};
+ true ->
+ {Result2, TransLog2}
+ end
+ end,
+ transaction_api:do_transaction(TFun, fun (_) -> ok end, fun (X) -> {fail, X} end).
+
+%% @doc unsubscribes a url for a topic.
+-spec(unsubscribe/2 :: (string(), string()) -> ok | {fail, any()}).
+unsubscribe(Topic, URL) ->
+ TFun = fun(TransLog) ->
+ {Subscribers, TransLog1} = transaction_api:read2(TransLog, Topic),
+ case lists:member(URL, Subscribers) of
+ true ->
+ NewSubscribers = lists:delete(URL, Subscribers),
+ TransLog2 = transaction_api:write2(TransLog1, Topic, NewSubscribers),
+ {{ok, ok}, TransLog2};
+ false ->
+ {{fail, not_found}, TransLog}
+ end
+ end,
+ transaction_api:do_transaction(TFun, fun (_) -> ok end, fun (X) -> {fail, X} end).
+
+%% @doc queries the subscribers of a query
+%% @spec get_subscribers(string()) -> [string()]
+get_subscribers(Topic) ->
+ {Fl, _Value} = transaction_api:quorum_read(Topic),
+ if
+ Fl == fail -> %% Fl is either Fail or the Value/Subscribers
+ [];
+ true ->
+ Fl
+ end.
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/pubsub/pubsub_publish.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/pubsub/pubsub_publish.erl
new file mode 100644
index 0000000000..97c993e576
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/pubsub/pubsub_publish.erl
@@ -0,0 +1,50 @@
+% Copyright 2008 Konrad-Zuse-Zentrum für Informationstechnik Berlin
+%
+% Licensed under the Apache License, Version 2.0 (the "License");
+% you may not use this file except in compliance with the License.
+% You may obtain a copy of the License at
+%
+% http://www.apache.org/licenses/LICENSE-2.0
+%
+% Unless required by applicable law or agreed to in writing, software
+% distributed under the License is distributed on an "AS IS" BASIS,
+% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+% See the License for the specific language governing permissions and
+% limitations under the License.
+%%%-------------------------------------------------------------------
+%%% File : pubsub_publish.erl
+%%% Author : Thorsten Schuett <[email protected]>
+%%% Description : Publish function
+%%%
+%%% Created : 26 Mar 2008 by Thorsten Schuett <[email protected]>
+%%%-------------------------------------------------------------------
+%% @author Thorsten Schuett <[email protected]>
+%% @copyright 2008 Konrad-Zuse-Zentrum für Informationstechnik Berlin
+%% @version $Id $
+-module(pubsub_dir.pubsub_publish).
+
+-author('[email protected]').
+-vsn('$Id: pubsub_publish.erl,v 1.1 2009/11/06 12:39:55 maria Exp $ ').
+
+-export([publish/3, publish_internal/3]).
+
+-import(json).
+-import(io).
+-import(http).
+-import(jsonrpc).
+
+%%====================================================================
+%% public functions
+%%====================================================================
+
+%% @doc publishs an event to a given url.
+%% @spec publish(string(), string(), string()) -> ok
+%% @todo use pool:pspawn
+publish(URL, Topic, Content) ->
+ spawn(fun () -> pubsub_publish:publish_internal(URL, Topic, Content) end),
+ ok.
+
+publish_internal(URL, Topic, Content) ->
+ Res = jsonrpc:call(URL, [], {call, notify, [Topic, Content]}),
+ io:format("~p ~p~n", [Res, URL]).
+
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/receive1.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/receive1.erl
new file mode 100644
index 0000000000..2699a6da51
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/receive1.erl
@@ -0,0 +1,17 @@
+%%%-------------------------------------------------------------------
+%%% File : receive1.erl
+%%% Author : Tobias Lindahl <[email protected]>
+%%% Description :
+%%%
+%%% Created : 27 Mar 2007 by Tobias Lindahl <[email protected]>
+%%%-------------------------------------------------------------------
+-module(receive1).
+
+-export([t/1]).
+
+t(X) ->
+ receive
+ after
+ infinity -> X
+ end.
+
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/record_construct.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/record_construct.erl
new file mode 100644
index 0000000000..627e23956b
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/record_construct.erl
@@ -0,0 +1,22 @@
+-module(record_construct).
+-export([t_loc/0, t_opa/0, t_rem/0]).
+
+-record(r_loc, {a = gazonk :: integer(), b = 42 :: atom()}).
+
+t_loc() ->
+ #r_loc{}.
+
+-record(r_opa, {a :: atom(),
+ b = gb_sets:new() :: gb_set(),
+ c = 42 :: boolean(),
+ d, % untyped on purpose
+ e = false :: boolean()}).
+
+t_opa() ->
+ #r_opa{}.
+
+-record(r_rem, {a = gazonk :: string()}).
+
+t_rem() ->
+ #r_rem{}.
+
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/record_pat.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/record_pat.erl
new file mode 100644
index 0000000000..89228b8357
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/record_pat.erl
@@ -0,0 +1,19 @@
+%%%-------------------------------------------------------------------
+%%% File : record_pat.erl
+%%% Author : Tobias Lindahl <>
+%%% Description : Emit warning if a pattern violates the record type
+%%%
+%%% Created : 21 Oct 2008 by Tobias Lindahl <>
+%%%-------------------------------------------------------------------
+-module(record_pat).
+
+-export([t/1]).
+
+-record(foo, {bar :: integer()}).
+
+t(#foo{bar=baz}) -> no_way;
+t(#foo{bar=1}) -> ok.
+
+
+
+
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/record_send_test.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/record_send_test.erl
new file mode 100644
index 0000000000..742519e54e
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/record_send_test.erl
@@ -0,0 +1,33 @@
+%%-------------------------------------------------------------------
+%% File : record_send_test.erl
+%% Author : Kostis Sagonas <[email protected]>
+%% Description : A test inspired by a post of Mkcael Remond to the
+%% Erlang mailing list suggesting thst Dialyzer should
+%% be reporting sends to records rather than to pids.
+%% Dialyzer v1.3.0 indeed reports one of the dicrepancies
+%% (the one with the 4-tuple) but not the one where the
+%% message is sent to a pair which is a record.
+%% This should be fixed.
+%%
+%% Created : 10 Apr 2005 by Kostis Sagonas <[email protected]>
+%%-------------------------------------------------------------------
+-module(record_send_test).
+
+-export([t/0]).
+
+-record(rec1, {a=a, b=b, c=c}).
+-record(rec2, {a}).
+
+t() ->
+ t(#rec1{}).
+
+t(Rec1 = #rec1{b=B}) ->
+ Rec2 = some_mod:some_function(),
+ if
+ is_record(Rec2, rec2) ->
+ Rec2 ! hello; %% currently this one is not found
+ true ->
+ Rec1 ! hello_again
+ end,
+ B.
+
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/record_test.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/record_test.erl
new file mode 100644
index 0000000000..8151e595a0
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/record_test.erl
@@ -0,0 +1,24 @@
+%%%-------------------------------------------------------------------
+%%% File : record_test.erl
+%%% Author : Tobias Lindahl <[email protected]>
+%%% Description :
+%%%
+%%% Created : 22 Oct 2004 by Tobias Lindahl <[email protected]>
+%%%-------------------------------------------------------------------
+-module(record_test).
+
+-export([t/0]).
+
+-record(foo, {bar}).
+
+t() ->
+ doit(foo).
+
+doit(X) ->
+ case X of
+ #foo{} -> error1;
+ foo -> ok;
+ _ -> error2
+ end.
+
+
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/recursive_types1.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/recursive_types1.erl
new file mode 100644
index 0000000000..657d11653b
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/recursive_types1.erl
@@ -0,0 +1,10 @@
+-module(recursive_types1).
+
+-export([test/0]).
+
+-type tree() :: 'nil' | {non_neg_integer(), tree(), tree()}.
+
+-spec test() -> {42, tree(), tree()}.
+
+test() ->
+ {42, {42, nil, nil}, {42, {42, nil, nil}, {42, nil, nil}}}.
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/recursive_types2.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/recursive_types2.erl
new file mode 100644
index 0000000000..3a22bbf5d2
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/recursive_types2.erl
@@ -0,0 +1,12 @@
+-module(recursive_types2).
+
+-export([test/0]).
+
+-type tree() :: 'nil' | {non_neg_integer(), child(), child()}.
+
+-type child() :: tree().
+
+-spec test() -> {42, tree(), tree()}.
+
+test() ->
+ {42, {42, nil, nil}, {42, {42, nil, nil}, {42, nil, nil}}}.
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/recursive_types3.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/recursive_types3.erl
new file mode 100644
index 0000000000..997678ac92
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/recursive_types3.erl
@@ -0,0 +1,15 @@
+-module(recursive_types3).
+
+-export([test/1]).
+
+-record(tree, {node :: atom(),
+ kid = nil :: 'nil' | tree()}).
+
+-type tree() :: #tree{}.
+
+-spec test(tree()) -> tree().
+
+test(Tree) ->
+ case Tree of
+ #tree{node = root, kid=#tree{}} -> Tree
+ end.
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/recursive_types4.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/recursive_types4.erl
new file mode 100644
index 0000000000..118bab57a1
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/recursive_types4.erl
@@ -0,0 +1,13 @@
+-module(recursive_types4).
+
+-export([test/0]).
+
+-record(tree, {node :: atom(),
+ kid = nil :: 'nil' | tree()}).
+
+-type tree() :: #tree{}.
+
+-spec test() -> tree().
+
+test() ->
+ #tree{node = root, kid = #tree{}}.
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/recursive_types5.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/recursive_types5.erl
new file mode 100644
index 0000000000..a71e613cf0
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/recursive_types5.erl
@@ -0,0 +1,13 @@
+-module(recursive_types5).
+
+-export([test/0]).
+
+-type tree() :: 'nil' | {non_neg_integer(), tree(), tree()}.
+
+-record(tree, {node :: atom(),
+ kid = 'nil' :: tree()}).
+
+-spec test() -> #tree{}.
+
+test() ->
+ #tree{node = root, kid = {42, {42, nil, nil}, {42, nil, nil}}}.
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/recursive_types6.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/recursive_types6.erl
new file mode 100644
index 0000000000..ff61976736
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/recursive_types6.erl
@@ -0,0 +1,17 @@
+-module(recursive_types6).
+
+-export([test/0]).
+
+-record(tree, {node :: non_neg_integer(),
+ kid = nil :: child()}).
+
+-type tree() :: #tree{}.
+
+-record(child, {tree :: 'nil' | tree()}).
+
+-type child() :: #child{}.
+
+-spec test() -> tree().
+
+test() ->
+ #tree{node = 42, kid = #child{tree = #tree{node = 42, kid = #child{tree = nil}}}}.
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/recursive_types7.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/recursive_types7.erl
new file mode 100644
index 0000000000..92106e9694
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/recursive_types7.erl
@@ -0,0 +1,13 @@
+-module(recursive_types7).
+
+-export([test/0]).
+
+-type tree() :: 'nil' | {non_neg_integer(), recursive_types7:tree(),
+ recursive_types7:tree()}.
+
+-export_type([tree/0]).
+
+-spec test() -> {42, tree(), tree()}.
+
+test() ->
+ {42, {42, nil, nil}, {42, {42, nil, nil}, {42, nil, nil}}}.
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/refine_bug1.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/refine_bug1.erl
new file mode 100644
index 0000000000..1b299e782a
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/refine_bug1.erl
@@ -0,0 +1,11 @@
+-module(refine_bug1).
+-export([f/1]).
+
+f(gazonk = X) ->
+ foo(X), % this call is currently not considered when refining foo's
+ throw(error); % type since it appears in a clause that throws an exception
+f(foo = X) ->
+ foo(X).
+
+foo(X) ->
+ X.
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/toth.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/toth.erl
new file mode 100644
index 0000000000..bd7fa4982e
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/toth.erl
@@ -0,0 +1,99 @@
+-module(toth).
+-export([sys_table_view/1]).
+
+%%% Constants
+-define(sysTabETS,1).
+-define(sysTabMnesia,2).
+-define(sysTabBoth,3).
+
+sys_table_view([CpId,{match,Pattern},TableType, ViewType]) ->
+ AllTableList =
+ case TableType of
+ ?sysTabMnesia ->
+ lists:sort(mnesia:system_info(tables));
+ ?sysTabBoth ->
+ lists:sort(rpc:call(CpId,ets,all,[]));
+ ?sysTabETS ->
+ lists:sort(rpc:call(CpId,ets,all,[]) --
+ mnesia:system_info(tables));
+ _ -> %%% Happens at registration only
+ [ok]
+ end,
+ %% Filter the matching table names, skip unnamed tables first:
+ NamedTableList = lists:filter(fun (X) -> is_atom(X) end, AllTableList),
+ TablesShown =
+ case Pattern of
+ "" ->
+ NamedTableList;
+ _ ->
+ %% Filter the ones whose name begins with the Pattern:
+ Filter = fun(T) ->
+ lists:prefix(Pattern, atom_to_list(T))
+ end,
+ lists:filter(Filter, NamedTableList)
+ end,
+
+ Fields = [{text, [{value,"CpId: " ++ atom_to_list(CpId)}]},
+ {text, [{value,"TabSpec=" ++ Pattern},
+ {value_format, term}]},
+ {text, [{value,"Table type: " ++ formatTableType(TableType)},
+ {value_format, term}]}],
+
+ Template = [[{type, index},
+ {link, {?MODULE, sys_table_browse,
+ [{"CpId",CpId},{"TableType",TableType},
+ {"View", ViewType},
+ {"FirstKey",1}, {"KeyPattern",""}]}}],
+
+ [{type, data},
+ {title, "Table name"},
+ {display_value, {erlang, atom_to_list}}], %%% else crash
+
+ [{type,data},
+ {title, "No of rows"},
+ {display_value, term}],
+
+ [{type,data},
+ {title, "Memory"},
+ {display_value, term}]
+ ],
+
+ TableAttr = [{rows, [[T,T|tableSize(T,TableType,CpId)] ||
+ T <- TablesShown]},
+ {template,Template}],
+
+ Page = [{header, {"Filter tables", "Selected tables"}},
+ {buttons, [reload, back]},
+ {layout, [{form, Fields},
+ {table, TableAttr}]}
+ ],
+ Page.
+
+%%--------------------------------------------------------------------
+%% tableSize/3
+%% @spec tableSize(T::atom(),TableType::integer(),CpId::atom()) ->
+%% list(integer())
+%% @doc Return the table size and memory size of the table.
+%% @end
+%%---------------------------------------------------------------------
+
+tableSize(T, TableType, CpId) ->
+ case TableType of
+ ?sysTabETS ->
+ [rpc:call(CpId, ets, info, [T, size]),
+ rpc:call(CpId, ets, info, [T, memory])];
+ ?sysTabMnesia ->
+ [mnesia:table_info(T, size),mnesia:table_info(T, memory)];
+ _ -> %%% Registration
+ [0,0]
+ end.
+
+formatTableType(T) ->
+ case T of
+ ?sysTabETS ->
+ "ETS";
+ ?sysTabMnesia ->
+ "mnesia";
+ _ -> %%% Registration !
+ "ETS + mnesia"
+ end.
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/trec.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/trec.erl
new file mode 100644
index 0000000000..b36b0cafba
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/trec.erl
@@ -0,0 +1,37 @@
+%%
+%% The current treatment of typed records leaves much to be desired.
+%% These are not made up examples; I have cases like that the branch
+%% of the HiPE compiler with types in records. I get very confusing
+%% warnings which require a lot of effort to find their cause and why
+%% a function has no local return.
+%%
+-module(trec).
+-export([test/0, mk_foo_exp/2]).
+
+-record(foo, {a :: integer(), b :: [atom()]}).
+
+%%
+%% For these functions we currently get the following warnings:
+%% 1. Function test/0 has no local return
+%% 2. The call trec:mk_foo_loc(42,any()) will fail since it differs
+%% in argument position 1 from the success typing arguments:
+%% ('undefined',atom())
+%% 3. Function mk_foo_loc/2 has no local return
+%%
+%% Arguably, the second warning is not what most users have in mind
+%% when they wrote the type declarations in the 'foo' record, so no
+%% doubt they'll find it confusing. But note that it is also inconsistent!
+%% How come there is a success typing for a function that has no local return?
+%%
+test() ->
+ mk_foo_loc(42, bar:f()).
+
+mk_foo_loc(A, B) ->
+ #foo{a = A, b = [A,B]}.
+
+%%
+%% For this function we currently get "has no local return" but we get
+%% no reason; I want us to get a reason.
+%%
+mk_foo_exp(A, B) when is_integer(A) ->
+ #foo{a = A, b = [A,B]}.
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/try1.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/try1.erl
new file mode 100644
index 0000000000..d07380295b
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/try1.erl
@@ -0,0 +1,27 @@
+%%%-------------------------------------------------------------------
+%%% File : try1.erl
+%%% Author : <[email protected]>
+%%% Description :
+%%%
+%%% Created : 23 Aug 2005 by <[email protected]>
+%%%-------------------------------------------------------------------
+-module(try1).
+
+-export([t/1]).
+
+t(X) ->
+ case wierd_is_bool(X) of
+ true -> ok;
+ false -> ok
+ end.
+
+wierd_is_bool(X) ->
+ try bool(X) of
+ Y -> Y
+ catch
+ _:_ -> false
+ end.
+
+bool(true) -> true;
+bool(false) -> true.
+
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/tuple1.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/tuple1.erl
new file mode 100644
index 0000000000..c58aac9646
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/tuple1.erl
@@ -0,0 +1,29 @@
+%%%-------------------------------------------------------------------
+%%% File : tuple1.erl
+%%% Author : Tobias Lindahl <[email protected]>
+%%% Description : Exposed two bugs in the analysis;
+%%% one supressed warning and one crash.
+%%%
+%%% Created : 13 Nov 2006 by Tobias Lindahl <[email protected]>
+%%%-------------------------------------------------------------------
+-module(tuple1).
+
+-export([t1/2, t2/2, t3/2, bar/2]).
+
+t1(List = [_|_], X) ->
+ lists:mapfoldl(fun foo/2, X, List).
+
+t2(List = [_|_], X) ->
+ lists:mapfoldl(fun bar/2, X, List).
+
+t3(List = [_|_], X) ->
+ lists:mapfoldl(fun baz/1, X, List).
+
+
+foo(1, 1) -> a;
+foo(a, 1) -> b.
+
+bar(1, 1) -> {b, b};
+bar(a, 1) -> {a, a}.
+
+baz(1) -> 1.
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/unsafe_beamcode_bug.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/unsafe_beamcode_bug.erl
new file mode 100644
index 0000000000..889f94014e
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/unsafe_beamcode_bug.erl
@@ -0,0 +1,15 @@
+-module(unsafe_beamcode_bug).
+-export([test/1]).
+
+test(N) -> i(r(N)).
+
+%% this function cannot be exported, or the error does not occur
+i({one}) -> ok1;
+i({two, _}) -> ok2;
+i({three, {_,R}, _}) -> R.
+
+r(1) -> {one};
+r(2) -> {two, 2};
+r(42)-> {dummy, 42}; % without this clause, no problem ... hmm
+r(3) -> {three, {rec,ok3}, 2}.
+
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/unused_cases.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/unused_cases.erl
new file mode 100644
index 0000000000..e6e6693963
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/unused_cases.erl
@@ -0,0 +1,41 @@
+%%-------------------------------------------------------------------
+%% File : unused_cases.erl
+%% Author : Kostis Sagonas <[email protected]>
+%% Description : Tests that Dialyzer warns whenever it finds unused
+%% case clauses -- even those that are catch all.
+%%
+%% Created : 21 Jan 2007 by Kostis Sagonas <[email protected]>
+%%-------------------------------------------------------------------
+
+-module(unused_cases).
+-export([test/0]).
+
+test() -> % dummy function to avoid exporting stuff
+ ok = unreachable_catchall(42),
+ ok = unreachable_middle(42),
+ ok = unreachable_final(42).
+
+unreachable_catchall(X) ->
+ case mk_pair(X) of
+ {_,_} -> ok;
+ OTHER -> {unreachable_catchall, OTHER}
+ end.
+
+unreachable_middle(X) ->
+ case is_positive(X) of
+ true -> ok;
+ weird -> {unreachable_middle, weird};
+ false -> ok
+ end.
+
+unreachable_final(X) ->
+ case is_positive(X) of
+ true -> ok;
+ false -> ok;
+ OTHER-> {unreachable_final, OTHER}
+ end.
+
+mk_pair(X) -> {X, X}.
+
+is_positive(X) when is_integer(X), X > 0 -> true;
+is_positive(X) when is_integer(X) -> false.
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/unused_clauses.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/unused_clauses.erl
new file mode 100644
index 0000000000..a98b227a6b
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/unused_clauses.erl
@@ -0,0 +1,18 @@
+%%-------------------------------------------------------------------
+%% File : unused_clauses.erl
+%% Author : Kostis Sagonas <[email protected]>
+%% Description : Tests that Dialyzer warns when it finds an unused
+%% clause.
+%%
+%% Created : 16 Mar 2006 by Kostis Sagonas <[email protected]>
+%%-------------------------------------------------------------------
+
+-module(unused_clauses).
+-export([test/0]).
+
+test() -> {t(atom), t({42})}.
+
+t(X) when is_atom(X) -> X;
+t(X) when is_integer(X) -> X;
+t(X) when is_tuple(X) -> element(1, X);
+t(X) when is_binary(X) -> X.
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/zero_tuple.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/zero_tuple.erl
new file mode 100644
index 0000000000..90dc366fe7
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/zero_tuple.erl
@@ -0,0 +1,13 @@
+-module(zero_tuple).
+-export([t1/0, t2/0]).
+
+t1() ->
+ {} = a(),
+ ok.
+
+t2() ->
+ b = a(),
+ ok.
+
+a() -> a.
+