diff options
| author | Stavros Aronis <[email protected]> | 2011-04-02 18:57:42 +0300 |
|---|---|---|
| committer | Henrik Nord <[email protected]> | 2011-05-04 15:06:15 +0200 |
| commit | ca4633fd683527097451ca1398c90c87bb5c14fc (patch) | |
| tree | 3d8e18c9becd4feb7d3ceb1eed24bdce2ef69dd6 /lib/dialyzer/test/small_SUITE_data | |
| parent | bc619f0cbf9555df6dfc44a499f0cd9cee8bd1be (diff) | |
| download | otp-ca4633fd683527097451ca1398c90c87bb5c14fc.tar.gz otp-ca4633fd683527097451ca1398c90c87bb5c14fc.tar.bz2 otp-ca4633fd683527097451ca1398c90c87bb5c14fc.zip | |
Rename suite data directories
Diffstat (limited to 'lib/dialyzer/test/small_SUITE_data')
145 files changed, 3593 insertions, 0 deletions
diff --git a/lib/dialyzer/test/small_SUITE_data/dialyzer_options b/lib/dialyzer/test/small_SUITE_data/dialyzer_options new file mode 100644 index 0000000000..50991c9bc5 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/dialyzer_options @@ -0,0 +1 @@ +{dialyzer_options, []}. diff --git a/lib/dialyzer/test/small_SUITE_data/results/andalso_test b/lib/dialyzer/test/small_SUITE_data/results/andalso_test new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/andalso_test diff --git a/lib/dialyzer/test/small_SUITE_data/results/app_call b/lib/dialyzer/test/small_SUITE_data/results/app_call new file mode 100644 index 0000000000..cc1a63f944 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/app_call @@ -0,0 +1,3 @@ + +app_call.erl:6: The call M:'foo'() requires that M is of type atom() | tuple() not 42 +app_call.erl:9: The call 'mod':F() requires that F is of type atom() not {'gazonk',[]} diff --git a/lib/dialyzer/test/small_SUITE_data/results/appmon_place b/lib/dialyzer/test/small_SUITE_data/results/appmon_place new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/appmon_place diff --git a/lib/dialyzer/test/small_SUITE_data/results/areq b/lib/dialyzer/test/small_SUITE_data/results/areq new file mode 100644 index 0000000000..dd91f2d2bf --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/areq @@ -0,0 +1,2 @@ + +areq.erl:11: The test float() =:= 3 can never evaluate to 'true' diff --git a/lib/dialyzer/test/small_SUITE_data/results/atom_call b/lib/dialyzer/test/small_SUITE_data/results/atom_call new file mode 100644 index 0000000000..851bb7ab12 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/atom_call @@ -0,0 +1,3 @@ + +atom_call.erl:14: Fun application will fail since F :: 'f' is not a function of arity 0 +atom_call.erl:14: Function g/0 has no local return diff --git a/lib/dialyzer/test/small_SUITE_data/results/atom_widen b/lib/dialyzer/test/small_SUITE_data/results/atom_widen new file mode 100644 index 0000000000..6d0a7b2737 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/atom_widen @@ -0,0 +1,3 @@ + +atom_widen.erl:10: The call atom_widen:foo('z') will never return since it differs in the 1st argument from the success typing arguments: ('a' | 'b' | 'c' | 'd' | 'e' | 'f' | 'g' | 'h' | 'i' | 'k' | 'l' | 'm' | 'n') +atom_widen.erl:9: Function test/0 has no local return diff --git a/lib/dialyzer/test/small_SUITE_data/results/bs_fail_constr b/lib/dialyzer/test/small_SUITE_data/results/bs_fail_constr new file mode 100644 index 0000000000..dbc8241971 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/bs_fail_constr @@ -0,0 +1,9 @@ + +bs_fail_constr.erl:11: Function w3/1 has no local return +bs_fail_constr.erl:12: Binary construction will fail since the size field S in segment 42:S/integer-unit:1 has type neg_integer() +bs_fail_constr.erl:14: Function w4/1 has no local return +bs_fail_constr.erl:15: Binary construction will fail since the value field V in segment V/utf32 has type float() +bs_fail_constr.erl:5: Function w1/1 has no local return +bs_fail_constr.erl:6: Binary construction will fail since the value field V in segment V:8/integer-unit:1 has type float() +bs_fail_constr.erl:8: Function w2/1 has no local return +bs_fail_constr.erl:9: Binary construction will fail since the value field V in segment V/binary-unit:8 has type atom() diff --git a/lib/dialyzer/test/small_SUITE_data/results/bs_utf8 b/lib/dialyzer/test/small_SUITE_data/results/bs_utf8 new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/bs_utf8 diff --git a/lib/dialyzer/test/small_SUITE_data/results/cerl_hipeify b/lib/dialyzer/test/small_SUITE_data/results/cerl_hipeify new file mode 100644 index 0000000000..87bf6f309f --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/cerl_hipeify @@ -0,0 +1,4 @@ + +cerl_hipeify.erl:370: Function will never be called +cerl_hipeify.erl:370: Guard test fun((none()) -> none()) =:= F::{_,_,_} | {_,_,_,_} | {_,_,_,_,_} | {_,_,_,_,_,_} | {_,_,_,_,_,_,_} can never succeed +cerl_hipeify.erl:641: Function env__new_function_name/2 will never be called diff --git a/lib/dialyzer/test/small_SUITE_data/results/comm_layer b/lib/dialyzer/test/small_SUITE_data/results/comm_layer new file mode 100644 index 0000000000..cb4bf14eb4 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/comm_layer @@ -0,0 +1,2 @@ + +comm_layer.erl:76: Invalid type specification for function 'comm_layer_dir.comm_layer':this/0. The success typing is () -> {_,integer(),pid()} diff --git a/lib/dialyzer/test/small_SUITE_data/results/compare1 b/lib/dialyzer/test/small_SUITE_data/results/compare1 new file mode 100644 index 0000000000..f0d696ffcb --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/compare1 @@ -0,0 +1,4 @@ + +compare1.erl:15: Guard test X::42 > 42 can never succeed +compare1.erl:17: Guard test X::42 < 42 can never succeed +compare1.erl:19: Guard test X::42 =/= 42 can never succeed diff --git a/lib/dialyzer/test/small_SUITE_data/results/confusing_warning b/lib/dialyzer/test/small_SUITE_data/results/confusing_warning new file mode 100644 index 0000000000..d2d0c91fff --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/confusing_warning @@ -0,0 +1,2 @@ + +confusing_warning.erl:16: The pattern {'a', {_, L}} can never match the type {'b','aaa' | 'bbb'} diff --git a/lib/dialyzer/test/small_SUITE_data/results/contract1 b/lib/dialyzer/test/small_SUITE_data/results/contract1 new file mode 100644 index 0000000000..fb8ba5f72b --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/contract1 @@ -0,0 +1,3 @@ + +contract1.erl:23: Function test/0 has no local return +contract1.erl:24: The pattern 42 can never match the type 'a' | 'b' | 'c' diff --git a/lib/dialyzer/test/small_SUITE_data/results/contract2 b/lib/dialyzer/test/small_SUITE_data/results/contract2 new file mode 100644 index 0000000000..6809e528c4 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/contract2 @@ -0,0 +1,2 @@ + +contract2.erl:13: The call contract2:test(T::any(),nonempty_maybe_improper_list()) will never return since it differs in the 2nd argument from the success typing arguments: (['true'],[]) diff --git a/lib/dialyzer/test/small_SUITE_data/results/contract3 b/lib/dialyzer/test/small_SUITE_data/results/contract3 new file mode 100644 index 0000000000..44b49e745a --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/contract3 @@ -0,0 +1,3 @@ + +contract3.erl:17: Overloaded contract has overlapping domains; such contracts are currently unsupported and are simply ignored +contract3.erl:29: Overloaded contract has overlapping domains; such contracts are currently unsupported and are simply ignored diff --git a/lib/dialyzer/test/small_SUITE_data/results/contract5 b/lib/dialyzer/test/small_SUITE_data/results/contract5 new file mode 100644 index 0000000000..116c4f4d4d --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/contract5 @@ -0,0 +1,2 @@ + +contract5.erl:13: Invalid type specification for function contract5:t/0. The success typing is () -> #bar{baz::'not_a_boolean'} diff --git a/lib/dialyzer/test/small_SUITE_data/results/eqeq b/lib/dialyzer/test/small_SUITE_data/results/eqeq new file mode 100644 index 0000000000..dabd38ebe3 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/eqeq @@ -0,0 +1,2 @@ + +eqeq.erl:15: The test float() =:= 'foo' can never evaluate to 'true' diff --git a/lib/dialyzer/test/small_SUITE_data/results/ets_select b/lib/dialyzer/test/small_SUITE_data/results/ets_select new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/ets_select diff --git a/lib/dialyzer/test/small_SUITE_data/results/exhaust_case b/lib/dialyzer/test/small_SUITE_data/results/exhaust_case new file mode 100644 index 0000000000..45cdd80b64 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/exhaust_case @@ -0,0 +1,3 @@ + +exhaust_case.erl:17: The pattern 42 can never match the type 'bar' | 'foo' +exhaust_case.erl:18: The variable _other can never match since previous clauses completely covered the type 'bar' | 'foo' diff --git a/lib/dialyzer/test/small_SUITE_data/results/failing_guard1 b/lib/dialyzer/test/small_SUITE_data/results/failing_guard1 new file mode 100644 index 0000000000..5bdd13093a --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/failing_guard1 @@ -0,0 +1,4 @@ + +failing_guard1.erl:12: Guard test float() =:= 2 can never succeed +failing_guard1.erl:13: Guard test integer() =:= float() can never succeed +failing_guard1.erl:14: Guard test -2 | -1 | 0 | 1 | 2 =:= float() can never succeed diff --git a/lib/dialyzer/test/small_SUITE_data/results/flatten b/lib/dialyzer/test/small_SUITE_data/results/flatten new file mode 100644 index 0000000000..4571214e49 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/flatten @@ -0,0 +1,2 @@ + +flatten.erl:17: The call lists:flatten(nonempty_improper_list(atom() | binary() | [any()] | char(),atom())) will never return since it differs in the 1st argument from the success typing arguments: ([any()]) diff --git a/lib/dialyzer/test/small_SUITE_data/results/fun_app b/lib/dialyzer/test/small_SUITE_data/results/fun_app new file mode 100644 index 0000000000..b28baad43b --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/fun_app @@ -0,0 +1,7 @@ + +fun_app.erl:37: Fun application will fail since F :: fun((_,_,_) -> 'ok' | 'true') is not a function of arity 1 +fun_app.erl:37: The created fun has no local return +fun_app.erl:38: Fun application will fail since F :: fun((_,_,_) -> 'ok' | 'true') is not a function of arity 2 +fun_app.erl:38: The created fun has no local return +fun_app.erl:40: Fun application will fail since F :: fun((_,_,_) -> 'ok' | 'true') is not a function of arity 4 +fun_app.erl:40: The created fun has no local return diff --git a/lib/dialyzer/test/small_SUITE_data/results/fun_ref_match b/lib/dialyzer/test/small_SUITE_data/results/fun_ref_match new file mode 100644 index 0000000000..60b34530b4 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/fun_ref_match @@ -0,0 +1,2 @@ + +fun_ref_match.erl:14: Function will never be called diff --git a/lib/dialyzer/test/small_SUITE_data/results/gencall b/lib/dialyzer/test/small_SUITE_data/results/gencall new file mode 100644 index 0000000000..d0479ed738 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/gencall @@ -0,0 +1,4 @@ + +gencall.erl:11: Call to missing or unexported function gencall:foo/0 +gencall.erl:12: Call to missing or unexported function gen_server:handle_cast/2 +gencall.erl:9: Call to missing or unexported function ets:lookup/3 diff --git a/lib/dialyzer/test/small_SUITE_data/results/gs_make b/lib/dialyzer/test/small_SUITE_data/results/gs_make new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/gs_make diff --git a/lib/dialyzer/test/small_SUITE_data/results/inf_loop2 b/lib/dialyzer/test/small_SUITE_data/results/inf_loop2 new file mode 100644 index 0000000000..7e9972ad98 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/inf_loop2 @@ -0,0 +1,4 @@ + +inf_loop2.erl:18: Function test/0 has no local return +inf_loop2.erl:19: The call lists:reverse('gazonk') will never return since it differs in the 1st argument from the success typing arguments: ([any()]) +inf_loop2.erl:22: Function loop/0 has no local return diff --git a/lib/dialyzer/test/small_SUITE_data/results/invalid_specs b/lib/dialyzer/test/small_SUITE_data/results/invalid_specs new file mode 100644 index 0000000000..c95c0ff1f8 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/invalid_specs @@ -0,0 +1,3 @@ + +invalid_spec1.erl:5: Invalid type specification for function invalid_spec1:get_plan_dirty/1. The success typing is ([string()]) -> {maybe_improper_list(),[atom()]} +invalid_spec2.erl:5: Function foo/0 has no local return diff --git a/lib/dialyzer/test/small_SUITE_data/results/letrec1 b/lib/dialyzer/test/small_SUITE_data/results/letrec1 new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/letrec1 diff --git a/lib/dialyzer/test/small_SUITE_data/results/list_match b/lib/dialyzer/test/small_SUITE_data/results/list_match new file mode 100644 index 0000000000..95007da604 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/list_match @@ -0,0 +1,2 @@ + +list_match.erl:19: The pattern [_ | T] can never match since previous clauses completely covered the type [1 | 2 | 3 | 4] diff --git a/lib/dialyzer/test/small_SUITE_data/results/lzip b/lib/dialyzer/test/small_SUITE_data/results/lzip new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/lzip diff --git a/lib/dialyzer/test/small_SUITE_data/results/make_tuple b/lib/dialyzer/test/small_SUITE_data/results/make_tuple new file mode 100644 index 0000000000..4d51586e35 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/make_tuple @@ -0,0 +1,3 @@ + +make_tuple.erl:4: Function test/0 has no local return +make_tuple.erl:5: The pattern {_, _} can never match the type {_,_,_} diff --git a/lib/dialyzer/test/small_SUITE_data/results/minus_minus b/lib/dialyzer/test/small_SUITE_data/results/minus_minus new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/minus_minus diff --git a/lib/dialyzer/test/small_SUITE_data/results/mod_info b/lib/dialyzer/test/small_SUITE_data/results/mod_info new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/mod_info diff --git a/lib/dialyzer/test/small_SUITE_data/results/my_filter b/lib/dialyzer/test/small_SUITE_data/results/my_filter new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/my_filter diff --git a/lib/dialyzer/test/small_SUITE_data/results/my_sofs b/lib/dialyzer/test/small_SUITE_data/results/my_sofs new file mode 100644 index 0000000000..bfee0bce0d --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/my_sofs @@ -0,0 +1,3 @@ + +my_sofs.erl:34: The pattern {'Set', _, _} can never match the type #OrdSet{} +my_sofs.erl:54: The pattern {'Set', _, _} can never match the type #OrdSet{} diff --git a/lib/dialyzer/test/small_SUITE_data/results/no_match b/lib/dialyzer/test/small_SUITE_data/results/no_match new file mode 100644 index 0000000000..9760b980a2 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/no_match @@ -0,0 +1,4 @@ + +no_match.erl:5: Function t1/1 has no clauses that will ever match +no_match.erl:7: Function t2/1 has no clauses that will ever match +no_match.erl:9: Function t3/1 has no local return diff --git a/lib/dialyzer/test/small_SUITE_data/results/no_unused_fun b/lib/dialyzer/test/small_SUITE_data/results/no_unused_fun new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/no_unused_fun diff --git a/lib/dialyzer/test/small_SUITE_data/results/no_unused_fun2 b/lib/dialyzer/test/small_SUITE_data/results/no_unused_fun2 new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/no_unused_fun2 diff --git a/lib/dialyzer/test/small_SUITE_data/results/non_existing b/lib/dialyzer/test/small_SUITE_data/results/non_existing new file mode 100644 index 0000000000..58da2bfc8b --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/non_existing @@ -0,0 +1,2 @@ + +non_existing.erl:9: Call to missing or unexported function lists:non_existing_call/1 diff --git a/lib/dialyzer/test/small_SUITE_data/results/not_guard_crash b/lib/dialyzer/test/small_SUITE_data/results/not_guard_crash new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/not_guard_crash diff --git a/lib/dialyzer/test/small_SUITE_data/results/or_bug b/lib/dialyzer/test/small_SUITE_data/results/or_bug new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/or_bug diff --git a/lib/dialyzer/test/small_SUITE_data/results/orelsebug b/lib/dialyzer/test/small_SUITE_data/results/orelsebug new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/orelsebug diff --git a/lib/dialyzer/test/small_SUITE_data/results/orelsebug2 b/lib/dialyzer/test/small_SUITE_data/results/orelsebug2 new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/orelsebug2 diff --git a/lib/dialyzer/test/small_SUITE_data/results/overloaded1 b/lib/dialyzer/test/small_SUITE_data/results/overloaded1 new file mode 100644 index 0000000000..ab57ec03ff --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/overloaded1 @@ -0,0 +1,3 @@ + +overloaded1.erl:10: The pattern {'ok', 'gazonk'} can never match the type {'error',_} | {'ok',{atom(),atom(),byte()}} +overloaded1.erl:9: Function test1/0 has no local return diff --git a/lib/dialyzer/test/small_SUITE_data/results/port_info_test b/lib/dialyzer/test/small_SUITE_data/results/port_info_test new file mode 100644 index 0000000000..9ee863f9eb --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/port_info_test @@ -0,0 +1,6 @@ + +port_info_test.erl:10: The pattern {'connected', 42} can never match the type 'undefined' | {'connected',pid()} +port_info_test.erl:14: The pattern {'registered_name', "42"} can never match the type 'undefined' | {'registered_name',atom()} +port_info_test.erl:19: The pattern {'output', 42} can never match the type 'undefined' | {'connected',pid()} +port_info_test.erl:24: Guard test 'links' =:= Atom::'connected' can never succeed +port_info_test.erl:28: The pattern {'gazonk', _} can never match the type 'undefined' | {'connected' | 'id' | 'input' | 'links' | 'name' | 'output' | 'registered_name',atom() | pid() | [pid() | char()] | integer()} diff --git a/lib/dialyzer/test/small_SUITE_data/results/process_info_test b/lib/dialyzer/test/small_SUITE_data/results/process_info_test new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/process_info_test diff --git a/lib/dialyzer/test/small_SUITE_data/results/pubsub b/lib/dialyzer/test/small_SUITE_data/results/pubsub new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/pubsub diff --git a/lib/dialyzer/test/small_SUITE_data/results/receive1 b/lib/dialyzer/test/small_SUITE_data/results/receive1 new file mode 100644 index 0000000000..abf6eec0ca --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/receive1 @@ -0,0 +1,2 @@ + +receive1.erl:12: Function t/1 has no local return diff --git a/lib/dialyzer/test/small_SUITE_data/results/record_construct b/lib/dialyzer/test/small_SUITE_data/results/record_construct new file mode 100644 index 0000000000..c0110b144f --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/record_construct @@ -0,0 +1,7 @@ + +record_construct.erl:15: Function t_opa/0 has no local return +record_construct.erl:16: Record construction #r_opa{b::gb_set(),c::42,e::'false'} violates the declared type of field c::boolean() +record_construct.erl:20: Function t_rem/0 has no local return +record_construct.erl:21: Record construction #r_rem{a::'gazonk'} violates the declared type of field a::string() +record_construct.erl:6: Function t_loc/0 has no local return +record_construct.erl:7: Record construction #r_loc{a::'gazonk',b::42} violates the declared type of field a::integer() and b::atom() diff --git a/lib/dialyzer/test/small_SUITE_data/results/record_pat b/lib/dialyzer/test/small_SUITE_data/results/record_pat new file mode 100644 index 0000000000..9a3f925e42 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/record_pat @@ -0,0 +1,2 @@ + +record_pat.erl:14: The pattern {'foo', 'baz'} violates the declared type for #foo{} diff --git a/lib/dialyzer/test/small_SUITE_data/results/record_send_test b/lib/dialyzer/test/small_SUITE_data/results/record_send_test new file mode 100644 index 0000000000..6a08d44179 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/record_send_test @@ -0,0 +1,2 @@ + +record_send_test.erl:30: The call erlang:'!'(Rec1::#rec1{a::'a',b::'b',c::'c'},'hello_again') will never return since it differs in the 1st argument from the success typing arguments: (atom() | pid() | port() | {atom(),atom()},any()) diff --git a/lib/dialyzer/test/small_SUITE_data/results/record_test b/lib/dialyzer/test/small_SUITE_data/results/record_test new file mode 100644 index 0000000000..9715f0dcfb --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/record_test @@ -0,0 +1,3 @@ + +record_test.erl:19: The pattern {'foo', _} can never match the type 'foo' +record_test.erl:21: The variable _ can never match since previous clauses completely covered the type 'foo' diff --git a/lib/dialyzer/test/small_SUITE_data/results/recursive_types1 b/lib/dialyzer/test/small_SUITE_data/results/recursive_types1 new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/recursive_types1 diff --git a/lib/dialyzer/test/small_SUITE_data/results/recursive_types2 b/lib/dialyzer/test/small_SUITE_data/results/recursive_types2 new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/recursive_types2 diff --git a/lib/dialyzer/test/small_SUITE_data/results/recursive_types3 b/lib/dialyzer/test/small_SUITE_data/results/recursive_types3 new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/recursive_types3 diff --git a/lib/dialyzer/test/small_SUITE_data/results/recursive_types4 b/lib/dialyzer/test/small_SUITE_data/results/recursive_types4 new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/recursive_types4 diff --git a/lib/dialyzer/test/small_SUITE_data/results/recursive_types5 b/lib/dialyzer/test/small_SUITE_data/results/recursive_types5 new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/recursive_types5 diff --git a/lib/dialyzer/test/small_SUITE_data/results/recursive_types6 b/lib/dialyzer/test/small_SUITE_data/results/recursive_types6 new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/recursive_types6 diff --git a/lib/dialyzer/test/small_SUITE_data/results/recursive_types7 b/lib/dialyzer/test/small_SUITE_data/results/recursive_types7 new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/recursive_types7 diff --git a/lib/dialyzer/test/small_SUITE_data/results/toth b/lib/dialyzer/test/small_SUITE_data/results/toth new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/toth diff --git a/lib/dialyzer/test/small_SUITE_data/results/trec b/lib/dialyzer/test/small_SUITE_data/results/trec new file mode 100644 index 0000000000..01ccc63761 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/trec @@ -0,0 +1,7 @@ + +trec.erl:26: Function test/0 has no local return +trec.erl:27: The call trec:mk_foo_loc(42,any()) will never return since it differs in the 1st argument from the success typing arguments: ('undefined',atom()) +trec.erl:29: Function mk_foo_loc/2 has no local return +trec.erl:30: Record construction violates the declared type for #foo{} since variable A cannot be of type atom() +trec.erl:36: Function mk_foo_exp/2 has no local return +trec.erl:37: Record construction violates the declared type for #foo{} since variable A cannot be of type atom() diff --git a/lib/dialyzer/test/small_SUITE_data/results/try1 b/lib/dialyzer/test/small_SUITE_data/results/try1 new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/try1 diff --git a/lib/dialyzer/test/small_SUITE_data/results/tuple1 b/lib/dialyzer/test/small_SUITE_data/results/tuple1 new file mode 100644 index 0000000000..1b5ed49b56 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/tuple1 @@ -0,0 +1,5 @@ + +tuple1.erl:13: Function t1/2 has no local return +tuple1.erl:14: The call lists:mapfoldl(fun((_,_) -> 'a' | 'b'),X::any(),List::nonempty_maybe_improper_list()) will never return since the success typing arguments are (fun((_,_) -> {_,_}),any(),[any()]) +tuple1.erl:19: Function t3/2 has no local return +tuple1.erl:20: The call lists:mapfoldl(fun((_) -> 1),X::any(),List::nonempty_maybe_improper_list()) will never return since it differs in the 1st argument from the success typing arguments: (fun((_,_) -> {_,_}),any(),[any()]) diff --git a/lib/dialyzer/test/small_SUITE_data/results/unsafe_beamcode_bug b/lib/dialyzer/test/small_SUITE_data/results/unsafe_beamcode_bug new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/unsafe_beamcode_bug diff --git a/lib/dialyzer/test/small_SUITE_data/results/unused_cases b/lib/dialyzer/test/small_SUITE_data/results/unused_cases new file mode 100644 index 0000000000..cafe1c042b --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/unused_cases @@ -0,0 +1,4 @@ + +unused_cases.erl:21: The variable OTHER can never match since previous clauses completely covered the type {42,42} +unused_cases.erl:27: The pattern 'weird' can never match the type 'false' +unused_cases.erl:35: The variable OTHER can never match since previous clauses completely covered the type boolean() diff --git a/lib/dialyzer/test/small_SUITE_data/results/unused_clauses b/lib/dialyzer/test/small_SUITE_data/results/unused_clauses new file mode 100644 index 0000000000..4603e888c1 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/unused_clauses @@ -0,0 +1,3 @@ + +unused_clauses.erl:16: Guard test is_integer(X::{42}) can never succeed +unused_clauses.erl:18: The variable X can never match since previous clauses completely covered the type 'atom' | {42} diff --git a/lib/dialyzer/test/small_SUITE_data/results/zero_tuple b/lib/dialyzer/test/small_SUITE_data/results/zero_tuple new file mode 100644 index 0000000000..bf5ec5cd6e --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/zero_tuple @@ -0,0 +1,5 @@ + +zero_tuple.erl:4: Function t1/0 has no local return +zero_tuple.erl:5: The pattern {} can never match the type 'a' +zero_tuple.erl:8: Function t2/0 has no local return +zero_tuple.erl:9: The pattern 'b' can never match the type 'a' diff --git a/lib/dialyzer/test/small_SUITE_data/src/app_call.erl b/lib/dialyzer/test/small_SUITE_data/src/app_call.erl new file mode 100644 index 0000000000..54d178d29a --- /dev/null +++ b/lib/dialyzer/test/small_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_SUITE_data/src/appmon_place.erl b/lib/dialyzer/test/small_SUITE_data/src/appmon_place.erl new file mode 100644 index 0000000000..60ffbe818f --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/appmon_place.erl @@ -0,0 +1,70 @@ +%%--------------------------------------------------------------------- +%% 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_SUITE_data/src/areq.erl b/lib/dialyzer/test/small_SUITE_data/src/areq.erl new file mode 100644 index 0000000000..66bb30491c --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/areq.erl @@ -0,0 +1,11 @@ +-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_SUITE_data/src/atom_call.erl b/lib/dialyzer/test/small_SUITE_data/src/atom_call.erl new file mode 100644 index 0000000000..2b70503144 --- /dev/null +++ b/lib/dialyzer/test/small_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_SUITE_data/src/atom_guard.erl b/lib/dialyzer/test/small_SUITE_data/src/atom_guard.erl new file mode 100644 index 0000000000..95581b339a --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/atom_guard.erl @@ -0,0 +1,8 @@ +-module(atom_guard). +-export([test/0]). + +test() -> + foo(42). + +foo(X) when is_atom(x) -> + X. diff --git a/lib/dialyzer/test/small_SUITE_data/src/atom_widen.erl b/lib/dialyzer/test/small_SUITE_data/src/atom_widen.erl new file mode 100644 index 0000000000..81bfac9d56 --- /dev/null +++ b/lib/dialyzer/test/small_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_SUITE_data/src/bs_fail_constr.erl b/lib/dialyzer/test/small_SUITE_data/src/bs_fail_constr.erl new file mode 100644 index 0000000000..8c1f8c009a --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/bs_fail_constr.erl @@ -0,0 +1,15 @@ +-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_SUITE_data/src/bs_utf8.erl b/lib/dialyzer/test/small_SUITE_data/src/bs_utf8.erl new file mode 100644 index 0000000000..5fe28f1da1 --- /dev/null +++ b/lib/dialyzer/test/small_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_SUITE_data/src/cerl_hipeify.erl b/lib/dialyzer/test/small_SUITE_data/src/cerl_hipeify.erl new file mode 100644 index 0000000000..b7883e7b49 --- /dev/null +++ b/lib/dialyzer/test/small_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_SUITE_data/src/comm_layer/comm_acceptor.erl b/lib/dialyzer/test/small_SUITE_data/src/comm_layer/comm_acceptor.erl new file mode 100644 index 0000000000..2ca1468911 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/comm_layer/comm_acceptor.erl @@ -0,0 +1,119 @@ +% 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_SUITE_data/src/comm_layer/comm_connection.erl b/lib/dialyzer/test/small_SUITE_data/src/comm_layer/comm_connection.erl new file mode 100644 index 0000000000..48cc50ae21 --- /dev/null +++ b/lib/dialyzer/test/small_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_SUITE_data/src/comm_layer/comm_layer.erl b/lib/dialyzer/test/small_SUITE_data/src/comm_layer/comm_layer.erl new file mode 100644 index 0000000000..b7fdd183e1 --- /dev/null +++ b/lib/dialyzer/test/small_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_SUITE_data/src/comm_layer/comm_layer.hrl b/lib/dialyzer/test/small_SUITE_data/src/comm_layer/comm_layer.hrl new file mode 100644 index 0000000000..54f31b7c55 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/comm_layer/comm_layer.hrl @@ -0,0 +1,29 @@ +% 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_SUITE_data/src/comm_layer/comm_logger.erl b/lib/dialyzer/test/small_SUITE_data/src/comm_layer/comm_logger.erl new file mode 100644 index 0000000000..b8882758af --- /dev/null +++ b/lib/dialyzer/test/small_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_SUITE_data/src/comm_layer/comm_port.erl b/lib/dialyzer/test/small_SUITE_data/src/comm_layer/comm_port.erl new file mode 100644 index 0000000000..e8169b4673 --- /dev/null +++ b/lib/dialyzer/test/small_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_SUITE_data/src/comm_layer/comm_port_sup.erl b/lib/dialyzer/test/small_SUITE_data/src/comm_layer/comm_port_sup.erl new file mode 100644 index 0000000000..d7a25b14ab --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/comm_layer/comm_port_sup.erl @@ -0,0 +1,88 @@ +% 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_SUITE_data/src/compare1.erl b/lib/dialyzer/test/small_SUITE_data/src/compare1.erl new file mode 100644 index 0000000000..915ae7621c --- /dev/null +++ b/lib/dialyzer/test/small_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_SUITE_data/src/confusing_warning.erl b/lib/dialyzer/test/small_SUITE_data/src/confusing_warning.erl new file mode 100644 index 0000000000..c82df0f056 --- /dev/null +++ b/lib/dialyzer/test/small_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_SUITE_data/src/contract2.erl b/lib/dialyzer/test/small_SUITE_data/src/contract2.erl new file mode 100644 index 0000000000..211de7f009 --- /dev/null +++ b/lib/dialyzer/test/small_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_SUITE_data/src/contract3.erl b/lib/dialyzer/test/small_SUITE_data/src/contract3.erl new file mode 100644 index 0000000000..5b0bee9694 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/contract3.erl @@ -0,0 +1,33 @@ +%%%------------------------------------------------------------------- +%%% 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_SUITE_data/src/contract5.erl b/lib/dialyzer/test/small_SUITE_data/src/contract5.erl new file mode 100644 index 0000000000..c4c9ac9ebf --- /dev/null +++ b/lib/dialyzer/test/small_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_SUITE_data/src/disj_norm_form.erl b/lib/dialyzer/test/small_SUITE_data/src/disj_norm_form.erl new file mode 100644 index 0000000000..fedac566ea --- /dev/null +++ b/lib/dialyzer/test/small_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_SUITE_data/src/eqeq.erl b/lib/dialyzer/test/small_SUITE_data/src/eqeq.erl new file mode 100644 index 0000000000..f8989185d4 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/eqeq.erl @@ -0,0 +1,15 @@ +%%%------------------------------------------------------------------- +%%% 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_SUITE_data/src/ets_select.erl b/lib/dialyzer/test/small_SUITE_data/src/ets_select.erl new file mode 100644 index 0000000000..17bfb5c8bc --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/ets_select.erl @@ -0,0 +1,11 @@ +-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_SUITE_data/src/exhaust_case.erl b/lib/dialyzer/test/small_SUITE_data/src/exhaust_case.erl new file mode 100644 index 0000000000..4b2c16f8a2 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/exhaust_case.erl @@ -0,0 +1,23 @@ +%%------------------------------------------------------------------- +%% 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_SUITE_data/src/failing_guard1.erl b/lib/dialyzer/test/small_SUITE_data/src/failing_guard1.erl new file mode 100644 index 0000000000..9e39975105 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/failing_guard1.erl @@ -0,0 +1,15 @@ +%%----------------------------------------------------------------------- +%% 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_SUITE_data/src/flatten.erl b/lib/dialyzer/test/small_SUITE_data/src/flatten.erl new file mode 100644 index 0000000000..e424d5404c --- /dev/null +++ b/lib/dialyzer/test/small_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_SUITE_data/src/fun_app.erl b/lib/dialyzer/test/small_SUITE_data/src/fun_app.erl new file mode 100644 index 0000000000..20b6138d26 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/fun_app.erl @@ -0,0 +1,41 @@ +%% 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_SUITE_data/src/fun_ref_match.erl b/lib/dialyzer/test/small_SUITE_data/src/fun_ref_match.erl new file mode 100644 index 0000000000..31e6bdfb47 --- /dev/null +++ b/lib/dialyzer/test/small_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_SUITE_data/src/fun_ref_record.erl b/lib/dialyzer/test/small_SUITE_data/src/fun_ref_record.erl new file mode 100644 index 0000000000..eace7a4332 --- /dev/null +++ b/lib/dialyzer/test/small_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_SUITE_data/src/gencall.erl b/lib/dialyzer/test/small_SUITE_data/src/gencall.erl new file mode 100644 index 0000000000..d2875c9df1 --- /dev/null +++ b/lib/dialyzer/test/small_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_SUITE_data/src/gs_make.erl b/lib/dialyzer/test/small_SUITE_data/src/gs_make.erl new file mode 100644 index 0000000000..2842e773c4 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/gs_make.erl @@ -0,0 +1,260 @@ +%% ``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_SUITE_data/src/inf_loop2.erl b/lib/dialyzer/test/small_SUITE_data/src/inf_loop2.erl new file mode 100644 index 0000000000..6ac29116a5 --- /dev/null +++ b/lib/dialyzer/test/small_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_SUITE_data/src/invalid_specs/invalid_spec1.erl b/lib/dialyzer/test/small_SUITE_data/src/invalid_specs/invalid_spec1.erl new file mode 100644 index 0000000000..06ab2f9a22 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/invalid_specs/invalid_spec1.erl @@ -0,0 +1,28 @@ +-module(invalid_spec1). + +-export([get_plan_dirty/1]). + +-spec get_plan_dirty([string()]) -> {{atom(), any()}, [atom()]}. + +get_plan_dirty(ClassL) -> + get_plan_dirty(ClassL, [], []). + +get_plan_dirty([], Res, FoundClassList) -> + {Res,FoundClassList}; +get_plan_dirty([Class|ClassL], Res, FoundClassList) -> + ClassPlan = list_to_atom(Class ++ "_plan"), + case catch mnesia:dirty_all_keys(ClassPlan) of + {'EXIT',_} -> + get_plan_dirty(ClassL, Res, FoundClassList); + [] -> + get_plan_dirty(ClassL, Res, FoundClassList); + KeyL -> + ClassAtom = list_to_atom(Class), + Res2 = + lists:foldl(fun(Key, Acc) -> + [{ClassAtom,Key}|Acc] + end, + Res, + KeyL), + get_plan_dirty(ClassL, Res2, [ClassAtom|FoundClassList]) + end. diff --git a/lib/dialyzer/test/small_SUITE_data/src/invalid_specs/invalid_spec2.erl b/lib/dialyzer/test/small_SUITE_data/src/invalid_specs/invalid_spec2.erl new file mode 100644 index 0000000000..e49f73d014 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/invalid_specs/invalid_spec2.erl @@ -0,0 +1,11 @@ +-module(invalid_spec2). + +-export([foo/0]). + +foo() -> + case + invalid_spec1:get_plan_dirty(mnesia:dirty_all_keys(cmClassInfo)) + of + {[],[]} -> foo; + { _, _} -> bar + end. diff --git a/lib/dialyzer/test/small_SUITE_data/src/letrec1.erl b/lib/dialyzer/test/small_SUITE_data/src/letrec1.erl new file mode 100644 index 0000000000..eeea671bcc --- /dev/null +++ b/lib/dialyzer/test/small_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_SUITE_data/src/list_match.erl b/lib/dialyzer/test/small_SUITE_data/src/list_match.erl new file mode 100644 index 0000000000..38ef6ef976 --- /dev/null +++ b/lib/dialyzer/test/small_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_SUITE_data/src/lzip.erl b/lib/dialyzer/test/small_SUITE_data/src/lzip.erl new file mode 100644 index 0000000000..753d2939d8 --- /dev/null +++ b/lib/dialyzer/test/small_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_SUITE_data/src/make_tuple.erl b/lib/dialyzer/test/small_SUITE_data/src/make_tuple.erl new file mode 100644 index 0000000000..0a5edf8c24 --- /dev/null +++ b/lib/dialyzer/test/small_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_SUITE_data/src/minus_minus.erl b/lib/dialyzer/test/small_SUITE_data/src/minus_minus.erl new file mode 100644 index 0000000000..f1e9483c40 --- /dev/null +++ b/lib/dialyzer/test/small_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_SUITE_data/src/mod_info.erl b/lib/dialyzer/test/small_SUITE_data/src/mod_info.erl new file mode 100644 index 0000000000..a24e4276ad --- /dev/null +++ b/lib/dialyzer/test/small_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_SUITE_data/src/my_filter.erl b/lib/dialyzer/test/small_SUITE_data/src/my_filter.erl new file mode 100644 index 0000000000..ecb2827eb4 --- /dev/null +++ b/lib/dialyzer/test/small_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_SUITE_data/src/my_sofs.erl b/lib/dialyzer/test/small_SUITE_data/src/my_sofs.erl new file mode 100644 index 0000000000..e3ae99ebbc --- /dev/null +++ b/lib/dialyzer/test/small_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_SUITE_data/src/no_match.erl b/lib/dialyzer/test/small_SUITE_data/src/no_match.erl new file mode 100644 index 0000000000..e3e7a4b2d1 --- /dev/null +++ b/lib/dialyzer/test/small_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_SUITE_data/src/no_unused_fun.erl b/lib/dialyzer/test/small_SUITE_data/src/no_unused_fun.erl new file mode 100644 index 0000000000..0bd8ba402c --- /dev/null +++ b/lib/dialyzer/test/small_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_SUITE_data/src/no_unused_fun2.erl b/lib/dialyzer/test/small_SUITE_data/src/no_unused_fun2.erl new file mode 100644 index 0000000000..e287c4de5f --- /dev/null +++ b/lib/dialyzer/test/small_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_SUITE_data/src/non_existing.erl b/lib/dialyzer/test/small_SUITE_data/src/non_existing.erl new file mode 100644 index 0000000000..5701b8a745 --- /dev/null +++ b/lib/dialyzer/test/small_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_SUITE_data/src/not_guard_crash.erl b/lib/dialyzer/test/small_SUITE_data/src/not_guard_crash.erl new file mode 100644 index 0000000000..75bcffc2bc --- /dev/null +++ b/lib/dialyzer/test/small_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_SUITE_data/src/or_bug.erl b/lib/dialyzer/test/small_SUITE_data/src/or_bug.erl new file mode 100644 index 0000000000..fb8f6558b8 --- /dev/null +++ b/lib/dialyzer/test/small_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_SUITE_data/src/orelsebug.erl b/lib/dialyzer/test/small_SUITE_data/src/orelsebug.erl new file mode 100644 index 0000000000..8479fc33cc --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/orelsebug.erl @@ -0,0 +1,16 @@ +%%%------------------------------------------------------------------- +%%% 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_SUITE_data/src/orelsebug2.erl b/lib/dialyzer/test/small_SUITE_data/src/orelsebug2.erl new file mode 100644 index 0000000000..60e0c47384 --- /dev/null +++ b/lib/dialyzer/test/small_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_SUITE_data/src/overloaded1.erl b/lib/dialyzer/test/small_SUITE_data/src/overloaded1.erl new file mode 100644 index 0000000000..0af4f7446f --- /dev/null +++ b/lib/dialyzer/test/small_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_SUITE_data/src/port_info_test.erl b/lib/dialyzer/test/small_SUITE_data/src/port_info_test.erl new file mode 100644 index 0000000000..2ee9a3a6e2 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/port_info_test.erl @@ -0,0 +1,33 @@ +%% +%% 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_SUITE_data/src/process_info_test.erl b/lib/dialyzer/test/small_SUITE_data/src/process_info_test.erl new file mode 100644 index 0000000000..2c24ae597f --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/process_info_test.erl @@ -0,0 +1,20 @@ +%% +%% 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_SUITE_data/src/pubsub/pubsub_api.erl b/lib/dialyzer/test/small_SUITE_data/src/pubsub/pubsub_api.erl new file mode 100644 index 0000000000..85ea292077 --- /dev/null +++ b/lib/dialyzer/test/small_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_SUITE_data/src/pubsub/pubsub_publish.erl b/lib/dialyzer/test/small_SUITE_data/src/pubsub/pubsub_publish.erl new file mode 100644 index 0000000000..601dbad74b --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/pubsub/pubsub_publish.erl @@ -0,0 +1,49 @@ +% 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_SUITE_data/src/receive1.erl b/lib/dialyzer/test/small_SUITE_data/src/receive1.erl new file mode 100644 index 0000000000..96fdf54e4d --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/receive1.erl @@ -0,0 +1,16 @@ +%%%------------------------------------------------------------------- +%%% 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_SUITE_data/src/record_construct.erl b/lib/dialyzer/test/small_SUITE_data/src/record_construct.erl new file mode 100644 index 0000000000..54cc2601bd --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/record_construct.erl @@ -0,0 +1,21 @@ +-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_SUITE_data/src/record_pat.erl b/lib/dialyzer/test/small_SUITE_data/src/record_pat.erl new file mode 100644 index 0000000000..3308641571 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/record_pat.erl @@ -0,0 +1,15 @@ +%%%------------------------------------------------------------------- +%%% 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_SUITE_data/src/record_send_test.erl b/lib/dialyzer/test/small_SUITE_data/src/record_send_test.erl new file mode 100644 index 0000000000..87cd97bd85 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/record_send_test.erl @@ -0,0 +1,32 @@ +%%------------------------------------------------------------------- +%% 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_SUITE_data/src/record_test.erl b/lib/dialyzer/test/small_SUITE_data/src/record_test.erl new file mode 100644 index 0000000000..48a00b172e --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/record_test.erl @@ -0,0 +1,22 @@ +%%%------------------------------------------------------------------- +%%% 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_SUITE_data/src/recursive_types1.erl b/lib/dialyzer/test/small_SUITE_data/src/recursive_types1.erl new file mode 100644 index 0000000000..657d11653b --- /dev/null +++ b/lib/dialyzer/test/small_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_SUITE_data/src/recursive_types2.erl b/lib/dialyzer/test/small_SUITE_data/src/recursive_types2.erl new file mode 100644 index 0000000000..3a22bbf5d2 --- /dev/null +++ b/lib/dialyzer/test/small_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_SUITE_data/src/recursive_types3.erl b/lib/dialyzer/test/small_SUITE_data/src/recursive_types3.erl new file mode 100644 index 0000000000..997678ac92 --- /dev/null +++ b/lib/dialyzer/test/small_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_SUITE_data/src/recursive_types4.erl b/lib/dialyzer/test/small_SUITE_data/src/recursive_types4.erl new file mode 100644 index 0000000000..f6b5f87e04 --- /dev/null +++ b/lib/dialyzer/test/small_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_SUITE_data/src/recursive_types5.erl b/lib/dialyzer/test/small_SUITE_data/src/recursive_types5.erl new file mode 100644 index 0000000000..cd1cd5ede9 --- /dev/null +++ b/lib/dialyzer/test/small_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_SUITE_data/src/recursive_types6.erl b/lib/dialyzer/test/small_SUITE_data/src/recursive_types6.erl new file mode 100644 index 0000000000..ff61976736 --- /dev/null +++ b/lib/dialyzer/test/small_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_SUITE_data/src/recursive_types7.erl b/lib/dialyzer/test/small_SUITE_data/src/recursive_types7.erl new file mode 100644 index 0000000000..92106e9694 --- /dev/null +++ b/lib/dialyzer/test/small_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_SUITE_data/src/refine_bug1.erl b/lib/dialyzer/test/small_SUITE_data/src/refine_bug1.erl new file mode 100644 index 0000000000..1b299e782a --- /dev/null +++ b/lib/dialyzer/test/small_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_SUITE_data/src/toth.erl b/lib/dialyzer/test/small_SUITE_data/src/toth.erl new file mode 100644 index 0000000000..bae22be4f1 --- /dev/null +++ b/lib/dialyzer/test/small_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_SUITE_data/src/trec.erl b/lib/dialyzer/test/small_SUITE_data/src/trec.erl new file mode 100644 index 0000000000..ba50c3b401 --- /dev/null +++ b/lib/dialyzer/test/small_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_SUITE_data/src/try1.erl b/lib/dialyzer/test/small_SUITE_data/src/try1.erl new file mode 100644 index 0000000000..05963a16af --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/try1.erl @@ -0,0 +1,26 @@ +%%%------------------------------------------------------------------- +%%% 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_SUITE_data/src/tuple1.erl b/lib/dialyzer/test/small_SUITE_data/src/tuple1.erl new file mode 100644 index 0000000000..d608275efe --- /dev/null +++ b/lib/dialyzer/test/small_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_SUITE_data/src/unsafe_beamcode_bug.erl b/lib/dialyzer/test/small_SUITE_data/src/unsafe_beamcode_bug.erl new file mode 100644 index 0000000000..071b4a53c1 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/unsafe_beamcode_bug.erl @@ -0,0 +1,14 @@ +-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_SUITE_data/src/unused_cases.erl b/lib/dialyzer/test/small_SUITE_data/src/unused_cases.erl new file mode 100644 index 0000000000..e6e6693963 --- /dev/null +++ b/lib/dialyzer/test/small_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_SUITE_data/src/unused_clauses.erl b/lib/dialyzer/test/small_SUITE_data/src/unused_clauses.erl new file mode 100644 index 0000000000..a98b227a6b --- /dev/null +++ b/lib/dialyzer/test/small_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_SUITE_data/src/zero_tuple.erl b/lib/dialyzer/test/small_SUITE_data/src/zero_tuple.erl new file mode 100644 index 0000000000..7c790e5658 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/zero_tuple.erl @@ -0,0 +1,12 @@ +-module(zero_tuple). +-export([t1/0, t2/0]). + +t1() -> + {} = a(), + ok. + +t2() -> + b = a(), + ok. + +a() -> a. |