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/opaque_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/opaque_SUITE_data')
60 files changed, 2832 insertions, 0 deletions
diff --git a/lib/dialyzer/test/opaque_SUITE_data/dialyzer_options b/lib/dialyzer/test/opaque_SUITE_data/dialyzer_options new file mode 100644 index 0000000000..3ff26b87db --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/dialyzer_options @@ -0,0 +1 @@ +{dialyzer_options, [{warnings, [no_unused, no_return]}]}. diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/array b/lib/dialyzer/test/opaque_SUITE_data/results/array new file mode 100644 index 0000000000..b05d088a03 --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/results/array @@ -0,0 +1,3 @@ + +array_use.erl:12: The type test is_tuple(array()) breaks the opaqueness of the term array() +array_use.erl:9: The attempt to match a term of type array() against the pattern {'array', _, _, 'undefined', _} breaks the opaqueness of the term diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/crash b/lib/dialyzer/test/opaque_SUITE_data/results/crash new file mode 100644 index 0000000000..6bdd934169 --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/results/crash @@ -0,0 +1,7 @@ + +crash_1.erl:42: The specification for crash_1:empty/0 states that the function might also return crash_1:targetlist() but the inferred return is none() +crash_1.erl:45: Record construction #targetlist{list::[]} violates the declared type of field list::'undefined' | crash_1:target() +crash_1.erl:48: The call crash_1:get_using_branch2(Branch::maybe_improper_list(),L::'undefined' | crash_1:target()) contains an opaque term as 2nd argument when terms of different types are expected in these positions +crash_1.erl:50: The pattern <_Branch, []> can never match the type <maybe_improper_list(),'undefined' | crash_1:target()> +crash_1.erl:52: The pattern <Branch, [H = {'target', _, _} | _T]> can never match the type <maybe_improper_list(),'undefined' | crash_1:target()> +crash_1.erl:54: The pattern <Branch, [{'target', _, _} | T]> can never match the type <maybe_improper_list(),'undefined' | crash_1:target()> diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/dict b/lib/dialyzer/test/opaque_SUITE_data/results/dict new file mode 100644 index 0000000000..5c6bf6a927 --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/results/dict @@ -0,0 +1,15 @@ + +dict_use.erl:41: The attempt to match a term of type dict() against the pattern 'gazonk' breaks the opaqueness of the term +dict_use.erl:45: The attempt to match a term of type dict() against the pattern [] breaks the opaqueness of the term +dict_use.erl:46: The attempt to match a term of type dict() against the pattern 42 breaks the opaqueness of the term +dict_use.erl:51: The attempt to match a term of type dict() against the pattern [] breaks the opaqueness of the term +dict_use.erl:52: The attempt to match a term of type dict() against the pattern 42 breaks the opaqueness of the term +dict_use.erl:58: Attempt to test for equality between a term of type maybe_improper_list() and a term of opaque type dict() +dict_use.erl:60: Attempt to test for inequality between a term of type atom() and a term of opaque type dict() +dict_use.erl:64: Guard test length(D::dict()) breaks the opaqueness of its argument +dict_use.erl:65: Guard test is_atom(D::dict()) breaks the opaqueness of its argument +dict_use.erl:66: Guard test is_list(D::dict()) breaks the opaqueness of its argument +dict_use.erl:70: The type test is_list(dict()) breaks the opaqueness of the term dict() +dict_use.erl:73: The call dict:fetch('foo',[1 | 2 | 3,...]) does not have an opaque term of type dict() as 2nd argument +dict_use.erl:76: The call dict:merge(Fun::any(),42,[1 | 2,...]) does not have opaque terms as 2nd and 3rd arguments +dict_use.erl:79: The call dict:store(42,'elli',{'dict',0,16,16,8,80,48,{[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[]},{{[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[]}}}) does not have an opaque term of type dict() as 3rd argument diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/ets b/lib/dialyzer/test/opaque_SUITE_data/results/ets new file mode 100644 index 0000000000..5498ba1538 --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/results/ets @@ -0,0 +1,3 @@ + +ets_use.erl:12: Guard test is_integer(T::atom() | tid()) breaks the opaqueness of its argument +ets_use.erl:7: Guard test is_integer(T::tid()) breaks the opaqueness of its argument diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/gb_sets b/lib/dialyzer/test/opaque_SUITE_data/results/gb_sets new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/results/gb_sets diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/inf_loop1 b/lib/dialyzer/test/opaque_SUITE_data/results/inf_loop1 new file mode 100644 index 0000000000..eb8f304905 --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/results/inf_loop1 @@ -0,0 +1,5 @@ + +inf_loop1.erl:119: The pattern [{_, LNorms}] can never match the type [] +inf_loop1.erl:121: The pattern [{LinksA, LNormA}, {LinksB, LNormB}] can never match the type [] +inf_loop1.erl:129: The pattern [{_, Norm} | _] can never match the type [] +inf_loop1.erl:71: The call gb_trees:get(Edge::any(),Etab::array()) contains an opaque term as 2nd argument when terms of different types are expected in these positions diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/int b/lib/dialyzer/test/opaque_SUITE_data/results/int new file mode 100644 index 0000000000..3ee4def34b --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/results/int @@ -0,0 +1,3 @@ + +int_adt.erl:28: Invalid type specification for function int_adt:add_f/2. The success typing is (number(),float()) -> number() +int_adt.erl:32: Invalid type specification for function int_adt:div_f/2. The success typing is (number(),number()) -> float() diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/mixed_opaque b/lib/dialyzer/test/opaque_SUITE_data/results/mixed_opaque new file mode 100644 index 0000000000..ab850b613e --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/results/mixed_opaque @@ -0,0 +1,2 @@ + +mixed_opaque_use.erl:31: The call mixed_opaque_rec_adt:get_a(Q::mixed_opaque_queue_adt:my_queue()) contains an opaque term as 1st argument when an opaque term of type mixed_opaque_rec_adt:rec() is expected diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/my_digraph b/lib/dialyzer/test/opaque_SUITE_data/results/my_digraph new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/results/my_digraph diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/my_queue b/lib/dialyzer/test/opaque_SUITE_data/results/my_queue new file mode 100644 index 0000000000..2860b91084 --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/results/my_queue @@ -0,0 +1,7 @@ + +my_queue_use.erl:15: The call my_queue_adt:is_empty([]) does not have an opaque term of type my_queue_adt:my_queue() as 1st argument +my_queue_use.erl:19: The call my_queue_adt:add(42,Q0::[]) does not have an opaque term of type my_queue_adt:my_queue() as 2nd argument +my_queue_use.erl:24: The attempt to match a term of type my_queue_adt:my_queue() against the pattern [42 | Q2] breaks the opaqueness of the term +my_queue_use.erl:30: Attempt to test for equality between a term of type [] and a term of opaque type my_queue_adt:my_queue() +my_queue_use.erl:34: Cons will produce an improper list since its 2nd argument is my_queue_adt:my_queue() +my_queue_use.erl:34: The call my_queue_adt:dequeue(nonempty_improper_list(42,my_queue_adt:my_queue())) does not have an opaque term of type my_queue_adt:my_queue() as 1st argument diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/opaque b/lib/dialyzer/test/opaque_SUITE_data/results/opaque new file mode 100644 index 0000000000..ca76f57b54 --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/results/opaque @@ -0,0 +1,2 @@ + +opaque_bug4.erl:20: The attempt to match a term of type opaque_adt:abc() against the pattern 'a' breaks the opaqueness of the term diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/queue b/lib/dialyzer/test/opaque_SUITE_data/results/queue new file mode 100644 index 0000000000..59ce33f098 --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/results/queue @@ -0,0 +1,11 @@ + +queue_use.erl:18: The call queue:is_empty({[],[]}) does not have an opaque term of type queue() as 1st argument +queue_use.erl:22: The call queue:in(42,Q0::{[],[]}) does not have an opaque term of type queue() as 2nd argument +queue_use.erl:27: The attempt to match a term of type queue() against the pattern {"*", Q2} breaks the opaqueness of the term +queue_use.erl:33: Attempt to test for equality between a term of type {[42,...],[]} and a term of opaque type queue() +queue_use.erl:36: The attempt to match a term of type queue() against the pattern {F, _R} breaks the opaqueness of the term +queue_use.erl:40: The call queue:out({[42,...],[]}) does not have an opaque term of type queue() as 1st argument +queue_use.erl:51: The call queue_use:is_in_queue(E::42,DB::#db{p::[],q::queue()}) contains an opaque term as 2nd argument when terms of different types are expected in these positions +queue_use.erl:56: The attempt to match a term of type #db{p::[],q::queue()} against the pattern {'db', _, {L1, L2}} breaks the opaqueness of queue() +queue_use.erl:62: The call queue_use:tuple_queue({42,'gazonk'}) does not have a term of type {_,queue()} (with opaque subterms) as 1st argument +queue_use.erl:65: The call queue:in(F::42,Q::'gazonk') does not have an opaque term of type queue() as 2nd argument diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/rec b/lib/dialyzer/test/opaque_SUITE_data/results/rec new file mode 100644 index 0000000000..72736b3b3c --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/results/rec @@ -0,0 +1,6 @@ + +rec_use.erl:17: The attempt to match a term of type rec_adt:rec() against the pattern {'rec', _, 42} breaks the opaqueness of the term +rec_use.erl:18: Guard test tuple_size(R::rec_adt:rec()) breaks the opaqueness of its argument +rec_use.erl:23: The call rec_adt:get_a(R::tuple()) does not have an opaque term of type rec_adt:rec() as 1st argument +rec_use.erl:27: Attempt to test for equality between a term of type {'rec','gazonk',42} and a term of opaque type rec_adt:rec() +rec_use.erl:30: The call erlang:tuple_size(rec_adt:rec()) contains an opaque term as 1st argument when a structured term of type tuple() is expected diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/timer b/lib/dialyzer/test/opaque_SUITE_data/results/timer new file mode 100644 index 0000000000..e917b76b08 --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/results/timer @@ -0,0 +1,4 @@ + +timer_use.erl:16: The pattern 'gazonk' can never match the type {'error',_} | {'ok',timer:tref()} +timer_use.erl:17: The attempt to match a term of type {'ok',timer:tref()} against the pattern {'ok', 42} breaks the opaqueness of timer:tref() +timer_use.erl:18: The attempt to match a term of type {'error',_} | {'ok',timer:tref()} against the pattern {Tag, 'gazonk'} breaks the opaqueness of timer:tref() diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/union b/lib/dialyzer/test/opaque_SUITE_data/results/union new file mode 100644 index 0000000000..98829b424a --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/results/union @@ -0,0 +1,5 @@ + +union_use.erl:12: The attempt to match a term of type union_adt:u() against the pattern 'aaa' breaks the opaqueness of the term +union_use.erl:16: The type test is_tuple(union_adt:u()) breaks the opaqueness of the term union_adt:u() +union_use.erl:7: Guard test is_atom(A::union_adt:u()) breaks the opaqueness of its argument +union_use.erl:8: Guard test is_tuple(T::union_adt:u()) breaks the opaqueness of its argument diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/wings b/lib/dialyzer/test/opaque_SUITE_data/results/wings new file mode 100644 index 0000000000..a9571441f8 --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/results/wings @@ -0,0 +1,11 @@ + +wings_dissolve.erl:103: Guard test is_list(List::gb_set()) breaks the opaqueness of its argument +wings_dissolve.erl:19: Guard test is_list(Faces::gb_set()) breaks the opaqueness of its argument +wings_dissolve.erl:272: Guard test is_list(Faces::gb_set()) breaks the opaqueness of its argument +wings_dissolve.erl:31: The call gb_sets:is_empty(Faces::[any(),...]) does not have an opaque term of type gb_set() as 1st argument +wings_edge.erl:205: The pattern <Edge, 'hard', Htab> can never match the type <_,'soft',_> +wings_edge_cmd.erl:30: The call gb_trees:size(P::gb_set()) contains an opaque term as 1st argument when an opaque term of type gb_tree() is expected +wings_edge_cmd.erl:32: The pattern [_ | Parts] can never match the type [] +wings_edge_cmd.erl:32: The pattern [{_, P} | _] can never match the type [] +wings_io.erl:30: The attempt to match a term of type {'empty',queue()} against the pattern {'empty', {In, Out}} breaks the opaqueness of queue() +wings_we.erl:155: The call wings_util:gb_trees_largest_key(Etab::gb_tree()) contains an opaque term as 1st argument when a structured term of type {_,{_,_,_,'nil' | {_,_,_,'nil' | {_,_,_,_}}}} is expected diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/array/array_use.erl b/lib/dialyzer/test/opaque_SUITE_data/src/array/array_use.erl new file mode 100644 index 0000000000..1702dc8f03 --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/array/array_use.erl @@ -0,0 +1,15 @@ +-module(array_use). + +-export([ok1/0, wrong1/0, wrong2/0]). + +ok1() -> + array:set(17, gazonk, array:new()). + +wrong1() -> + {array, _, _, undefined, _} = array:new(42). + +wrong2() -> + case is_tuple(array:new(42)) of + true -> structure_is_exposed; + false -> cannot_possibly_be + end. diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/crash/crash_1.erl b/lib/dialyzer/test/opaque_SUITE_data/src/crash/crash_1.erl new file mode 100644 index 0000000000..eebeed15af --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/crash/crash_1.erl @@ -0,0 +1,55 @@ +%%%------------------------------------------------------------------- +%%% From : Fredrik Thulin <[email protected]> +%%% +%%% A module with an erroneous record field declaration which mixes up +%%% structured and opaque terms and causes a crash in dialyzer. +%%% +%%% In addition, it revealed that the compiler produced extraneous +%%% warnings about unused record definitions when in fact they are +%%% needed for type declarations. This is now fixed. +%%%------------------------------------------------------------------- +-module(crash_1). + +-export([add/3, empty/0]). + +%%-------------------------------------------------------------------- + +-record(sipurl, {proto = "sip" :: string(), host :: string()}). +-record(keylist, {list = [] :: [_]}). +-type sip_headers() :: #keylist{}. +-record(request, {uri :: #sipurl{}, header :: sip_headers()}). +-type sip_request() :: #request{}. + +%%-------------------------------------------------------------------- + +-record(target, {branch :: string(), request :: sip_request()}). +-opaque target() :: #target{}. + +-record(targetlist, {list :: target()}). % XXX: THIS ONE SHOULD READ [target()] +-opaque targetlist() :: #targetlist{}. + +%%==================================================================== + +add(Branch, #request{} = Request, #targetlist{list = L} = TargetList) -> + case get_using_branch(Branch, TargetList) of + none -> + NewTarget = #target{branch = Branch, request = Request}, + #targetlist{list = L ++ [NewTarget]}; + #target{} -> + TargetList + end. + +-spec empty() -> targetlist(). + +empty() -> + #targetlist{list = []}. + +get_using_branch(Branch, #targetlist{list = L}) when is_list(Branch) -> + get_using_branch2(Branch, L). + +get_using_branch2(_Branch, []) -> + none; +get_using_branch2(Branch, [#target{branch=Branch}=H | _T]) -> + H; +get_using_branch2(Branch, [#target{} | T]) -> + get_using_branch2(Branch, T). diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/dict/dict_use.erl b/lib/dialyzer/test/opaque_SUITE_data/src/dict/dict_use.erl new file mode 100644 index 0000000000..8a2cd86f43 --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/dict/dict_use.erl @@ -0,0 +1,82 @@ +-module(dict_use). + +-export([ok1/0, ok2/0, ok3/0, ok4/0, ok5/0, ok6/0]). +-export([middle/0]). +-export([w1/0, w2/0, w3/0, w4/1, w5/0, w6/0, w7/0, w8/1, w9/0]). + +-define(DICT, dict). + +%%--------------------------------------------------------------------- +%% Cases that are OK +%%--------------------------------------------------------------------- + +ok1() -> + dict:new(). + +ok2() -> + case dict:new() of X -> X end. + +ok3() -> + Dict1 = dict:new(), + Dict2 = dict:new(), + Dict1 =:= Dict2. + +ok4() -> + dict:fetch(foo, dict:new()). + +ok5() -> % this is OK since some_mod:new/0 might be returning a dict() + dict:fetch(foo, some_mod:new()). + +ok6() -> + dict:store(42, elli, dict:new()). + +middle() -> + {w1(), w2()}. + +%%--------------------------------------------------------------------- +%% Cases that are problematic w.r.t. opaqueness of types +%%--------------------------------------------------------------------- + +w1() -> + gazonk = dict:new(). + +w2() -> + case dict:new() of + [] -> nil; + 42 -> weird + end. + +w3() -> + try dict:new() of + [] -> nil; + 42 -> weird + catch + _:_ -> exception + end. + +w4(Dict) when is_list(Dict) -> + Dict =:= dict:new(); +w4(Dict) when is_atom(Dict) -> + Dict =/= dict:new(). + +w5() -> + case dict:new() of + D when length(D) =/= 42 -> weird; + D when is_atom(D) -> weirder; + D when is_list(D) -> gazonk + end. + +w6() -> + is_list(dict:new()). + +w7() -> + dict:fetch(foo, [1,2,3]). + +w8(Fun) -> + dict:merge(Fun, 42, [1,2]). + +w9() -> + dict:store(42, elli, + {dict,0,16,16,8,80,48, + {[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[]}, + {{[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[]}}}). diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/ets/ets_use.erl b/lib/dialyzer/test/opaque_SUITE_data/src/ets/ets_use.erl new file mode 100644 index 0000000000..d65af0af4e --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/ets/ets_use.erl @@ -0,0 +1,16 @@ +-module(ets_use). +-export([t1/0, t2/0]). + +t1() -> + case n() of + T when is_atom(T) -> atm; + T when is_integer(T) -> int + end. + +t2() -> + case n() of + T when is_integer(T) -> int; + T when is_atom(T) -> atm + end. + +n() -> ets:new(n, [named_table]). diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/gb_sets/gb_sets_rec.erl b/lib/dialyzer/test/opaque_SUITE_data/src/gb_sets/gb_sets_rec.erl new file mode 100644 index 0000000000..008b0a486a --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/gb_sets/gb_sets_rec.erl @@ -0,0 +1,23 @@ +%%--------------------------------------------------------------------- +%% This module does not test gb_sets. Instead it tests that we can +%% create records whose fields are declared with an opaque type and +%% retrieve these fields without problems. Unitialized record fields +%% used to cause trouble for the analysis due to the implicit +%% 'undefined' value that record fields contain. The problem was the +%% strange interaction of ?opaque() and ?union() in the definition of +%% erl_types:t_inf/3. This was fixed 18/1/2009. +%% -------------------------------------------------------------------- + +-module(gb_sets_rec). + +-export([new/0, get_g/1]). + +-record(rec, {g :: gb_set()}). + +-spec new() -> #rec{}. +new() -> + #rec{g = gb_sets:empty()}. + +-spec get_g(#rec{}) -> gb_set(). +get_g(R) -> + R#rec.g. diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/inf_loop1.erl b/lib/dialyzer/test/opaque_SUITE_data/src/inf_loop1.erl new file mode 100644 index 0000000000..0dff16cf14 --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/inf_loop1.erl @@ -0,0 +1,172 @@ +%% -*- erlang-indent-level: 2 -*- +%%---------------------------------------------------------------------------- +%% Non-sensical (i.e., stripped-down) program that sends the analysis +%% into an infinite loop. The #we.es field was originally a gb_tree() +%% but the programmer declared it as an array in order to change it to +%% that data type instead. In the file, there are two calls to function +%% gb_trees:get/2 which seem to be the ones responsible for sending the +%% analysis into an infinite loop. Currently, these calls are marked and +%% have been changed to gbee_trees:get/2 in order to be able to see that +%% the analysis works if these two calls are taken out of the picture. +%%---------------------------------------------------------------------------- +-module(inf_loop1). + +-export([command/1]). + +-record(we, {id, + es = array:new() :: array(), + vp, + mirror = none}). +-record(edge, {vs,ve,a = none,b = none,lf,rf,ltpr,ltsu,rtpr,rtsu}). + +command(St) -> + State = drag_mode(offset_region), + SetupSt = wings_sel_conv:more(St), + Tvs = wings_sel:fold(fun(Faces, #we{id = Id} = We, Acc) -> + FaceRegions = wings_sel:face_regions(Faces, We), + {AllVs0,VsData} = + collect_offset_regions_data(FaceRegions, We, [], []), + AllVs = ordsets:from_list(AllVs0), + [{Id,{AllVs,offset_regions_fun(VsData, State)}}|Acc] + end, + [], + SetupSt), + wings_drag:setup(Tvs, 42, [], St). + +drag_mode(Type) -> + {Mode,Norm} = wings_pref:get_value(Type, {average,loop}), + {Type,Mode,Norm}. + +collect_offset_regions_data([Faces|Regions], We, AllVs, VsData) -> + {FaceNormTab,OuterEdges,RegVs} = + some_fake_module:faces_data_0(Faces, We, [], [], []), + {LoopNorm,LoopVsData,LoopVs} = + offset_regions_loop_data(OuterEdges, Faces, We, FaceNormTab), + Vs = RegVs -- LoopVs, + RegVsData = vertex_normals(Vs, FaceNormTab, We, LoopVsData), + collect_offset_regions_data(Regions, We, RegVs ++ AllVs, + [{LoopNorm,RegVsData}|VsData]); +collect_offset_regions_data([], _, AllVs, VsData) -> + {AllVs,VsData}. + +offset_regions_loop_data(Edges, Faces, We, FNtab) -> + EdgeSet = gb_sets:from_list(Edges), + offset_loop_data_0(EdgeSet, Faces, We, FNtab, [], [], []). + +offset_loop_data_0(EdgeSet0, Faces, We, FNtab, LNorms, VData0, Vs0) -> + case gb_sets:is_empty(EdgeSet0) of + false -> + {Edge,EdgeSet1} = gb_sets:take_smallest(EdgeSet0), + {EdgeSet,VData,Links,LoopNorm,Vs} = + offset_loop_data_1(Edge, EdgeSet1, Faces, We, FNtab, VData0, Vs0), + offset_loop_data_0(EdgeSet, Faces, We, FNtab, + [{Links,LoopNorm}|LNorms], VData, Vs); + true -> + AvgLoopNorm = average_loop_norm(LNorms), + {AvgLoopNorm,VData0,Vs0} + end. + +offset_loop_data_1(Edge, EdgeSet, _Faces, + #we{es = Etab, vp = Vtab} = We, FNtab, VData, Vs) -> + #edge{vs = Va, ve = Vb, lf = Lf, ltsu = NextLeft} = gb_trees:get(Edge, Etab), + VposA = gb_trees:get(Va, Vtab), + VposB = gb_trees:get(Vb, Vtab), + VDir = e3d_vec:sub(VposB, VposA), + FNorm = wings_face:normal(Lf, We), + EdgeData = gb_trees:get(NextLeft, Etab), + offset_loop_data_2(NextLeft, EdgeData, Va, VposA, Lf, Edge, We, FNtab, + EdgeSet, VDir, [], [FNorm], VData, [], Vs, 0). + +offset_loop_data_2(CurE, #edge{vs = Va, ve = Vb, lf = PrevFace, + rtsu = NextEdge, ltsu = IfCurIsMember}, + Vb, VposB, PrevFace, LastE, + #we{mirror = M} = We, + FNtab, EdgeSet0, VDir, EDir0, VNorms0, VData0, VPs0, Vs0, + Links) -> + Mirror = M == PrevFace, + offset_loop_is_member(Mirror, Vb, Va, VposB, CurE, IfCurIsMember, VNorms0, + NextEdge, EdgeSet0, VDir, EDir0, FNtab, PrevFace, + LastE, We, VData0, VPs0, Vs0, Links). + +offset_loop_is_member(Mirror, V1, V2, Vpos1, CurE, NextE, VNorms0, NEdge, + EdgeSet0, VDir, EDir0, FNtab, PFace, LastE, We, + VData0, VPs0, Vs0, Links) -> + #we{es = Etab, vp = Vtab} = We, + Vpos2 = gb_trees:get(V2, Vtab), + Dir = e3d_vec:sub(Vpos2, Vpos1), + NextVDir = e3d_vec:neg(Dir), + EdgeSet = gb_sets:delete(CurE, EdgeSet0), + EdgeData = gbee_trees:get(NextE, Etab), %% HERE + [FNorm|_] = VNorms0, + VData = offset_loop_data_3(Mirror, V1, Vpos1, VNorms0, NEdge, VDir, + Dir, EDir0, FNtab, We, VData0), + VPs = [Vpos1|VPs0], + Vs = [V1|Vs0], + offset_loop_data_2(NextE, EdgeData, V2, Vpos2, PFace, LastE, We, FNtab, + EdgeSet, NextVDir, [], [FNorm], VData, VPs, Vs, Links + 1). + +offset_loop_data_3(false, V, Vpos, VNorms0, NextEdge, + VDir, Dir, EDir0, FNtab, We, VData0) -> + #we{es = Etab} = We, + VNorm = e3d_vec:norm(e3d_vec:add(VNorms0)), + NV = wings_vertex:other(V, gbee_trees:get(NextEdge, Etab)), %% HERE + ANorm = vertex_normal(NV, FNtab, We), + EDir = some_fake_module:average_edge_dir(VNorm, VDir, Dir, EDir0), + AvgDir = some_fake_module:evaluate_vdata(VDir, Dir, VNorm), + ScaledDir = some_fake_module:along_edge_scale_factor(VDir, Dir, EDir, ANorm), + [{V,{Vpos,AvgDir,EDir,ScaledDir}}|VData0]. + +average_loop_norm([{_,LNorms}]) -> + e3d_vec:norm(LNorms); +average_loop_norm([{LinksA,LNormA},{LinksB,LNormB}]) -> + case LinksA < LinksB of + true -> + e3d_vec:norm(e3d_vec:add(e3d_vec:neg(LNormA), LNormB)); + false -> + e3d_vec:norm(e3d_vec:add(e3d_vec:neg(LNormB), LNormA)) + end; +average_loop_norm(LNorms) -> + LoopNorms = [Norm || {_,Norm} <- LNorms], + e3d_vec:norm(e3d_vec:neg(e3d_vec:add(LoopNorms))). + +vertex_normals([V|Vs], FaceNormTab, #we{vp = Vtab, mirror = M} = We, Acc) -> + FaceNorms = + wings_vertex:fold(fun(_, Face, _, A) when Face == M -> + [e3d_vec:neg(wings_face:normal(M, We))|A]; + (_, Face, _, A) -> + [gb_trees:get(Face, FaceNormTab)|A] + end, [], V, We), + VNorm = e3d_vec:norm(e3d_vec:add(FaceNorms)), + Vpos = gb_trees:get(V, Vtab), + vertex_normals(Vs, FaceNormTab, We, [{V,{Vpos,VNorm}}|Acc]); +vertex_normals([], _, _, Acc) -> + Acc. + +vertex_normal(V, FaceNormTab, #we{mirror = M} = We) -> + wings_vertex:fold(fun(_, Face, _, A) when Face == M -> + [e3d_vec:neg(wings_face:normal(Face, We))|A]; + (_, Face, _, A) -> + N = gb_trees:get(Face, FaceNormTab), + case e3d_vec:is_zero(N) of + true -> A; + false -> [N|A] + end + end, [], V, We). + +offset_regions_fun(OffsetData, {_,Solution,_} = State) -> + fun(new_mode_data, {NewState,_}) -> + offset_regions_fun(OffsetData, NewState); + ([Dist,_,_,Bump|_], A) -> + lists:foldl(fun({LoopNormal,VsData}, VsAcc0) -> + lists:foldl(fun({V,{Vpos0,VNorm}}, VsAcc) -> + [{V,Vpos0}|VsAcc]; + ({V,{Vpos0,Dir,EDir,ScaledEDir}}, VsAcc) -> + Vec = case Solution of + average -> Dir; + along_edges -> EDir; + scaled -> ScaledEDir + end, + [{V,Vpos0}|VsAcc] + end, VsAcc0, VsData) + end, A, OffsetData) + end. diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/int/int_adt.erl b/lib/dialyzer/test/opaque_SUITE_data/src/int/int_adt.erl new file mode 100644 index 0000000000..99f8cbdc4a --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/int/int_adt.erl @@ -0,0 +1,33 @@ +%%---------------------------------------------------------------------------- +%% Module that tests consistency of spec declarations in the presence of +%% opaque types. Contains both valid and invalid contracts with opaque types. +%%---------------------------------------------------------------------------- + +-module(int_adt). + +-export([new_i/0, add_i/2, div_i/2, add_f/2, div_f/2]). + +-export_type([int/0]). + +-opaque int() :: integer(). + +%% the user has declared the return to be an opaque type, but the success +%% typing inference is too strong and finds a subtype as a return: this is OK +-spec new_i() -> int(). +new_i() -> 42. + +%% the success typing is more general than the contract: this is OK +-spec add_i(int(), int()) -> int(). +add_i(X, Y) -> X + Y. + +%% the success typing coincides with the contract: this is OK, of course +-spec div_i(int(), int()) -> int(). +div_i(X, Y) -> X div Y. + +%% the success typing has an incompatible domain element: this is invalid +-spec add_f(int(), int()) -> int(). +add_f(X, Y) when is_float(Y) -> X + trunc(Y). + +%% the success typing has an incompatible range: this is invalid +-spec div_f(int(), int()) -> int(). +div_f(X, Y) -> X / Y. diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/int/int_use.erl b/lib/dialyzer/test/opaque_SUITE_data/src/int/int_use.erl new file mode 100644 index 0000000000..b4471e1cee --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/int/int_use.erl @@ -0,0 +1,11 @@ +%%--------------------------------------------------------------------------- +%% Module that uses the opaque types of int_adt. +%% TODO: Should be extended with invalid contracts. +%%--------------------------------------------------------------------------- +-module(int_use). + +-export([test/0]). + +-spec test() -> int_adt:int(). +test() -> + int_adt:new_i(). diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/mixed_opaque/mixed_opaque_queue_adt.erl b/lib/dialyzer/test/opaque_SUITE_data/src/mixed_opaque/mixed_opaque_queue_adt.erl new file mode 100644 index 0000000000..ac59f19cd3 --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/mixed_opaque/mixed_opaque_queue_adt.erl @@ -0,0 +1,26 @@ +%%--------------------------------------------------------------------------- +%% A clone of 'queue_adt' so as to test its combination with 'rec_adt' +%%--------------------------------------------------------------------------- +-module(mixed_opaque_queue_adt). + +-export([new/0, add/2, dequeue/1, is_empty/1]). + +-opaque my_queue() :: list(). + +-spec new() -> my_queue(). +new() -> + []. + +-spec add(term(), my_queue()) -> my_queue(). +add(E, Q) -> + Q ++ [E]. + +-spec dequeue(my_queue()) -> {term(), my_queue()}. +dequeue([H|T]) -> + {H, T}. + +-spec is_empty(my_queue()) -> boolean(). +is_empty([]) -> + true; +is_empty([_|_]) -> + false. diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/mixed_opaque/mixed_opaque_rec_adt.erl b/lib/dialyzer/test/opaque_SUITE_data/src/mixed_opaque/mixed_opaque_rec_adt.erl new file mode 100644 index 0000000000..61bae5110d --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/mixed_opaque/mixed_opaque_rec_adt.erl @@ -0,0 +1,25 @@ +%%--------------------------------------------------------------------------- +%% A clone of 'rec_adt' so as to test its combination with 'queue_adt' +%%--------------------------------------------------------------------------- +-module(mixed_opaque_rec_adt). + +-export([new/0, get_a/1, get_b/1, set_a/2, set_b/2]). + +-record(rec, {a :: atom(), b = 0 :: integer()}). + +-opaque rec() :: #rec{}. + +-spec new() -> rec(). +new() -> #rec{a = gazonk, b = 42}. + +-spec get_a(rec()) -> atom(). +get_a(#rec{a = A}) -> A. + +-spec get_b(rec()) -> integer(). +get_b(#rec{b = B}) -> B. + +-spec set_a(rec(), atom()) -> rec(). +set_a(R, A) -> R#rec{a = A}. + +-spec set_b(rec(), integer()) -> rec(). +set_b(R, B) -> R#rec{b = B}. diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/mixed_opaque/mixed_opaque_use.erl b/lib/dialyzer/test/opaque_SUITE_data/src/mixed_opaque/mixed_opaque_use.erl new file mode 100644 index 0000000000..e82dcd5f38 --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/mixed_opaque/mixed_opaque_use.erl @@ -0,0 +1,31 @@ +%%--------------------------------------------------------------------------- +%% Test that tries some combinations of using more than one opaque data type +%% in the same function(s). +%%---------------------------------------------------------------------------- +-module(mixed_opaque_use). + +-export([ok1/1, ok2/0, wrong1/0]). + +-define(REC, mixed_opaque_rec_adt). +-define(QUEUE, mixed_opaque_queue_adt). + +%% Currently returning unions of opaque types is considered OK +ok1(Type) -> + case Type of + queue -> ?QUEUE:new(); + rec -> ?REC:new() + end. + +%% Constructing a queue of records is OK +ok2() -> + Q0 = ?QUEUE:new(), + R0 = ?REC:new(), + Q1 = ?QUEUE:add(R0, Q0), + {R1,_Q2} = ?QUEUE:dequeue(Q1), + ?REC:get_a(R1). + +%% But of course calling a function expecting some opaque type +%% with some other opaque typs is not OK +wrong1() -> + Q = ?QUEUE:new(), + ?REC:get_a(Q). diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/my_digraph/my_digraph_adt.erl b/lib/dialyzer/test/opaque_SUITE_data/src/my_digraph/my_digraph_adt.erl new file mode 100644 index 0000000000..82159d6a8d --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/my_digraph/my_digraph_adt.erl @@ -0,0 +1,51 @@ +-module(my_digraph_adt). + +-export([new/0, new/1]). + +-record(my_digraph, {vtab = notable, + etab = notable, + ntab = notable, + cyclic = true :: boolean()}). + +-opaque my_digraph() :: #my_digraph{}. + +-type d_protection() :: 'private' | 'protected'. +-type d_cyclicity() :: 'acyclic' | 'cyclic'. +-type d_type() :: d_cyclicity() | d_protection(). + +-spec new() -> my_digraph(). +new() -> new([]). + +-spec new([atom()]) -> my_digraph(). +new(Type) -> + try check_type(Type, protected, []) of + {Access, Ts} -> + V = ets:new(vertices, [set, Access]), + E = ets:new(edges, [set, Access]), + N = ets:new(neighbours, [bag, Access]), + ets:insert(N, [{'$vid', 0}, {'$eid', 0}]), + set_type(Ts, #my_digraph{vtab=V, etab=E, ntab=N}) + catch + throw:Error -> throw(Error) + end. + +-spec check_type([atom()], d_protection(), [{'cyclic', boolean()}]) -> + {d_protection(), [{'cyclic', boolean()}]}. + +check_type([acyclic|Ts], A, L) -> + check_type(Ts, A,[{cyclic,false} | L]); +check_type([cyclic | Ts], A, L) -> + check_type(Ts, A, [{cyclic,true} | L]); +check_type([protected | Ts], _, L) -> + check_type(Ts, protected, L); +check_type([private | Ts], _, L) -> + check_type(Ts, private, L); +check_type([T | _], _, _) -> + throw({error, {unknown_type, T}}); +check_type([], A, L) -> {A, L}. + +-spec set_type([{'cyclic', boolean()}], my_digraph()) -> my_digraph(). + +set_type([{cyclic,V} | Ks], G) -> + set_type(Ks, G#my_digraph{cyclic = V}); +set_type([], G) -> G. diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/my_queue/my_queue_adt.erl b/lib/dialyzer/test/opaque_SUITE_data/src/my_queue/my_queue_adt.erl new file mode 100644 index 0000000000..52688062ce --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/my_queue/my_queue_adt.erl @@ -0,0 +1,23 @@ +-module(my_queue_adt). + +-export([new/0, add/2, dequeue/1, is_empty/1]). + +-opaque my_queue() :: list(). + +-spec new() -> my_queue(). +new() -> + []. + +-spec add(term(), my_queue()) -> my_queue(). +add(E, Q) -> + Q ++ [E]. + +-spec dequeue(my_queue()) -> {term(), my_queue()}. +dequeue([H|T]) -> + {H, T}. + +-spec is_empty(my_queue()) -> boolean(). +is_empty([]) -> + true; +is_empty([_|_]) -> + false. diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/my_queue/my_queue_use.erl b/lib/dialyzer/test/opaque_SUITE_data/src/my_queue/my_queue_use.erl new file mode 100644 index 0000000000..98f9972c1e --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/my_queue/my_queue_use.erl @@ -0,0 +1,35 @@ +-module(my_queue_use). + +-export([ok1/0, ok2/0, wrong1/0, wrong2/0, wrong3/0, wrong4/0, wrong5/0]). + +ok1() -> + my_queue_adt:is_empty(my_queue_adt:new()). + +ok2() -> + Q0 = my_queue_adt:new(), + Q1 = my_queue_adt:add(42, Q0), + {42, Q2} = my_queue_adt:dequeue(Q1), + my_queue_adt:is_empty(Q2). + +wrong1() -> + my_queue_adt:is_empty([]). + +wrong2() -> + Q0 = [], + my_queue_adt:add(42, Q0). + +wrong3() -> + Q0 = my_queue_adt:new(), + Q1 = my_queue_adt:add(42, Q0), + [42|Q2] = Q1, + Q2. + +wrong4() -> + Q0 = my_queue_adt:new(), + Q1 = my_queue_adt:add(42, Q0), + Q1 =:= []. + +wrong5() -> + Q0 = my_queue_adt:new(), + {42, Q2} = my_queue_adt:dequeue([42|Q0]), + Q2. diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/opaque/opaque_adt.erl b/lib/dialyzer/test/opaque_SUITE_data/src/opaque/opaque_adt.erl new file mode 100644 index 0000000000..3456f0e9c6 --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/opaque/opaque_adt.erl @@ -0,0 +1,9 @@ +-module(opaque_adt). +-export([atom_or_list/1]). + +-opaque abc() :: 'a' | 'b' | 'c'. + +atom_or_list(1) -> a; +atom_or_list(2) -> b; +atom_or_list(3) -> c; +atom_or_list(N) -> lists:duplicate(N, a). diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/opaque/opaque_bug1.erl b/lib/dialyzer/test/opaque_SUITE_data/src/opaque/opaque_bug1.erl new file mode 100644 index 0000000000..5a03989853 --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/opaque/opaque_bug1.erl @@ -0,0 +1,16 @@ +%%--------------------------------------------------------------------- +%% A test for which the analysis went into an infinite loop due to +%% specialization using structured type instead of the opaque one. +%%--------------------------------------------------------------------- + +-module(opaque_bug1). + +-export([test/1]). + +-record(c, {a::atom()}). + +-opaque erl_type() :: 'any' | #c{}. + +test(#c{a=foo} = T) -> local(T). + +local(#c{a=foo}) -> any. diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/opaque/opaque_bug2.erl b/lib/dialyzer/test/opaque_SUITE_data/src/opaque/opaque_bug2.erl new file mode 100644 index 0000000000..f193a58f59 --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/opaque/opaque_bug2.erl @@ -0,0 +1,13 @@ +%%--------------------------------------------------------------------- +%% A test for which the analysis gave a bogus warning due to +%% considering the function call name to be of opaque type... +%%--------------------------------------------------------------------- + +-module(opaque_bug2). + +-export([test/0]). + +-opaque o() :: 'map'. + +test() -> + lists:map(fun(X) -> X+1 end, [1,2]). diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/opaque/opaque_bug3.erl b/lib/dialyzer/test/opaque_SUITE_data/src/opaque/opaque_bug3.erl new file mode 100644 index 0000000000..71da82a1f6 --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/opaque/opaque_bug3.erl @@ -0,0 +1,19 @@ +%%--------------------------------------------------------------------- +%% A test for which the analysis gave wrong results because it did not +%% handle the is_tuple/1 guard properly. +%%--------------------------------------------------------------------- + +-module(opaque_bug3). + +-export([test/1]). + +-record(c, {}). + +-opaque o() :: 'a' | #c{}. + +-spec test(o()) -> 42. + +test(#c{} = O) -> t(O). + +t(T) when is_tuple(T) -> 42; +t(a) -> gazonk. diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/opaque/opaque_bug4.erl b/lib/dialyzer/test/opaque_SUITE_data/src/opaque/opaque_bug4.erl new file mode 100644 index 0000000000..a7ddc80fe8 --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/opaque/opaque_bug4.erl @@ -0,0 +1,21 @@ +%%--------------------------------------------------------------------- +%% A test for which the analysis gave wrong results due to erroneous +%% specialization and incorrect handling of unions. +%%--------------------------------------------------------------------- + +-module(opaque_bug4). + +-export([ok/0, wrong/0]). + +%-spec ok() -> 'ok'. +ok() -> + L = opaque_adt:atom_or_list(42), + foo(L). + +%-spec wrong() -> 'not_ok'. +wrong() -> + A = opaque_adt:atom_or_list(1), + foo(A). + +foo(a) -> not_ok; +foo([_|_]) -> ok. diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/queue/queue_use.erl b/lib/dialyzer/test/opaque_SUITE_data/src/queue/queue_use.erl new file mode 100644 index 0000000000..8d46bdb989 --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/queue/queue_use.erl @@ -0,0 +1,65 @@ +-module(queue_use). + +-export([ok1/0, ok2/0]). +-export([wrong1/0, wrong2/0, wrong3/0, wrong4/0, wrong5/0, wrong6/0, wrong7/0, wrong8/0]). + +ok1() -> + queue:is_empty(queue:new()). + +ok2() -> + Q0 = queue:new(), + Q1 = queue:in(42, Q0), + {{value, 42}, Q2} = queue:out(Q1), + queue:is_empty(Q2). + +%%-------------------------------------------------- + +wrong1() -> + queue:is_empty({[],[]}). + +wrong2() -> + Q0 = {[],[]}, + queue:in(42, Q0). + +wrong3() -> + Q0 = queue:new(), + Q1 = queue:in(42, Q0), + {[42],Q2} = Q1, + Q2. + +wrong4() -> + Q0 = queue:new(), + Q1 = queue:in(42, Q0), + Q1 =:= {[42],[]}. + +wrong5() -> + {F, _R} = queue:new(), + F. + +wrong6() -> + {{value, 42}, Q2} = queue:out({[42],[]}), + Q2. + +%%-------------------------------------------------- + +-record(db, {p, q}). + +wrong7() -> + add_unique(42, #db{p = [], q = queue:new()}). + +add_unique(E, DB) -> + case is_in_queue(E, DB) of + true -> DB; + false -> DB#db{q = queue:in(E, DB#db.q)} + end. + +is_in_queue(P, #db{q = {L1,L2}}) -> + lists:member(P, L1) orelse lists:member(P, L2). + +%%-------------------------------------------------- + +wrong8() -> + tuple_queue({42, gazonk}). + +tuple_queue({F, Q}) -> + queue:in(F, Q). diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/rec/rec_adt.erl b/lib/dialyzer/test/opaque_SUITE_data/src/rec/rec_adt.erl new file mode 100644 index 0000000000..f01cc5e519 --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/rec/rec_adt.erl @@ -0,0 +1,22 @@ +-module(rec_adt). + +-export([new/0, get_a/1, get_b/1, set_a/2, set_b/2]). + +-record(rec, {a :: atom(), b = 0 :: integer()}). + +-opaque rec() :: #rec{}. + +-spec new() -> rec(). +new() -> #rec{a = gazonk, b = 42}. + +-spec get_a(rec()) -> atom(). +get_a(#rec{a = A}) -> A. + +-spec get_b(rec()) -> integer(). +get_b(#rec{b = B}) -> B. + +-spec set_a(rec(), atom()) -> rec(). +set_a(R, A) -> R#rec{a = A}. + +-spec set_b(rec(), integer()) -> rec(). +set_b(R, B) -> R#rec{b = B}. diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/rec/rec_use.erl b/lib/dialyzer/test/opaque_SUITE_data/src/rec/rec_use.erl new file mode 100644 index 0000000000..358e9f918c --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/rec/rec_use.erl @@ -0,0 +1,30 @@ +-module(rec_use). + +-export([ok1/0, ok2/0, wrong1/0, wrong2/0, wrong3/0, wrong4/0]). + +ok1() -> + rec_adt:set_a(rec_adt:new(), foo). + +ok2() -> + R1 = rec_adt:new(), + B1 = rec_adt:get_b(R1), + R2 = rec_adt:set_b(R1, 42), + B2 = rec_adt:get_b(R2), + B1 =:= B2. + +wrong1() -> + case rec_adt:new() of + {rec, _, 42} -> weird1; + R when tuple_size(R) =:= 3 -> weird2 + end. + +wrong2() -> + R = list_to_tuple([rec, a, 42]), + rec_adt:get_a(R). + +wrong3() -> + R = rec_adt:new(), + R =:= {rec, gazonk, 42}. + +wrong4() -> + tuple_size(rec_adt:new()). diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/timer/timer_use.erl b/lib/dialyzer/test/opaque_SUITE_data/src/timer/timer_use.erl new file mode 100644 index 0000000000..9c8ea0af1c --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/timer/timer_use.erl @@ -0,0 +1,20 @@ +%%--------------------------------------------------------------------------- +%% A test case with: +%% - a genuine matching error -- 1st branch +%% - a violation of the opaqueness of timer:tref() -- 2nd branch +%% - a subtle violation of the opaqueness of timer:tref() -- 3rd branch +%% The test is supposed to check that these cases are treated properly. +%%--------------------------------------------------------------------------- + +-module(timer_use). +-export([wrong/0]). + +-spec wrong() -> error. + +wrong() -> + case timer:kill_after(42, self()) of + gazonk -> weird; + {ok, 42} -> weirder; + {Tag, gazonk} when Tag =/= error -> weirdest; + {error, _} -> error + end. diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/union/union_adt.erl b/lib/dialyzer/test/opaque_SUITE_data/src/union/union_adt.erl new file mode 100644 index 0000000000..5ca3202bba --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/union/union_adt.erl @@ -0,0 +1,19 @@ +-module(union_adt). +-export([new/1, new_a/1, new_rec/1]). + +-record(rec, {x = 42 :: integer()}). + +-opaque u() :: 'aaa' | 'bbb' | #rec{}. + +new(a) -> aaa; +new(b) -> bbb; +new(X) when is_integer(X) -> + #rec{x = X}. + +%% the following two functions (and their uses in union_use.erl) test +%% that the return type is the opaque one and not just a subtype of it + +new_a(a) -> aaa. + +new_rec(X) when is_integer(X) -> + #rec{x = X}. diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/union/union_use.erl b/lib/dialyzer/test/opaque_SUITE_data/src/union/union_use.erl new file mode 100644 index 0000000000..6a103279cd --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/union/union_use.erl @@ -0,0 +1,16 @@ +-module(union_use). + +-export([test/1, wrong_a/0, wrong_rec/0]). + +test(X) -> + case union_adt:new(X) of + A when is_atom(A) -> atom; + T when is_tuple(T) -> tuple + end. + +wrong_a() -> + aaa = union_adt:new_a(a), + ok. + +wrong_rec() -> + is_tuple(union_adt:new_rec(42)). diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/wings/wings.hrl b/lib/dialyzer/test/opaque_SUITE_data/src/wings/wings.hrl new file mode 100644 index 0000000000..b815be5e1d --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/wings/wings.hrl @@ -0,0 +1,204 @@ +%% +%% wings.hrl -- +%% +%% Global record definition and defines. +%% +%% Copyright (c) 2001-2005 Bjorn Gustavsson +%% +%% See the file "license.terms" for information on usage and redistribution +%% of this file, and for a DISCLAIMER OF ALL WARRANTIES. +%% +%% $Id: wings.hrl,v 1.1 2009/01/25 18:55:33 kostis Exp $ +%% + +-include("wings_intl.hrl"). + +-ifdef(NEED_ESDL). +-include_lib("esdl/include/sdl.hrl"). +-include_lib("esdl/include/sdl_events.hrl"). +-include_lib("esdl/include/sdl_video.hrl"). +-include_lib("esdl/include/sdl_keyboard.hrl"). +-include_lib("esdl/include/sdl_mouse.hrl"). +-include_lib("esdl/src/sdl_util.hrl"). +-define(CTRL_BITS, ?KMOD_CTRL). +-define(ALT_BITS, ?KMOD_ALT). +-define(SHIFT_BITS, ?KMOD_SHIFT). +-define(META_BITS, ?KMOD_META). +-endif. + +-define(WINGS_VERSION, ?wings_version). + +-define(CHAR_HEIGHT, wings_text:height()). +-define(CHAR_WIDTH, wings_text:width()). + +-define(LINE_HEIGHT, (?CHAR_HEIGHT+2)). +-define(GROUND_GRID_SIZE, 1). +-define(CAMERA_DIST, (8.0*?GROUND_GRID_SIZE)). +-define(NORMAL_LINEWIDTH, 1.0). +-define(DEGREE, 176). %Degree character. + +-define(HIT_BUF_SIZE, (1024*1024)). + +-define(PANE_COLOR, {0.52,0.52,0.52}). +-define(BEVEL_HIGHLIGHT, {0.9,0.9,0.9}). +-define(BEVEL_LOWLIGHT, {0.3,0.3,0.3}). +-define(BEVEL_HIGHLIGHT_MIX, 0.5). +-define(BEVEL_LOWLIGHT_MIX, 0.5). + +-define(SLOW(Cmd), begin wings_io:hourglass(), Cmd end). +-define(TC(Cmd), wings_util:tc(fun() -> Cmd end, ?MODULE, ?LINE)). + +-ifdef(DEBUG). +-define(ASSERT(E), case E of + true -> ok; + _ -> + erlang:error({assertion_failed,?MODULE,?LINE}) + end). +-define(CHECK_ERROR(), wings_gl:check_error(?MODULE, ?LINE)). +-else. +-define(ASSERT(E),ok). +-define(CHECK_ERROR(), ok). +-endif. + +%% Display lists per object. +%% Important: Plain integers and integers in lists will be assumed to +%% be display lists. Arbitrary integers must be stored inside a tuple +%% or record to not be interpreted as a display list. +-record(dlo, + {work=none, %Workmode faces. + smooth=none, %Smooth-shaded faces. + edges=none, %Edges and wire-frame. + vs=none, %Unselected vertices. + hard=none, %Hard edges. + sel=none, %Selected items. + orig_sel=none, %Original selection. + normals=none, %Normals. + pick=none, %For picking. + proxy_faces=none, %Smooth proxy faces. + proxy_edges=none, %Smooth proxy edges. + + %% Miscellanous. + hilite=none, %Hilite display list. + mirror=none, %Virtual mirror data. + ns=none, %Normals/positions per face. + + %% Source for display lists. + src_we=none, %Source object. + src_sel=none, %Source selection. + orig_mode=none, %Original selection mode. + split=none, %Split data. + drag=none, %For dragging. + transparent=false, %Object includes transparancy. + proxy_data=none, %Data for smooth proxy. + open=false, %Open (has hole). + + %% List of display lists known to be needed only based + %% on display modes, not whether the lists themselves exist. + %% Example: [work,edges] + needed=[] + }). + +%% Main state record containing all objects and other important state. +-record(st, + {shapes, %All visible shapes + selmode, %Selection mode: + % vertex, edge, face, body + sh=false, %Smart highlight active: true|false + sel=[], %Current sel: [{Id,GbSet}] + ssels=[], %Saved selections: + % [{Name,Mode,GbSet}] + temp_sel=none, %Selection only temporary? + + mat, %Defined materials (GbTree). + pal=[], %Palette + file, %Current filename. + saved, %True if model has been saved. + onext, %Next object id to use. + bb=none, %Saved bounding box. + edge_loop=none, %Previous edge loop. + views={0,{}}, %{Current,TupleOfViews} + pst=gb_trees:empty(), %Plugin State Info + % gb_tree where key is plugin module + + %% Previous commands. + repeatable, %Last repeatable command. + ask_args, %Ask arguments. + drag_args, %Drag arguments for command. + def, %Default operations. + + %% Undo information. + top, %Top of stack. + bottom, %Bottom of stack. + next_is_undo, %State of undo/redo toggle. + undone %States that were undone. + }). + +%% The Winged-Edge data structure. +%% See http://www.cs.mtu.edu/~shene/COURSES/cs3621/NOTES/model/winged-e.html +-record(we, + {id, %Shape id. + perm=0, %Permissions: + % 0 - Everything allowed. + % 1 - Visible, can't select. + % [] or {Mode,GbSet} - + % Invisible, can't select. + % The GbSet contains the + % object's selection. + name, %Name. + es, %gb_tree containing edges + fs, %gb_tree containing faces + he, %gb_sets containing hard edges + vc, %Connection info (=incident edge) + % for vertices. + vp, %Vertex positions. + pst=gb_trees:empty(), %Plugin State Info, + % gb_tree where key is plugin module + mat=default, %Materials. + next_id, %Next free ID for vertices, + % edges, and faces. + % (Needed because we never re-use + % IDs.) + mode, %'vertex'/'material'/'uv' + mirror=none, %Mirror: none|Face + light=none, %Light data: none|Light + has_shape=true %true|false + }). + +-define(IS_VISIBLE(Perm), (Perm =< 1)). +-define(IS_NOT_VISIBLE(Perm), (Perm > 1)). +-define(IS_SELECTABLE(Perm), (Perm == 0)). +-define(IS_NOT_SELECTABLE(Perm), (Perm =/= 0)). + +-define(IS_LIGHT(We), ((We#we.light =/= none) and (not We#we.has_shape))). +-define(IS_ANY_LIGHT(We), (We#we.light =/= none)). +-define(HAS_SHAPE(We), (We#we.has_shape)). +%-define(IS_LIGHT(We), (We#we.light =/= none)). +%-define(IS_NOT_LIGHT(We), (We#we.light =:= none)). + +%% Edge in a winged-edge shape. +-record(edge, + {vs, %Start vertex for edge + ve, %End vertex for edge + a=none, %Color or UV coordinate. + b=none, %Color or UV coordinate. + lf, %Left face + rf, %Right face + ltpr, %Left traversal predecessor + ltsu, %Left traversal successor + rtpr, %Right traversal predecessor + rtsu %Right traversal successor + }). + +%% The current view/camera. +-record(view, + {origin, + distance, % From origo. + azimuth, + elevation, + pan_x, %Panning in X direction. + pan_y, %Panning in Y direction. + along_axis=none, %Which axis viewed along. + fov, %Field of view. + hither, %Near clipping plane. + yon %Far clipping plane. + }). diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/wings/wings_dissolve.erl b/lib/dialyzer/test/opaque_SUITE_data/src/wings/wings_dissolve.erl new file mode 100644 index 0000000000..c469f0a45d --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/wings/wings_dissolve.erl @@ -0,0 +1,375 @@ +%% +%% wings_dissolve.erl -- +%% +%% This module implements dissolve of faces. +%% + +-module(wings_dissolve). + +-export([faces/2, complement/2]). + +-include("wings.hrl"). + +%% faces([Face], We) -> We' +%% Dissolve the given faces. +faces([], We) -> We; +faces(Faces, #we{fs=Ftab0}=We) -> + case gb_sets:is_empty(Faces) of + true -> We; + false when is_list(Faces) -> + Complement = ordsets:subtract(gb_trees:keys(Ftab0), + ordsets:from_list(Faces)), + dissolve_1(Faces, Complement, We); + false -> + Complement = ordsets:subtract(gb_trees:keys(Ftab0), + gb_sets:to_list(Faces)), + dissolve_1(Faces, Complement, We) + end. + +faces([], _, We) -> We; +faces(Faces,Complement,We) -> + case gb_sets:is_empty(Faces) of + true -> We; + false -> dissolve_1(Faces, Complement,We) + end. + +dissolve_1(Faces, Complement, We0) -> + We1 = optimistic_dissolve(Faces,Complement,We0#we{vc=undefined}), + NewFaces = wings_we:new_items_as_ordset(face, We0, We1), + We2 = wings_face:delete_bad_faces(NewFaces, We1), + We = wings_we:rebuild(We2), + case wings_we:is_consistent(We) of + true -> + We; + false -> + io:format("Dissolving would cause an inconsistent object structure.") + end. + +%% complement([Face], We) -> We' +%% Dissolve all faces BUT the given faces. Also invalidate the +%% mirror face if it existed and was dissolved. +complement(Fs0, #we{fs=Ftab0}=We0) when is_list(Fs0) -> + Fs = ordsets:subtract(gb_trees:keys(Ftab0), ordsets:from_list(Fs0)), + case faces(Fs, Fs0, We0) of + #we{mirror=none}=We -> We; + #we{mirror=Face,fs=Ftab}=We -> + case gb_trees:is_defined(Face, Ftab) of + false -> We; + true -> We#we{mirror=none} + end + end; +complement(Fs, We) -> complement(gb_sets:to_list(Fs), We). + +optimistic_dissolve(Faces0, Compl, We0) -> + %% Optimistically assume that we have a simple region without + %% any holes. + case outer_edge_loop(Faces0, We0) of + error -> + %% Assumption was wrong. We need to partition the selection + %% and dissolve each partition in turn. + Parts = wings_sel:face_regions(Faces0, We0), + complex_dissolve(Parts, We0); + [_|_]=Loop -> + %% Assumption was correct. + simple_dissolve(Faces0, Compl, Loop, We0) + end. + +%% simple_dissolve(Faces, Loop, We0) -> We +%% Dissolve a region of faces with no holes and no +%% repeated vertices in the outer edge loop. + +simple_dissolve(Faces0, Compl, Loop, We0) -> + Faces = to_gb_set(Faces0), + OldFace = gb_sets:smallest(Faces), + Mat = wings_facemat:face(OldFace, We0), + We1 = fix_materials(Faces, Compl, We0), + #we{es=Etab0,fs=Ftab0,he=Htab0} = We1, + {Ftab1,Etab1,Htab} = simple_del(Faces, Ftab0, Etab0, Htab0, We1), + {NewFace,We2} = wings_we:new_id(We1), + Ftab = gb_trees:insert(NewFace, hd(Loop), Ftab1), + Last = lists:last(Loop), + Etab = update_outer([Last|Loop], Loop, NewFace, Ftab, Etab1), + We = We2#we{es=Etab,fs=Ftab,he=Htab}, + wings_facemat:assign(Mat, [NewFace], We). + +fix_materials(Del,Keep,We) -> + case gb_sets:size(Del) < length(Keep) of + true -> + wings_facemat:delete_faces(Del,We); + false -> + wings_facemat:keep_faces(Keep,We) + end. + +to_gb_set(List) when is_list(List) -> + gb_sets:from_list(List); +to_gb_set(S) -> S. + +%% Delete faces and inner edges for a simple region. +simple_del(Faces, Ftab0, Etab0, Htab0, We) -> + case {gb_trees:size(Ftab0),gb_sets:size(Faces)} of + {AllSz,FaceSz} when AllSz < 2*FaceSz -> + %% At least half of the faces are selected. + %% It is faster to find the edges for the + %% unselected faces. + UnselFaces = ordsets:subtract(gb_trees:keys(Ftab0), + gb_sets:to_list(Faces)), + + UnselSet = sofs:from_external(UnselFaces, [face]), + Ftab1 = sofs:from_external(gb_trees:to_list(Ftab0), + [{face,edge}]), + Ftab2 = sofs:restriction(Ftab1, UnselSet), + Ftab = gb_trees:from_orddict(sofs:to_external(Ftab2)), + + Keep0 = wings_face:to_edges(UnselFaces, We), + Keep = sofs:set(Keep0, [edge]), + Etab1 = sofs:from_external(gb_trees:to_list(Etab0), + [{edge,info}]), + Etab2 = sofs:restriction(Etab1, Keep), + Etab = gb_trees:from_orddict(sofs:to_external(Etab2)), + + Htab = simple_del_hard(Htab0, sofs:to_external(Keep), undefined), + {Ftab,Etab,Htab}; + {_,_} -> + Ftab = lists:foldl(fun(Face, Ft) -> + gb_trees:delete(Face, Ft) + end, Ftab0, gb_sets:to_list(Faces)), + Inner = wings_face:inner_edges(Faces, We), + Etab = lists:foldl(fun(Edge, Et) -> + gb_trees:delete(Edge, Et) + end, Etab0, Inner), + Htab = simple_del_hard(Htab0, undefined, Inner), + {Ftab,Etab,Htab} + end. + +simple_del_hard(Htab, Keep, Remove) -> + case gb_sets:is_empty(Htab) of + true -> Htab; + false -> simple_del_hard_1(Htab, Keep, Remove) + end. + +simple_del_hard_1(Htab, Keep, undefined) -> + gb_sets:intersection(Htab, gb_sets:from_ordset(Keep)); +simple_del_hard_1(Htab, undefined, Remove) -> + gb_sets:difference(Htab, gb_sets:from_ordset(Remove)). + +%% complex([Partition], We0) -> We0 +%% The general dissolve. + +complex_dissolve([Faces|T], We0) -> + Face = gb_sets:smallest(Faces), + Mat = wings_facemat:face(Face, We0), + We1 = wings_facemat:delete_faces(Faces, We0), + Parts = outer_edge_partition(Faces, We1), + We = do_dissolve(Faces, Parts, Mat, We0, We1), + complex_dissolve(T, We); +complex_dissolve([], We) -> We. + +do_dissolve(Faces, Ess, Mat, WeOrig, We0) -> + We1 = do_dissolve_faces(Faces, We0), + Inner = wings_face:inner_edges(Faces, WeOrig), + We2 = delete_inner(Inner, We1), + #we{he=Htab0} = We = do_dissolve_1(Ess, Mat, We2), + Htab = gb_sets:difference(Htab0, gb_sets:from_list(Inner)), + We#we{he=Htab}. + +do_dissolve_1([EdgeList|Ess], Mat, #we{es=Etab0,fs=Ftab0}=We0) -> + {Face,We1} = wings_we:new_id(We0), + Ftab = gb_trees:insert(Face, hd(EdgeList), Ftab0), + Last = lists:last(EdgeList), + Etab = update_outer([Last|EdgeList], EdgeList, Face, Ftab, Etab0), + We2 = We1#we{es=Etab,fs=Ftab}, + We = wings_facemat:assign(Mat, [Face], We2), + do_dissolve_1(Ess, Mat, We); +do_dissolve_1([], _Mat, We) -> We. + +do_dissolve_faces(Faces, #we{fs=Ftab0}=We) -> + Ftab = lists:foldl(fun(Face, Ft) -> + gb_trees:delete(Face, Ft) + end, Ftab0, gb_sets:to_list(Faces)), + We#we{fs=Ftab}. + +delete_inner(Inner, #we{es=Etab0}=We) -> + Etab = lists:foldl(fun(Edge, Et) -> + gb_trees:delete(Edge, Et) + end, Etab0, Inner), + We#we{es=Etab}. + +update_outer([Pred|[Edge|Succ]=T], More, Face, Ftab, Etab0) -> + #edge{rf=Rf} = R0 = gb_trees:get(Edge, Etab0), + Rec = case gb_trees:is_defined(Rf, Ftab) of + true -> + ?ASSERT(false == gb_trees:is_defined(R0#edge.lf, Ftab)), + LS = succ(Succ, More), + R0#edge{lf=Face,ltpr=Pred,ltsu=LS}; + false -> + ?ASSERT(true == gb_trees:is_defined(R0#edge.lf, Ftab)), + RS = succ(Succ, More), + R0#edge{rf=Face,rtpr=Pred,rtsu=RS} + end, + Etab = gb_trees:update(Edge, Rec, Etab0), + update_outer(T, More, Face, Ftab, Etab); +update_outer([_], _More, _Face, _Ftab, Etab) -> Etab. + +succ([Succ|_], _More) -> Succ; +succ([], [Succ|_]) -> Succ. + +%% outer_edge_loop(FaceSet,WingedEdge) -> [Edge] | error. +%% Partition the outer edges of the FaceSet into a single closed loop. +%% Return 'error' if the faces in FaceSet does not form a +%% simple region without holes. +%% +%% Equvivalent to +%% case outer_edge_partition(FaceSet,WingedEdge) of +%% [Loop] -> Loop; +%% [_|_] -> error +%% end. +%% but faster. + +outer_edge_loop(Faces, We) -> + case lists:sort(collect_outer_edges(Faces, We)) of + [] -> error; + [{Key,Val}|Es0] -> + case any_duplicates(Es0, Key) of + false -> + Es = gb_trees:from_orddict(Es0), + N = gb_trees:size(Es), + outer_edge_loop_1(Val, Es, Key, N, []); + true -> error + end + end. + +outer_edge_loop_1({Edge,V}, _, V, 0, Acc) -> + %% This edge completes the loop, and we have used all possible edges. + [Edge|Acc]; +outer_edge_loop_1({_,V}, _, V, _N, _) -> + %% Loop is complete, but we haven't used all edges. + error; +outer_edge_loop_1({_,_}, _, _, 0, _) -> + %% We have used all possible edges, but somehow the loop + %% is not complete. I can't see how this is possible. + erlang:error(internal_error); +outer_edge_loop_1({Edge,Vb}, Es, EndV, N, Acc0) -> + Acc = [Edge|Acc0], + outer_edge_loop_1(gb_trees:get(Vb, Es), Es, EndV, N-1, Acc). + +any_duplicates([{V,_}|_], V) -> true; +any_duplicates([_], _) -> false; +any_duplicates([{V,_}|Es], _) -> any_duplicates(Es, V). + +%% outer_edge_partition(FaceSet, WingedEdge) -> [[Edge]]. +%% Partition the outer edges of the FaceSet. Each partion +%% of edges form a closed loop with no repeated vertices. +%% Outer edges are edges that have one face in FaceSet +%% and one outside. +%% It is assumed that FaceSet consists of one region returned by +%% wings_sel:face_regions/2. + +outer_edge_partition(Faces, We) -> + F0 = collect_outer_edges(Faces, We), + F = gb_trees:from_orddict(wings_util:rel2fam(F0)), + partition_edges(F, []). + +collect_outer_edges(Faces, We) when is_list(Faces) -> + collect_outer_edges_1(Faces, gb_sets:from_list(Faces), We); +collect_outer_edges(Faces, We) -> + collect_outer_edges_1(gb_sets:to_list(Faces), Faces, We). + +collect_outer_edges_1(Fs0, Faces0, #we{fs=Ftab}=We) -> + case {gb_trees:size(Ftab),gb_sets:size(Faces0)} of + {AllSz,FaceSz} when AllSz < 2*FaceSz -> + Fs = ordsets:subtract(gb_trees:keys(Ftab), Fs0), + Faces = gb_sets:from_ordset(Fs), + Coll = collect_outer_edges_a(Faces), + wings_face:fold_faces(Coll, [], Fs, We); + {_,_} -> + Coll = collect_outer_edges_b(Faces0), + wings_face:fold_faces(Coll, [], Fs0, We) + end. + +collect_outer_edges_a(Faces) -> + fun(Face, _, Edge, #edge{ve=V,vs=OtherV,lf=Face,rf=Other}, Acc) -> + case gb_sets:is_member(Other, Faces) of + false -> [{V,{Edge,OtherV}}|Acc]; + true -> Acc + end; + (Face, _, Edge, #edge{ve=OtherV,vs=V,rf=Face,lf=Other}, Acc) -> + case gb_sets:is_member(Other, Faces) of + false -> [{V,{Edge,OtherV}}|Acc]; + true -> Acc + end + end. + +collect_outer_edges_b(Faces) -> + fun(Face, _, Edge, #edge{vs=V,ve=OtherV,lf=Face,rf=Other}, Acc) -> + case gb_sets:is_member(Other, Faces) of + false -> [{V,{Edge,OtherV}}|Acc]; + true -> Acc + end; + (Face, _, Edge, #edge{vs=OtherV,ve=V,rf=Face,lf=Other}, Acc) -> + case gb_sets:is_member(Other, Faces) of + false -> [{V,{Edge,OtherV}}|Acc]; + true -> Acc + end + end. + +partition_edges(Es0, Acc) -> + case gb_trees:is_empty(Es0) of + true -> Acc; + false -> + {Key,Val,Es1} = gb_trees:take_smallest(Es0), + {Cycle,Es} = part_collect_cycle(Key, Val, Es1, []), + partition_edges(Es, [Cycle|Acc]) + end. + +%% part_collect_cycle(Vertex, VertexInfo, EdgeInfo, Acc0) -> +%% none | {[Edge],EdgeInfo} +%% Collect the cycle starting with Vertex. +%% +%% Note: This function can only return 'none' when called +%% recursively. + +part_collect_cycle(_, repeated, _, _) -> + %% Repeated vertex - we are not allowed to go this way. + %% Can only happen if we were called recursively because + %% a fork was encountered. + none; +part_collect_cycle(_Va, [{Edge,Vb}], Es0, Acc0) -> + %% Basic case. Only one way to go. + Acc = [Edge|Acc0], + case gb_trees:lookup(Vb, Es0) of + none -> + {Acc,Es0}; + {value,Val} -> + Es = gb_trees:delete(Vb, Es0), + part_collect_cycle(Vb, Val, Es, Acc) + end; +part_collect_cycle(Va, [Val|More], Es0, []) -> + %% No cycle started yet and we have multiple choice of + %% edges out from this vertex. It doesn't matter which + %% edge we follow, so we'll follow the first one. + {Cycle,Es} = part_collect_cycle(Va, [Val], Es0, []), + {Cycle,gb_trees:insert(Va, More, Es)}; +part_collect_cycle(Va, Edges, Es0, Acc) -> + %% We have a partially collected cycle and we have a + %% fork (multiple choice of edges). Here we must choose + %% an edge that closes the cycle without passing Va + %% again (because repeated vertices are not allowed). + Es = gb_trees:insert(Va, repeated, Es0), + part_fork(Va, Edges, Es, Acc, []). + +part_fork(Va, [Val|More], Es0, Acc, Tried) -> + %% Try to complete the cycle by following this edge. + case part_collect_cycle(Va, [Val], Es0, Acc) of + none -> + %% Failure - try the next edge. + part_fork(Va, More, Es0, Acc, [Val|Tried]); + {Cycle,Es} -> + %% Found a cycle. Update the vertex information + %% with all edges remaining. + {Cycle,gb_trees:update(Va, lists:reverse(Tried, More), Es)} + end; +part_fork(_, [], _, _, _) -> + %% None of edges were possible. Can only happen if this function + %% was called recursively (i.e. if we hit another fork while + %% processing a fork). + none. diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/wings/wings_edge.erl b/lib/dialyzer/test/opaque_SUITE_data/src/wings/wings_edge.erl new file mode 100644 index 0000000000..3483acb711 --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/wings/wings_edge.erl @@ -0,0 +1,243 @@ +%% +%% wings_edge.erl -- +%% +%% This module contains most edge command and edge utility functions. +%% +%% Copyright (c) 2001-2008 Bjorn Gustavsson. +%% +%% See the file "license.terms" for information on usage and redistribution +%% of this file, and for a DISCLAIMER OF ALL WARRANTIES. +%% +%% $Id: wings_edge.erl,v 1.1 2009/01/25 18:55:33 kostis Exp $ +%% + +-module(wings_edge). + +-export([dissolve_edges/2]). + +-include("wings.hrl"). + +%%% +%%% Dissolve. +%%% + +dissolve_edges(Edges0, We0) when is_list(Edges0) -> + #we{es=Etab} = We1 = lists:foldl(fun internal_dissolve_edge/2, We0, Edges0), + case [E || E <- Edges0, gb_trees:is_defined(E, Etab)] of + Edges0 -> + %% No edge was deleted in the last pass. We are done. + We = wings_we:rebuild(We0#we{vc=undefined}), + wings_we:validate_mirror(We); + Edges -> + dissolve_edges(Edges, We1) + end; +dissolve_edges(Edges, We) -> + dissolve_edges(gb_sets:to_list(Edges), We). + +internal_dissolve_edge(Edge, #we{es=Etab}=We0) -> + case gb_trees:lookup(Edge, Etab) of + none -> We0; + {value,#edge{ltpr=Same,ltsu=Same,rtpr=Same,rtsu=Same}} -> + Empty = gb_trees:empty(), + We0#we{vc=Empty,vp=Empty,es=Empty,fs=Empty,he=gb_sets:empty()}; + {value,#edge{rtpr=Back,ltsu=Back}=Rec} -> + merge_edges(backward, Edge, Rec, We0); + {value,#edge{rtsu=Forward,ltpr=Forward}=Rec} -> + merge_edges(forward, Edge, Rec, We0); + {value,Rec} -> + try dissolve_edge_1(Edge, Rec, We0) of + We -> We + catch + throw:hole -> We0 + end + end. + +%% dissolve_edge_1(Edge, EdgeRecord, We) -> We +%% Remove an edge and a face. If one of the faces is degenerated +%% (only consists of two edges), remove that one. Otherwise, it +%% doesn't matter which face we remove. +dissolve_edge_1(Edge, #edge{lf=Remove,rf=Keep,ltpr=Same,ltsu=Same}=Rec, We) -> + dissolve_edge_2(Edge, Remove, Keep, Rec, We); +dissolve_edge_1(Edge, #edge{lf=Keep,rf=Remove}=Rec, We) -> + dissolve_edge_2(Edge, Remove, Keep, Rec, We). + +dissolve_edge_2(Edge, FaceRemove, FaceKeep, + #edge{ltpr=LP,ltsu=LS,rtpr=RP,rtsu=RS}, + #we{fs=Ftab0,es=Etab0,he=Htab0}=We0) -> + %% First change face for all edges surrounding the face we will remove. + Etab1 = wings_face:fold( + fun (_, E, _, IntEtab) when E =:= Edge -> IntEtab; + (_, E, R, IntEtab) -> + case R of + #edge{lf=FaceRemove,rf=FaceKeep} -> + throw(hole); + #edge{rf=FaceRemove,lf=FaceKeep} -> + throw(hole); + #edge{lf=FaceRemove} -> + gb_trees:update(E, R#edge{lf=FaceKeep}, IntEtab); + #edge{rf=FaceRemove} -> + gb_trees:update(E, R#edge{rf=FaceKeep}, IntEtab) + end + end, Etab0, FaceRemove, We0), + + %% Patch all predecessors and successor of the edge we will remove. + Etab2 = patch_edge(LP, RS, Edge, Etab1), + Etab3 = patch_edge(LS, RP, Edge, Etab2), + Etab4 = patch_edge(RP, LS, Edge, Etab3), + Etab5 = patch_edge(RS, LP, Edge, Etab4), + + %% Remove the edge. + Etab = gb_trees:delete(Edge, Etab5), + Htab = hardness(Edge, soft, Htab0), + + %% Remove the face. Patch the face entry for the remaining face. + Ftab1 = gb_trees:delete(FaceRemove, Ftab0), + We1 = wings_facemat:delete_face(FaceRemove, We0), + Ftab = gb_trees:update(FaceKeep, LP, Ftab1), + + %% Return result. + We = We1#we{es=Etab,fs=Ftab,vc=undefined,he=Htab}, + AnEdge = gb_trees:get(FaceKeep, Ftab), + case gb_trees:get(AnEdge, Etab) of + #edge{lf=FaceKeep,ltpr=Same,ltsu=Same} -> + internal_dissolve_edge(AnEdge, We); + #edge{rf=FaceKeep,rtpr=Same,rtsu=Same} -> + internal_dissolve_edge(AnEdge, We); + _Other -> + case wings_we:is_face_consistent(FaceKeep, We) of + true -> + We; + false -> + io:format("Dissolving would cause a badly formed face.") + end + end. + +%% +%% We like winged edges, but not winged vertices (a vertex with +%% only two edges connected to it). We will remove the winged vertex +%% by joining the two edges connected to it. +%% + +merge_edges(Dir, Edge, Rec, #we{es=Etab}=We) -> + {Va,Vb,_,_,_,_,To,To} = half_edge(Dir, Rec), + case gb_trees:get(To, Etab) of + #edge{vs=Va,ve=Vb} -> + del_2edge_face(Dir, Edge, Rec, To, We); + #edge{vs=Vb,ve=Va} -> + del_2edge_face(Dir, Edge, Rec, To, We); + _Other -> + merge_1(Dir, Edge, Rec, To, We) + end. + +merge_1(Dir, Edge, Rec, To, #we{es=Etab0,fs=Ftab0,he=Htab0}=We) -> + OtherDir = reverse_dir(Dir), + {Vkeep,Vdelete,Lf,Rf,A,B,L,R} = half_edge(OtherDir, Rec), + Etab1 = patch_edge(L, To, Edge, Etab0), + Etab2 = patch_edge(R, To, Edge, Etab1), + Etab3 = patch_half_edge(To, Vkeep, Lf, A, L, Rf, B, R, Vdelete, Etab2), + Htab = hardness(Edge, soft, Htab0), + Etab = gb_trees:delete(Edge, Etab3), + #edge{lf=Lf,rf=Rf} = Rec, + Ftab1 = update_face(Lf, To, Edge, Ftab0), + Ftab = update_face(Rf, To, Edge, Ftab1), + merge_2(To, We#we{es=Etab,fs=Ftab,he=Htab,vc=undefined}). + +merge_2(Edge, #we{es=Etab}=We) -> + %% If the merged edge is part of a two-edge face, we must + %% remove that edge too. + case gb_trees:get(Edge, Etab) of + #edge{ltpr=Same,ltsu=Same} -> + internal_dissolve_edge(Edge, We); + #edge{rtpr=Same,rtsu=Same} -> + internal_dissolve_edge(Edge, We); + _Other -> We + end. + +update_face(Face, Edge, OldEdge, Ftab) -> + case gb_trees:get(Face, Ftab) of + OldEdge -> gb_trees:update(Face, Edge, Ftab); + _Other -> Ftab + end. + +del_2edge_face(Dir, EdgeA, RecA, EdgeB, + #we{es=Etab0,fs=Ftab0,he=Htab0}=We) -> + {_,_,Lf,Rf,_,_,_,_} = half_edge(reverse_dir(Dir), RecA), + RecB = gb_trees:get(EdgeB, Etab0), + Del = gb_sets:from_list([EdgeA,EdgeB]), + EdgeANear = stabile_neighbor(RecA, Del), + EdgeBNear = stabile_neighbor(RecB, Del), + Etab1 = patch_edge(EdgeANear, EdgeBNear, EdgeA, Etab0), + Etab2 = patch_edge(EdgeBNear, EdgeANear, EdgeB, Etab1), + Etab3 = gb_trees:delete(EdgeA, Etab2), + Etab = gb_trees:delete(EdgeB, Etab3), + + %% Patch hardness table. + Htab1 = hardness(EdgeA, soft, Htab0), + Htab = hardness(EdgeB, soft, Htab1), + + %% Patch the face table. + #edge{lf=Klf,rf=Krf} = gb_trees:get(EdgeANear, Etab), + KeepFaces = ordsets:from_list([Klf,Krf]), + EdgeAFaces = ordsets:from_list([Lf,Rf]), + [DelFace] = ordsets:subtract(EdgeAFaces, KeepFaces), + Ftab1 = gb_trees:delete(DelFace, Ftab0), + [KeepFace] = ordsets:intersection(KeepFaces, EdgeAFaces), + Ftab2 = update_face(KeepFace, EdgeANear, EdgeA, Ftab1), + Ftab = update_face(KeepFace, EdgeBNear, EdgeB, Ftab2), + + %% Return result. + We#we{vc=undefined,es=Etab,fs=Ftab,he=Htab}. + +stabile_neighbor(#edge{ltpr=Ea,ltsu=Eb,rtpr=Ec,rtsu=Ed}, Del) -> + [Edge] = lists:foldl(fun(E, A) -> + case gb_sets:is_member(E, Del) of + true -> A; + false -> [E|A] + end + end, [], [Ea,Eb,Ec,Ed]), + Edge. + +%%% +%%% Setting hard/soft edges. +%%% + +hardness(Edge, soft, Htab) -> gb_sets:delete_any(Edge, Htab); +hardness(Edge, hard, Htab) -> gb_sets:add(Edge, Htab). + +%%% +%%% Utilities. +%%% + +reverse_dir(forward) -> backward; +reverse_dir(backward) -> forward. + +half_edge(backward, #edge{vs=Va,ve=Vb,lf=Lf,rf=Rf,a=A,b=B,ltsu=L,rtpr=R}) -> + {Va,Vb,Lf,Rf,A,B,L,R}; +half_edge(forward, #edge{ve=Va,vs=Vb,lf=Lf,rf=Rf,a=A,b=B,ltpr=L,rtsu=R}) -> + {Va,Vb,Lf,Rf,A,B,L,R}. + +patch_half_edge(Edge, V, FaceA, A, Ea, FaceB, B, Eb, OrigV, Etab) -> + New = case gb_trees:get(Edge, Etab) of + #edge{vs=OrigV,lf=FaceA,rf=FaceB}=Rec -> + Rec#edge{a=A,vs=V,ltsu=Ea,rtpr=Eb}; + #edge{vs=OrigV,lf=FaceB,rf=FaceA}=Rec -> + Rec#edge{a=B,vs=V,ltsu=Eb,rtpr=Ea}; + #edge{ve=OrigV,lf=FaceA,rf=FaceB}=Rec -> + Rec#edge{b=B,ve=V,ltpr=Ea,rtsu=Eb}; + #edge{ve=OrigV,lf=FaceB,rf=FaceA}=Rec -> + Rec#edge{b=A,ve=V,ltpr=Eb,rtsu=Ea} + end, + gb_trees:update(Edge, New, Etab). + +patch_edge(Edge, ToEdge, OrigEdge, Etab) -> + New = case gb_trees:get(Edge, Etab) of + #edge{ltsu=OrigEdge}=R -> + R#edge{ltsu=ToEdge}; + #edge{ltpr=OrigEdge}=R -> + R#edge{ltpr=ToEdge}; + #edge{rtsu=OrigEdge}=R -> + R#edge{rtsu=ToEdge}; + #edge{rtpr=OrigEdge}=R -> + R#edge{rtpr=ToEdge} + end, + gb_trees:update(Edge, New, Etab). diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/wings/wings_edge_cmd.erl b/lib/dialyzer/test/opaque_SUITE_data/src/wings/wings_edge_cmd.erl new file mode 100644 index 0000000000..91fa5b2a39 --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/wings/wings_edge_cmd.erl @@ -0,0 +1,90 @@ +%% +%% wings_edge.erl -- +%% +%% This module contains most edge command and edge utility functions. +%% + +-module(wings_edge_cmd). + +-export([loop_cut/1]). + +-include("wings.hrl"). + +%%% +%%% The Loop Cut command. +%%% + +loop_cut(St0) -> + {Sel,St} = wings_sel:fold(fun loop_cut/3, {[],St0}, St0), + wings_sel:set(body, Sel, St). + +loop_cut(Edges, #we{name=Name,id=Id,fs=Ftab}=We0, {Sel,St0}) -> + AdjFaces = wings_face:from_edges(Edges, We0), + case loop_cut_partition(AdjFaces, Edges, We0, []) of + [_] -> + io:format("Edge loop doesn't divide ~p into two parts.", [Name]); + Parts0 -> + %% We arbitrarily decide that the largest part of the object + %% will be left unselected and will keep the name of the object. + + Parts1 = [{gb_trees:size(P),P} || P <- Parts0], + Parts2 = lists:reverse(lists:sort(Parts1)), + [_|Parts] = [gb_sets:to_list(P) || {_,P} <- Parts2], + + %% Also, this first part will also contain any sub-object + %% that was not reachable from any of the edges. Therefore, + %% we calculate the first part as the complement of the union + %% of all other parts. + + FirstComplement = ordsets:union(Parts), + First = ordsets:subtract(gb_trees:keys(Ftab), FirstComplement), + + We = wings_dissolve:complement(First, We0), + Shs = St0#st.shapes, + St = St0#st{shapes=gb_trees:update(Id, We, Shs)}, + loop_cut_make_copies(Parts, We0, Sel, St) + end. + +loop_cut_make_copies([P|Parts], We0, Sel0, #st{onext=Id}=St0) -> + Sel = [{Id,gb_sets:singleton(0)}|Sel0], + We = wings_dissolve:complement(P, We0), + St = wings_shape:insert(We, cut, St0), + loop_cut_make_copies(Parts, We0, Sel, St); +loop_cut_make_copies([], _, Sel, St) -> {Sel,St}. + +loop_cut_partition(Faces0, Edges, We, Acc) -> + case gb_sets:is_empty(Faces0) of + true -> Acc; + false -> + {AFace,Faces1} = gb_sets:take_smallest(Faces0), + Reachable = collect_faces(AFace, Edges, We), + Faces = gb_sets:difference(Faces1, Reachable), + loop_cut_partition(Faces, Edges, We, [Reachable|Acc]) + end. + +collect_faces(Face, Edges, We) -> + collect_faces(gb_sets:singleton(Face), We, Edges, gb_sets:empty()). + +collect_faces(Work0, We, Edges, Acc0) -> + case gb_sets:is_empty(Work0) of + true -> Acc0; + false -> + {Face,Work1} = gb_sets:take_smallest(Work0), + Acc = gb_sets:insert(Face, Acc0), + Work = collect_maybe_add(Work1, Face, Edges, We, Acc), + collect_faces(Work, We, Edges, Acc) + end. + +collect_maybe_add(Work, Face, Edges, We, Res) -> + wings_face:fold( + fun(_, Edge, Rec, A) -> + case gb_sets:is_member(Edge, Edges) of + true -> A; + false -> + Of = wings_face:other(Face, Rec), + case gb_sets:is_member(Of, Res) of + true -> A; + false -> gb_sets:add(Of, A) + end + end + end, Work, Face, We). diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/wings/wings_face.erl b/lib/dialyzer/test/opaque_SUITE_data/src/wings/wings_face.erl new file mode 100644 index 0000000000..487c05aa58 --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/wings/wings_face.erl @@ -0,0 +1,127 @@ +%% +%% wings_face.erl -- +%% +%% This module contains help routines for faces, such as fold functions +%% face iterators. +%% + +-module(wings_face). + +-export([delete_bad_faces/2, fold/4, fold_faces/4, from_edges/2, + inner_edges/2, to_edges/2, other/2]). + +-include("wings.hrl"). + +from_edges(Es, #we{es=Etab}) when is_list(Es) -> + from_edges_1(Es, Etab, []); +from_edges(Es, We) -> + from_edges(gb_sets:to_list(Es), We). + +from_edges_1([E|Es], Etab, Acc) -> + #edge{lf=Lf,rf=Rf} = gb_trees:get(E, Etab), + from_edges_1(Es, Etab, [Lf,Rf|Acc]); +from_edges_1([], _, Acc) -> gb_sets:from_list(Acc). + +%% other(Face, EdgeRecord) -> OtherFace +%% Pick up the "other face" from an edge record. +other(Face, #edge{lf=Face,rf=Other}) -> Other; +other(Face, #edge{rf=Face,lf=Other}) -> Other. + +%% to_edges(Faces, We) -> [Edge] +%% Convert a set or list of faces to a list of edges. +to_edges(Fs, We) -> + ordsets:from_list(to_edges_raw(Fs, We)). + +%% inner_edges(Faces, We) -> [Edge] +%% Given a set of faces, return all inner edges. +inner_edges(Faces, We) -> + S = to_edges_raw(Faces, We), + inner_edges_1(lists:sort(S), []). + +inner_edges_1([E,E|T], In) -> + inner_edges_1(T, [E|In]); +inner_edges_1([_|T], In) -> + inner_edges_1(T, In); +inner_edges_1([], In) -> lists:reverse(In). + +%% Fold over all edges surrounding a face. + +fold(F, Acc, Face, #we{es=Etab,fs=Ftab}) -> + Edge = gb_trees:get(Face, Ftab), + fold(Edge, Etab, F, Acc, Face, Edge, not_done). + +fold(LastEdge, _, _, Acc, _, LastEdge, done) -> Acc; +fold(Edge, Etab, F, Acc0, Face, LastEdge, _) -> + case gb_trees:get(Edge, Etab) of + #edge{ve=V,lf=Face,ltsu=NextEdge}=E -> + Acc = F(V, Edge, E, Acc0), + fold(NextEdge, Etab, F, Acc, Face, LastEdge, done); + #edge{vs=V,rf=Face,rtsu=NextEdge}=E -> + Acc = F(V, Edge, E, Acc0), + fold(NextEdge, Etab, F, Acc, Face, LastEdge, done) + end. + +%% Fold over a set of faces. + +fold_faces(F, Acc0, [Face|Faces], #we{es=Etab,fs=Ftab}=We) -> + Edge = gb_trees:get(Face, Ftab), + Acc = fold_faces_1(Edge, Etab, F, Acc0, Face, Edge, not_done), + fold_faces(F, Acc, Faces, We); +fold_faces(_F, Acc, [], _We) -> Acc; +fold_faces(F, Acc, Faces, We) -> + fold_faces(F, Acc, gb_sets:to_list(Faces), We). + +fold_faces_1(LastEdge, _, _, Acc, _, LastEdge, done) -> Acc; +fold_faces_1(Edge, Etab, F, Acc0, Face, LastEdge, _) -> + case gb_trees:get(Edge, Etab) of + #edge{ve=V,lf=Face,ltsu=NextEdge}=E -> + Acc = F(Face, V, Edge, E, Acc0), + fold_faces_1(NextEdge, Etab, F, Acc, Face, LastEdge, done); + #edge{vs=V,rf=Face,rtsu=NextEdge}=E -> + Acc = F(Face, V, Edge, E, Acc0), + fold_faces_1(NextEdge, Etab, F, Acc, Face, LastEdge, done) + end. + +%% Return an unsorted list of edges for the faces (with duplicates). + +to_edges_raw(Faces, #we{es=Etab,fs=Ftab}) when is_list(Faces) -> + to_edges_raw(Faces, Ftab, Etab, []); +to_edges_raw(Faces, We) -> + to_edges_raw(gb_sets:to_list(Faces), We). + +to_edges_raw([Face|Faces], Ftab, Etab, Acc0) -> + Edge = gb_trees:get(Face, Ftab), + Acc = to_edges_raw_1(Edge, Etab, Acc0, Face, Edge, not_done), + to_edges_raw(Faces, Ftab, Etab, Acc); +to_edges_raw([], _, _, Acc) -> Acc. + +to_edges_raw_1(LastEdge, _, Acc, _, LastEdge, done) -> Acc; +to_edges_raw_1(Edge, Etab, Acc, Face, LastEdge, _) -> + case gb_trees:get(Edge, Etab) of + #edge{lf=Face,ltsu=NextEdge} -> + to_edges_raw_1(NextEdge, Etab, [Edge|Acc], Face, LastEdge, done); + #edge{rf=Face,rtsu=NextEdge} -> + to_edges_raw_1(NextEdge, Etab, [Edge|Acc], Face, LastEdge, done) + end. + +delete_bad_faces(Fs, #we{fs=Ftab,es=Etab}=We) when is_list(Fs) -> + Es = bad_edges(Fs, Ftab, Etab, []), + wings_edge:dissolve_edges(Es, We); +delete_bad_faces(Fs, We) -> + delete_bad_faces(gb_sets:to_list(Fs), We). + +bad_edges([F|Fs], Ftab, Etab, Acc) -> + case gb_trees:lookup(F, Ftab) of + {value,Edge} -> + case gb_trees:get(Edge, Etab) of + #edge{ltpr=Same,ltsu=Same,rtpr=Same,rtsu=Same} -> + erlang:error({internal_error,one_edged_face,F}); + #edge{ltpr=Same,ltsu=Same} -> + bad_edges(Fs, Ftab, Etab, [Edge|Acc]); + #edge{rtpr=Same,rtsu=Same} -> + bad_edges(Fs, Ftab, Etab, [Edge|Acc]); + _ -> bad_edges(Fs, Ftab, Etab, Acc) + end; + none -> bad_edges(Fs, Ftab, Etab, Acc) + end; +bad_edges([], _, _, Acc) -> Acc. diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/wings/wings_facemat.erl b/lib/dialyzer/test/opaque_SUITE_data/src/wings/wings_facemat.erl new file mode 100644 index 0000000000..a3fa5e3508 --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/wings/wings_facemat.erl @@ -0,0 +1,299 @@ +%% +%% wings_facemat.erl -- +%% +%% This module keeps tracks of the mapping from a face number +%% to its material name. +%% +%% Copyright (c) 2001-2005 Bjorn Gustavsson +%% +%% See the file "license.terms" for information on usage and redistribution +%% of this file, and for a DISCLAIMER OF ALL WARRANTIES. +%% +%% $Id: wings_facemat.erl,v 1.1 2009/01/25 18:55:33 kostis Exp $ +%% +%% +%% + +-module(wings_facemat). +-export([all/1,face/2,used_materials/1,mat_faces/2, + assign/2,assign/3, + delete_face/2,delete_faces/2,keep_faces/2, + hide_faces/1,show_faces/1, + renumber/2,gc/1,merge/1]). + +-include("wings.hrl"). +-import(lists, [keysearch/3,reverse/1,reverse/2,sort/1]). + +%%% +%%% API functions for retrieving information. +%%% + +%% all(We) -> [{Face,MaterialName}] +%% Return materials for all faces as an ordered list. +all(#we{mat=M}=We) when is_atom(M) -> + Vis = visible_faces(We), + make_tab(Vis, M); +all(#we{mat=L}) when is_list(L) -> + remove_invisible(L). + +%% face(Face, We) -> MaterialName +%% Return the material for the face Face. +face(_, #we{mat=M}) when is_atom(M) -> M; +face(Face, #we{mat=Tab}) -> + {value,{_,Mat}} = keysearch(Face, 1, Tab), + Mat. + +%% used_materials(We) -> [MaterialName] +%% Return an ordered list of all materials used in the We. +used_materials(#we{mat=M}) when is_atom(M) -> [M]; +used_materials(#we{mat=L}) when is_list(L) -> + used_materials_1(L, []). + +%% mat_faces([{Face,Info}], We) -> [{Mat,[{Face,Info}]}] +%% Group face tab into groups based on material. +%% Used for displaying objects. +mat_faces(Ftab, #we{mat=AtomMat}) when is_atom(AtomMat) -> + [{AtomMat,Ftab}]; +mat_faces(Ftab, #we{mat=MatTab}) -> + mat_faces_1(Ftab, remove_invisible(MatTab), []). + +%%% +%%% API functions for updating material name mapping. +%%% + +%% assign([{Face,MaterialName}], We) -> We' +%% Assign materials. +assign([], We) -> We; +assign([{F,M}|_]=FaceMs, We) when is_atom(M), is_integer(F) -> + Tab = ordsets:from_list(FaceMs), + assign_face_ms(Tab, We). + +%% assign(MaterialName, Faces, We) -> We' +%% Assign MaterialName to all faces Faces. +assign(Mat, _, #we{mat=Mat}=We) when is_atom(Mat) -> We; +assign(Mat, Fs, We) when is_atom(Mat), is_list(Fs) -> + assign_1(Mat, Fs, We); +assign(Mat, Fs, We) when is_atom(Mat) -> + assign_1(Mat, gb_sets:to_list(Fs), We). + +%% delete_face(Face, We) -> We' +%% Delete the material name mapping for the face Face. +delete_face(_, #we{mat=AtomMat}=We) when is_atom(AtomMat) -> We; +delete_face(Face, #we{mat=MatTab0}=We) -> + MatTab = orddict:erase(Face, MatTab0), + We#we{mat=MatTab}. + +%% delete_face(Faces, We) -> We' +%% Delete the material name mapping for all faces Faces. +delete_faces(_, #we{mat=AtomMat}=We) when is_atom(AtomMat) -> We; +delete_faces(Faces0, #we{mat=MatTab0}=We) when is_list(Faces0) -> + Faces = sofs:from_external(Faces0, [face]), + MatTab1 = sofs:from_external(MatTab0, [{face,mat}]), + MatTab2 = sofs:drestriction(MatTab1, Faces), + MatTab = sofs:to_external(MatTab2), + We#we{mat=MatTab}; +delete_faces(Faces, We) -> + delete_faces(gb_sets:to_list(Faces), We). + +%% keep_faces(Faces, We) -> We' +%% Delete all the other material names mapping for all faces other Faces. +keep_faces(_, #we{mat=AtomMat}=We) when is_atom(AtomMat) -> We; +keep_faces([Face], We) -> + Mat = face(Face,We), + We#we{mat=[{Face,Mat}]}; +keep_faces(Faces0, #we{mat=MatTab0}=We) when is_list(Faces0) -> + Faces = sofs:from_external(Faces0, [face]), + MatTab1 = sofs:from_external(MatTab0, [{face,mat}]), + MatTab2 = sofs:restriction(MatTab1, Faces), + MatTab = sofs:to_external(MatTab2), + We#we{mat=MatTab}; +keep_faces(Faces, We) -> + keep_faces(gb_sets:to_list(Faces), We). + +%% hide_faces(We) -> We' +%% Update the material name mapping in the We to reflect +%% the newly hidden faces in the face tab. +hide_faces(#we{mat=M}=We) when is_atom(M) -> We; +hide_faces(#we{mat=L0,fs=Ftab}=We) -> + L = hide_faces_1(L0, Ftab, []), + We#we{mat=L}. + +%% show_faces(We) -> We' +%% Update the material name mapping in the We to reflect +%% that all faces are again visible. +show_faces(#we{mat=M}=We) when is_atom(M) -> We; +show_faces(#we{mat=L0}=We) -> + L = show_faces_1(L0, []), + We#we{mat=L}. + +%% renumber(MaterialMapping, FaceOldToNew) -> MaterialMapping. +%% Renumber face number in material name mapping. +renumber(Mat, _) when is_atom(Mat) -> Mat; +renumber(L, Fmap) when is_list(L) -> renumber_1(L, Fmap, []). + +%% gc(We) -> We' +%% Garbage collect the material mapping information, removing +%% the mapping for any face no longer present in the face table. +gc(#we{mat=Mat}=We) when is_atom(Mat) -> We; +gc(#we{mat=Tab0,fs=Ftab}=We) -> + Fs = sofs:from_external(gb_trees:keys(Ftab), [face]), + Tab1 = sofs:from_external(Tab0, [{face,material}]), + Tab2 = sofs:restriction(Tab1, Fs), + Tab = sofs:to_external(Tab2), + We#we{mat=compress(Tab)}. + +%% merge([We]) -> [{Face,MaterialName}] | MaterialName. +%% Merge materials for several objects. +merge([#we{mat=M}|Wes]=L) when is_atom(M) -> + case merge_all_same(Wes, M) of + true -> M; + false -> merge_1(L, []) + end; +merge(L) -> merge_1(L, []). + +merge_1([#we{mat=M,es=Etab}|T], Acc) when is_atom(M) -> + FsM = merge_2(gb_trees:values(Etab), M, []), + merge_1(T, [FsM|Acc]); +merge_1([#we{mat=FsMs}|T], Acc) -> + merge_1(T, [FsMs|Acc]); +merge_1([], Acc) -> lists:merge(Acc). + +merge_2([#edge{lf=Lf,rf=Rf}|T], M, Acc) -> + merge_2(T, M, [{Lf,M},{Rf,M}|Acc]); +merge_2([], _, Acc) -> ordsets:from_list(Acc). + +merge_all_same([#we{mat=M}|Wes], M) -> merge_all_same(Wes, M); +merge_all_same([_|_], _) -> false; +merge_all_same([], _) -> true. + +%%% +%%% Local functions. +%%% + +assign_1(Mat, Fs, #we{fs=Ftab}=We) -> + case length(Fs) =:= gb_trees:size(Ftab) of + true -> We#we{mat=Mat}; + false -> assign_2(Mat, Fs, We) + end. + +assign_2(Mat, Fs0, #we{fs=Ftab,mat=Mat0}=We) when is_atom(Mat0) -> + Fs = ordsets:from_list(Fs0), + OtherFaces = ordsets:subtract(gb_trees:keys(Ftab), Fs), + Tab0 = make_tab(OtherFaces, Mat0), + Tab1 = make_tab(Fs, Mat), + Tab = lists:merge(Tab0, Tab1), + We#we{mat=Tab}; +assign_2(Mat, Fs0, #we{mat=Tab0}=We) when is_list(Tab0) -> + Fs = ordsets:from_list(Fs0), + Tab1 = make_tab(Fs, Mat), + Tab = mat_merge(Tab1, Tab0, []), + We#we{mat=Tab}. + +assign_face_ms(Tab, #we{fs=Ftab}=We) -> + case length(Tab) =:= gb_trees:size(Ftab) of + true -> We#we{mat=compress(Tab)}; + false -> assign_face_ms_1(Tab, We) + end. + +assign_face_ms_1(Tab1, #we{fs=Ftab,mat=Mat0}=We) when is_atom(Mat0) -> + Tab0 = make_tab(gb_trees:keys(Ftab), Mat0), + Tab = mat_merge(Tab1, Tab0, []), + We#we{mat=Tab}; +assign_face_ms_1(Tab1, #we{mat=Tab0}=We) when is_list(Tab0) -> + Tab = mat_merge(Tab1, Tab0, []), + We#we{mat=Tab}. + +mat_merge([{Fn,_}|_]=Fns, [{Fo,_}=Fold|Fos], Acc) when Fo < Fn -> + mat_merge(Fns, Fos, [Fold|Acc]); +mat_merge([{Fn,_}=Fnew|Fns], [{Fo,_}|_]=Fos, Acc) when Fo > Fn -> + mat_merge(Fns, Fos, [Fnew|Acc]); +mat_merge([Fnew|Fns], [_|Fos], Acc) -> % Equality + mat_merge(Fns, Fos, [Fnew|Acc]); +mat_merge([], Fos, Acc) -> + rev_compress(Acc, Fos); +mat_merge(Fns, [], Acc) -> + rev_compress(Acc, Fns). + +make_tab(Fs, M) -> + make_tab_1(Fs, M, []). + +make_tab_1([F|Fs], M, Acc) -> + make_tab_1(Fs, M, [{F,M}|Acc]); +make_tab_1([], _, Acc) -> reverse(Acc). + + +visible_faces(#we{fs=Ftab}) -> + visible_faces_1(gb_trees:keys(Ftab)). + +visible_faces_1([F|Fs]) when F < 0 -> + visible_faces_1(Fs); +visible_faces_1(Fs) -> Fs. + +remove_invisible([{F,_}|Fs]) when F < 0 -> + remove_invisible(Fs); +remove_invisible(Fs) -> Fs. + +hide_faces_1([{F,_}=P|Fms], Ftab, Acc) when F < 0 -> + hide_faces_1(Fms, Ftab, [P|Acc]); +hide_faces_1([{F,M}=P|Fms], Ftab, Acc) -> + case gb_trees:is_defined(F, Ftab) of + false -> hide_faces_1(Fms, Ftab, [{-F-1,M}|Acc]); + true -> hide_faces_1(Fms, Ftab, [P|Acc]) + end; +hide_faces_1([], _, Acc) -> sort(Acc). + +show_faces_1([{F,M}|Fms], Acc) when F < 0 -> + show_faces_1(Fms, [{-F-1,M}|Acc]); +show_faces_1(Fs, Acc) -> sort(Acc++Fs). + +renumber_1([{F,M}|T], Fmap, Acc) -> + renumber_1(T, Fmap, [{gb_trees:get(F, Fmap),M}|Acc]); +renumber_1([], _, Acc) -> sort(Acc). + +%% rev_compress([{Face,Mat}], [{Face,Mat}]) -> [{Face,Mat}] | Mat. +%% Reverse just like lists:reverse/2, but if all materials +%% turns out to be just the same, return that material. +rev_compress(L, Acc) -> + case same_mat(Acc) of + [] -> reverse(L, Acc); + M -> rev_compress_1(L, M, Acc) + end. + +rev_compress_1([{_,M}=E|T], M, Acc) -> + %% Same material. + rev_compress_1(T, M, [E|Acc]); +rev_compress_1([_|_]=L, _, Acc) -> + %% Another material. Finish by using reverse/2. + reverse(L, Acc); +rev_compress_1([], M, _) -> + %% All materials turned out to be the same. + M. + +%% compress(MaterialTab) -> [{Face,Mat}] | Mat. +%% Compress a face mapping if possible. +compress(M) when is_atom(M) -> M; +compress(L) when is_list(L) -> + case same_mat(L) of + [] -> L; + M -> M + end. + +same_mat([]) -> []; +same_mat([{_,M}|T]) -> same_mat_1(T, M). + +same_mat_1([{_,M}|T], M) -> same_mat_1(T, M); +same_mat_1([], M) -> M; +same_mat_1(_, _) -> []. + +used_materials_1([{_,M}|T], [M|_]=Acc) -> + used_materials_1(T, Acc); +used_materials_1([{_,M}|T], Acc) -> + used_materials_1(T, [M|Acc]); +used_materials_1([], Acc) -> + ordsets:from_list(Acc). + +mat_faces_1([{F1,_}|_]=Fs, [{F2,_}|Ms], Acc) when F2 < F1 -> + mat_faces_1(Fs, Ms, Acc); +mat_faces_1([{F,Info}|Fs], [{F,Mat}|Ms], Acc) -> + mat_faces_1(Fs, Ms, [{Mat,{F,Info}}|Acc]); +mat_faces_1([], _, Acc) -> wings_util:rel2fam(Acc). diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/wings/wings_intl.hrl b/lib/dialyzer/test/opaque_SUITE_data/src/wings/wings_intl.hrl new file mode 100644 index 0000000000..ebcb560f27 --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/wings/wings_intl.hrl @@ -0,0 +1,15 @@ +%% +%% wings_intl.hrl -- +%% +%% Defines for translations +%% +%% Copyright (c) 2001-2005 Bjorn Gustavsson +%% +%% See the file "license.terms" for information on usage and redistribution +%% of this file, and for a DISCLAIMER OF ALL WARRANTIES. +%% +%% $Id: wings_intl.hrl,v 1.1 2009/01/25 18:55:33 kostis Exp $ +%% + +-define(STR(A,B,Str), wings_lang:str({?MODULE,A,B},Str)). +-define(__(Key,Str), wings_lang:str({?MODULE,Key},Str)). diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/wings/wings_io.erl b/lib/dialyzer/test/opaque_SUITE_data/src/wings/wings_io.erl new file mode 100644 index 0000000000..39002c675d --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/wings/wings_io.erl @@ -0,0 +1,37 @@ +%% +%% wings_io.erl -- +%% +%% This module contains most of the low-level GUI for Wings. +%% + +-module(wings_io). + +-export([get_matching_events/1]). + +-define(EVENT_QUEUE, wings_io_event_queue). + +%%% +%%% Input. +%%% + +get_matching_events(Filter) -> + Eq = get(?EVENT_QUEUE), + get_matching_events_1(Filter, Eq, [], []). + +get_matching_events_1(Filter, Eq0, Match, NoMatch) -> + case queue:out(Eq0) of + {{value,Ev},Eq} -> + case Filter(Ev) of + false -> + get_matching_events_1(Filter, Eq, Match, [Ev|NoMatch]); + true -> + get_matching_events_1(Filter, Eq, [Ev|Match], NoMatch) + end; + {empty,{In,Out}} -> + case Match of + [] -> []; + _ -> + put(?EVENT_QUEUE, {In, lists:reverse(NoMatch, Out)}), + Match + end + end. diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/wings/wings_sel.erl b/lib/dialyzer/test/opaque_SUITE_data/src/wings/wings_sel.erl new file mode 100644 index 0000000000..eef797027e --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/wings/wings_sel.erl @@ -0,0 +1,68 @@ +%% +%% wings_sel.erl -- +%% +%% This module implements selection utilities. +%% + +-module(wings_sel). + +-export([face_regions/2, fold/3, set/3]). + +-include("wings.hrl"). + +set(Mode, Sel, St) -> + St#st{selmode=Mode, sel=lists:sort(Sel), sh=false}. + +%%% +%%% Fold over the selection. +%%% + +fold(F, Acc, #st{sel=Sel,shapes=Shapes}) -> + fold_1(F, Acc, Shapes, Sel). + +fold_1(F, Acc0, Shapes, [{Id,Items}|T]) -> + We = gb_trees:get(Id, Shapes), + ?ASSERT(We#we.id =:= Id), + fold_1(F, F(Items, We, Acc0), Shapes, T); +fold_1(_F, Acc, _Shapes, []) -> Acc. + +%%% +%%% Divide the face selection into regions where each face shares at least +%%% one edge with another face in the same region. Two faces can share a +%%% vertex without necessarily being in the same region. +%%% + +face_regions(Faces, We) when is_list(Faces) -> + face_regions_1(gb_sets:from_list(Faces), We); +face_regions(Faces, We) -> + face_regions_1(Faces, We). + +face_regions_1(Faces, We) -> + find_face_regions(Faces, We, fun collect_face_fun/5, []). + +find_face_regions(Faces0, We, Coll, Acc) -> + case gb_sets:is_empty(Faces0) of + true -> Acc; + false -> + {Face,Faces1} = gb_sets:take_smallest(Faces0), + Ws = [Face], + {Reg,Faces} = collect_face_region(Ws, We, Coll, [], Faces1), + find_face_regions(Faces, We, Coll, [Reg|Acc]) + end. + +collect_face_region([_|_]=Ws0, We, Coll, Reg0, Faces0) -> + Reg = Ws0++Reg0, + {Ws,Faces} = wings_face:fold_faces(Coll, {[],Faces0}, Ws0, We), + collect_face_region(Ws, We, Coll, Reg, Faces); +collect_face_region([], _, _, Reg, Faces) -> + {gb_sets:from_list(Reg),Faces}. + +collect_face_fun(Face, _, _, Rec, {Ws,Faces}=A) -> + Of = case Rec of + #edge{lf=Face,rf=Of0} -> Of0; + #edge{rf=Face,lf=Of0} -> Of0 + end, + case gb_sets:is_member(Of, Faces) of + true -> {[Of|Ws],gb_sets:delete(Of, Faces)}; + false -> A + end. diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/wings/wings_shape.erl b/lib/dialyzer/test/opaque_SUITE_data/src/wings/wings_shape.erl new file mode 100644 index 0000000000..0df8ca68eb --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/wings/wings_shape.erl @@ -0,0 +1,69 @@ +%% +%% wings_shape.erl -- +%% +%% Utilities for shape records. +%% + +-module(wings_shape). + +-export([insert/3]). + +-include("wings.hrl"). + +%%% +%%% Exported functions. +%%% + +%% new(We, Suffix, St0) -> St. +%% Suffix = cut | clone | copy | extract | sep +%% +%% Create a new object based on an old object. The name +%% will be created from the old name (with digits and known +%% suffixes stripped) with the given Suffix and a number +%% appended. +insert(#we{name=OldName}=We0, Suffix, #st{shapes=Shapes0,onext=Oid}=St) -> + Name = new_name(OldName, Suffix, Oid), + We = We0#we{id=Oid,name=Name}, + Shapes = gb_trees:insert(Oid, We, Shapes0), + St#st{shapes=Shapes,onext=Oid+1}. + +%%% +%%% Local functions follow. +%%% + +new_name(OldName, Suffix0, Id) -> + Suffix = suffix(Suffix0), + Base = base(lists:reverse(OldName)), + lists:reverse(Base, "_" ++ Suffix ++ integer_to_list(Id)). + +%% Note: Filename suffixes are intentionally not translated. +%% If we are to translate them in the future, base/1 below +%% must be updated to strip suffixes (both for the current language +%% and for English). + +suffix(cut) -> "cut"; +suffix(clone) -> "clone"; +suffix(copy) -> "copy"; +suffix(extract) -> "extract"; +suffix(mirror) -> "mirror"; +suffix(sep) -> "sep". + +%% base_1(ReversedName) -> ReversedBaseName +%% Given an object name, strip digits and known suffixes to +%% create a base name. Returns the unchanged name if +%% no known suffix could be stripped. + +base(OldName) -> + case base_1(OldName) of + error -> OldName; + Base -> Base + end. + +base_1([H|T]) when $0 =< H, H =< $9 -> base_1(T); +base_1("tuc_"++Base) -> Base; %"_cut" +base_1("enolc_"++Base) -> Base; %"_clone" +base_1("ypoc_"++Base) -> Base; %"_copy" +base_1("tcartxe_"++Base) -> Base; %"_extract" +base_1("rorrim_"++Base) -> Base; %"_mirror" +base_1("pes_"++Base) -> Base; %"_sep" +base_1(_Base) -> error. diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/wings/wings_util.erl b/lib/dialyzer/test/opaque_SUITE_data/src/wings/wings_util.erl new file mode 100644 index 0000000000..8f0da1f5dc --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/wings/wings_util.erl @@ -0,0 +1,38 @@ +%% +%% wings_util.erl -- +%% +%% Various utility functions that not obviously fit somewhere else. +%% + +-module(wings_util). + +-export([gb_trees_smallest_key/1, gb_trees_largest_key/1, + gb_trees_map/2, rel2fam/1]). + +-include("wings.hrl"). + +rel2fam(Rel) -> + sofs:to_external(sofs:relation_to_family(sofs:relation(Rel))). + +%% a definition that does not violate the opaqueness of gb_tree() +gb_trees_smallest_key(Tree) -> + {Key, _V} = gb_trees:smallest(Tree), + Key. + +%% a definition that violates the opaqueness of gb_tree() +gb_trees_largest_key({_, Tree}) -> + largest_key1(Tree). + +largest_key1({Key, _Value, _Smaller, nil}) -> + Key; +largest_key1({_Key, _Value, _Smaller, Larger}) -> + largest_key1(Larger). + +gb_trees_map(F, {Size,Tree}) -> + {Size,gb_trees_map_1(F, Tree)}. + +gb_trees_map_1(_, nil) -> nil; +gb_trees_map_1(F, {K,V,Smaller,Larger}) -> + {K,F(K, V), + gb_trees_map_1(F, Smaller), + gb_trees_map_1(F, Larger)}. diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/wings/wings_we.erl b/lib/dialyzer/test/opaque_SUITE_data/src/wings/wings_we.erl new file mode 100644 index 0000000000..6a93363445 --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/wings/wings_we.erl @@ -0,0 +1,250 @@ +%% +%% wings_we.erl -- +%% +%% This module contains functions to build and manipulate +%% we records (winged-edged records, the central data structure +%% in Wings 3D). + +-module(wings_we). + +-export([rebuild/1, is_consistent/1, is_face_consistent/2, new_id/1, + new_items_as_ordset/3, validate_mirror/1, visible/1, visible_edges/1]). + +-include("wings.hrl"). + +%%% +%%% API. +%%% + +validate_mirror(#we{mirror=none}=We) -> We; +validate_mirror(#we{fs=Ftab,mirror=Face}=We) -> + case gb_trees:is_defined(Face, Ftab) of + false -> We#we{mirror=none}; + true -> We + end. + +%% rebuild(We) -> We' +%% Rebuild any missing 'vc' and 'fs' tables. If there are +%% fewer elements in the 'vc' table than in the 'vp' table, +%% remove redundant entries in the 'vp' table. Updated id +%% bounds. +rebuild(#we{vc=undefined,fs=undefined,es=Etab0}=We0) -> + Etab = gb_trees:to_list(Etab0), + Ftab = rebuild_ftab(Etab), + VctList = rebuild_vct(Etab), + We = We0#we{vc=gb_trees:from_orddict(VctList),fs=Ftab}, + rebuild_1(VctList, We); +rebuild(#we{vc=undefined,es=Etab}=We) -> + VctList = rebuild_vct(gb_trees:to_list(Etab), []), + rebuild_1(VctList, We#we{vc=gb_trees:from_orddict(VctList)}); +rebuild(#we{fs=undefined,es=Etab}=We) -> + Ftab = rebuild_ftab(gb_trees:to_list(Etab)), + rebuild(We#we{fs=Ftab}); +rebuild(We) -> update_id_bounds(We). + +%%% Utilities for allocating IDs. + +new_id(#we{next_id=Id}=We) -> + {Id,We#we{next_id=Id+1}}. + +%%% Returns sets of newly created items. + +new_items_as_ordset(vertex, #we{next_id=Wid}, #we{next_id=NewWid,vp=Tab}) -> + new_items_as_ordset_1(Tab, Wid, NewWid); +new_items_as_ordset(edge, #we{next_id=Wid}, #we{next_id=NewWid,es=Tab}) -> + new_items_as_ordset_1(Tab, Wid, NewWid); +new_items_as_ordset(face, #we{next_id=Wid}, #we{next_id=NewWid,fs=Tab}) -> + new_items_as_ordset_1(Tab, Wid, NewWid). + +any_hidden(#we{fs=Ftab}) -> + not gb_trees:is_empty(Ftab) andalso + wings_util:gb_trees_smallest_key(Ftab) < 0. + +%%% +%%% Local functions. +%%% + +rebuild_1(VctList, #we{vc=Vct,vp=Vtab0}=We) -> + case {gb_trees:size(Vct),gb_trees:size(Vtab0)} of + {Same,Same} -> rebuild(We); + {Sz1,Sz2} when Sz1 < Sz2 -> + Vtab = vertex_gc_1(VctList, gb_trees:to_list(Vtab0), []), + rebuild(We#we{vp=Vtab}) + end. + +rebuild_vct(Es) -> + rebuild_vct(Es, []). + +rebuild_vct([{Edge,#edge{vs=Va,ve=Vb}}|Es], Acc0) -> + Acc = rebuild_maybe_add(Va, Vb, Edge, Acc0), + rebuild_vct(Es, Acc); +rebuild_vct([], VtoE) -> + build_incident_tab(VtoE). + +rebuild_ftab(Es) -> + rebuild_ftab_1(Es, []). + +rebuild_ftab_1([{Edge,#edge{lf=Lf,rf=Rf}}|Es], Acc0) -> + Acc = rebuild_maybe_add(Lf, Rf, Edge, Acc0), + rebuild_ftab_1(Es, Acc); +rebuild_ftab_1([], FtoE) -> + gb_trees:from_orddict(build_incident_tab(FtoE)). + +rebuild_maybe_add(Ka, Kb, E, [_,{Ka,_}|_]=Acc) -> + [{Kb,E}|Acc]; +rebuild_maybe_add(Ka, Kb, E, [_,{Kb,_}|_]=Acc) -> + [{Ka,E}|Acc]; +rebuild_maybe_add(Ka, Kb, E, [{Ka,_}|_]=Acc) -> + [{Kb,E}|Acc]; +rebuild_maybe_add(Ka, Kb, E, [{Kb,_}|_]=Acc) -> + [{Ka,E}|Acc]; +rebuild_maybe_add(Ka, Kb, E, Acc) -> + [{Ka,E},{Kb,E}|Acc]. + +vertex_gc_1([{V,_}|Vct], [{V,_}=Vtx|Vpos], Acc) -> + vertex_gc_1(Vct, Vpos, [Vtx|Acc]); +vertex_gc_1([_|_]=Vct, [_|Vpos], Acc) -> + vertex_gc_1(Vct, Vpos, Acc); +vertex_gc_1([], _, Acc) -> + gb_trees:from_orddict(lists:reverse(Acc)). + +%%% +%%% Handling of hidden faces. +%%% + +visible(#we{mirror=none,fs=Ftab}) -> + visible_2(gb_trees:keys(Ftab)); +visible(#we{mirror=Face,fs=Ftab}) -> + visible_2(gb_trees:keys(gb_trees:delete(Face, Ftab))). + +visible_2([F|Fs]) when F < 0 -> visible_2(Fs); +visible_2(Fs) -> Fs. + +visible_edges(#we{es=Etab,mirror=Face}=We) -> + case any_hidden(We) of + false -> gb_trees:keys(Etab); + true -> visible_es_1(gb_trees:to_list(Etab), Face, []) + end. + +visible_es_1([{E,#edge{lf=Lf,rf=Rf}}|Es], Face, Acc) -> + if + Lf < 0 -> + %% Left face hidden. + if + Rf < 0; Rf =:= Face -> + %% Both faces invisible (in some way). + visible_es_1(Es, Face, Acc); + true -> + %% Right face is visible. + visible_es_1(Es, Face, [E|Acc]) + end; + Lf =:= Face, Rf < 0 -> + %% Left face mirror, right face hidden. + visible_es_1(Es, Face, Acc); + true -> + %% At least one face visible. + visible_es_1(Es, Face, [E|Acc]) + end; +visible_es_1([], _, Acc) -> ordsets:from_list(Acc). + +update_id_bounds(#we{vp=Vtab,es=Etab,fs=Ftab}=We) -> + case gb_trees:is_empty(Etab) of + true -> We#we{next_id=0}; + false -> + LastId = lists:max([wings_util:gb_trees_largest_key(Vtab), + wings_util:gb_trees_largest_key(Etab), + wings_util:gb_trees_largest_key(Ftab)]), + We#we{next_id=LastId+1} + end. + +%% build_incident_tab([{Elem,Edge}]) -> [{Elem,Edge}] +%% Elem = Face or Vertex +%% Build the table of incident edges for either faces or vertices. +%% Returns an ordered list where each Elem is unique. + +build_incident_tab(ElemToEdgeRel) -> + T = ets:new(?MODULE, [ordered_set]), + ets:insert(T, ElemToEdgeRel), + R = ets:tab2list(T), + ets:delete(T), + R. + +%%% +%%% Calculate normals. +%%% + +new_items_as_ordset_1(Tab, Wid, NewWid) when NewWid-Wid < 32 -> + new_items_as_ordset_2(Wid, NewWid, Tab, []); +new_items_as_ordset_1(Tab, Wid, _NewWid) -> + [Item || Item <- gb_trees:keys(Tab), Item >= Wid]. + +new_items_as_ordset_2(Wid, NewWid, Tab, Acc) when Wid < NewWid -> + case gb_trees:is_defined(Wid, Tab) of + true -> new_items_as_ordset_2(Wid+1, NewWid, Tab, [Wid|Acc]); + false -> new_items_as_ordset_2(Wid+1, NewWid, Tab, Acc) + end; +new_items_as_ordset_2(_Wid, _NewWid, _Tab, Acc) -> lists:reverse(Acc). + +%%% +%%% Test the consistency of a #we{}. +%%% + +is_consistent(#we{}=We) -> + try + validate_vertex_tab(We), + validate_faces(We) + catch error:_ -> false + end. + +is_face_consistent(Face, #we{fs=Ftab,es=Etab}) -> + Edge = gb_trees:get(Face, Ftab), + try validate_face(Face, Edge, Etab) + catch error:_ -> false + end. + +validate_faces(#we{fs=Ftab,es=Etab}) -> + validate_faces_1(gb_trees:to_list(Ftab), Etab). + +validate_faces_1([{Face,Edge}|Fs], Etab) -> + validate_face(Face, Edge, Etab), + validate_faces_1(Fs, Etab); +validate_faces_1([], _) -> true. + +validate_face(Face, Edge, Etab) -> + Ccw = walk_face_ccw(Edge, Etab, Face, Edge, []), + Edge = walk_face_cw(Edge, Etab, Face, Ccw), + [V|Vs] = lists:sort(Ccw), + validate_face_vertices(Vs, V). + +validate_face_vertices([V|_], V) -> + erlang:error(repeated_vertex); +validate_face_vertices([_], _) -> + true; +validate_face_vertices([V|Vs], _) -> + validate_face_vertices(Vs, V). + +walk_face_ccw(LastEdge, _, _, LastEdge, [_|_]=Acc) -> Acc; +walk_face_ccw(Edge, Etab, Face, LastEdge, Acc) -> + case gb_trees:get(Edge, Etab) of + #edge{ve=V,lf=Face,ltpr=Next} -> + walk_face_ccw(Next, Etab, Face, LastEdge, [V|Acc]); + #edge{vs=V,rf=Face,rtpr=Next} -> + walk_face_ccw(Next, Etab, Face, LastEdge, [V|Acc]) + end. + +walk_face_cw(Edge, _, _, []) -> Edge; +walk_face_cw(Edge, Etab, Face, [V|Vs]) -> + case gb_trees:get(Edge, Etab) of + #edge{vs=V,lf=Face,ltsu=Next} -> + walk_face_cw(Next, Etab, Face, Vs); + #edge{ve=V,rf=Face,rtsu=Next} -> + walk_face_cw(Next, Etab, Face, Vs) + end. + +validate_vertex_tab(#we{es=Etab,vc=Vct}) -> + lists:foreach(fun({V,Edge}) -> + case gb_trees:get(Edge, Etab) of + #edge{vs=V} -> ok; + #edge{ve=V} -> ok + end + end, gb_trees:to_list(Vct)). diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/zoltan_kis1.erl b/lib/dialyzer/test/opaque_SUITE_data/src/zoltan_kis1.erl new file mode 100644 index 0000000000..82bcf2edcf --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/zoltan_kis1.erl @@ -0,0 +1,14 @@ +-module(zoltan_kis1). + +-export([f/0, gen/0]). + +-opaque id() :: string(). + +-spec f() -> integer(). + +%BIF and Unification(t_unify) issue +f() -> erlang:length(gen()). + +-spec gen() -> id(). + +gen() -> "Dummy". diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/zoltan_kis2.erl b/lib/dialyzer/test/opaque_SUITE_data/src/zoltan_kis2.erl new file mode 100644 index 0000000000..a4b0a18157 --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/zoltan_kis2.erl @@ -0,0 +1,14 @@ +-module(zoltan_kis2). + +-export([get/2]). + +-opaque data() :: gb_tree(). + +-spec get(term(), data()) -> term(). + +get(Key, Data) -> + %%Should unopaque data for remote calls + case gb_trees:lookup(Key, Data) of + 'none' -> 'undefined'; + {'value', Val} -> Val + end. diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/zoltan_kis3.erl b/lib/dialyzer/test/opaque_SUITE_data/src/zoltan_kis3.erl new file mode 100644 index 0000000000..4977ca4bc9 --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/zoltan_kis3.erl @@ -0,0 +1,14 @@ +-module(zoltan_kis3). + +-export([f/0, gen/0]). + +-opaque id() :: string(). + +-spec f() -> char(). + +%%List pattern matching issue +f() -> [H|_T] = gen(), H. + +-spec gen() -> id(). + +gen() -> "Dummy". diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/zoltan_kis4.erl b/lib/dialyzer/test/opaque_SUITE_data/src/zoltan_kis4.erl new file mode 100644 index 0000000000..ad3771aa2c --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/zoltan_kis4.erl @@ -0,0 +1,14 @@ +-module(zoltan_kis4). + +-export([f/0, gen/0]). + +-opaque id() :: string(). + +-spec f() -> boolean(). + +%%Equality test issue +f() -> "Dummy" == gen(). + +-spec gen() -> id(). + +gen() -> "Dummy". diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/zoltan_kis5.erl b/lib/dialyzer/test/opaque_SUITE_data/src/zoltan_kis5.erl new file mode 100644 index 0000000000..ecf14c91c1 --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/zoltan_kis5.erl @@ -0,0 +1,14 @@ +-module(zoltan_kis5). + +-export([f/0, gen/0]). + +-opaque id() :: string(). + +-spec f() -> boolean(). + +%% Equality test issue +f() -> "Dummy" == gen(). + +-spec gen() -> id(). + +gen() -> "Dummy". diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/zoltan_kis6.erl b/lib/dialyzer/test/opaque_SUITE_data/src/zoltan_kis6.erl new file mode 100644 index 0000000000..6f0779d7d1 --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/zoltan_kis6.erl @@ -0,0 +1,14 @@ +-module(zoltan_kis6). + +-export([f/0, gen/0]). + +-opaque id() :: {integer(),atom()}. + +%%-spec f() -> id(). + +%% Tuple Unification (t_unify) issue +f() -> {X,Y} = gen(). + +-spec gen() -> id(). + +gen() -> {34, leprecon}. |