aboutsummaryrefslogtreecommitdiffstats
path: root/lib/dialyzer
diff options
context:
space:
mode:
Diffstat (limited to 'lib/dialyzer')
-rw-r--r--lib/dialyzer/src/dialyzer.erl15
-rw-r--r--lib/dialyzer/src/dialyzer_cl.erl8
-rw-r--r--lib/dialyzer/src/dialyzer_contracts.erl90
-rw-r--r--lib/dialyzer/src/dialyzer_dataflow.erl1058
-rw-r--r--lib/dialyzer/src/dialyzer_succ_typings.erl82
-rw-r--r--lib/dialyzer/src/dialyzer_typesig.erl355
-rw-r--r--lib/dialyzer/test/Makefile1
-rw-r--r--lib/dialyzer/test/dialyzer.cover3
-rw-r--r--lib/dialyzer/test/opaque_SUITE_data/results/crash2
-rw-r--r--lib/dialyzer/test/opaque_SUITE_data/results/ets1
-rw-r--r--lib/dialyzer/test/opaque_SUITE_data/results/ewgi2
-rw-r--r--lib/dialyzer/test/opaque_SUITE_data/results/inf_loop12
-rw-r--r--lib/dialyzer/test/opaque_SUITE_data/results/inf_loop25
-rw-r--r--lib/dialyzer/test/opaque_SUITE_data/results/int4
-rw-r--r--lib/dialyzer/test/opaque_SUITE_data/results/mixed_opaque2
-rw-r--r--lib/dialyzer/test/opaque_SUITE_data/results/modules3
-rw-r--r--lib/dialyzer/test/opaque_SUITE_data/results/my_queue2
-rw-r--r--lib/dialyzer/test/opaque_SUITE_data/results/opaque1
-rw-r--r--lib/dialyzer/test/opaque_SUITE_data/results/queue1
-rw-r--r--lib/dialyzer/test/opaque_SUITE_data/results/simple87
-rw-r--r--lib/dialyzer/test/opaque_SUITE_data/results/wings2
-rw-r--r--lib/dialyzer/test/opaque_SUITE_data/src/ets/ets_use.erl10
-rw-r--r--lib/dialyzer/test/opaque_SUITE_data/src/inf_loop2.erl175
-rw-r--r--lib/dialyzer/test/opaque_SUITE_data/src/modules/opaque_digraph.erl655
-rw-r--r--lib/dialyzer/test/opaque_SUITE_data/src/modules/opaque_erl_scan.erl1300
-rw-r--r--lib/dialyzer/test/opaque_SUITE_data/src/opaque/opaque_adt.erl2
-rw-r--r--lib/dialyzer/test/opaque_SUITE_data/src/simple/exact_adt.erl17
-rw-r--r--lib/dialyzer/test/opaque_SUITE_data/src/simple/exact_api.erl60
-rw-r--r--lib/dialyzer/test/opaque_SUITE_data/src/simple/is_rec.erl65
-rw-r--r--lib/dialyzer/test/opaque_SUITE_data/src/simple/rec_adt.erl28
-rw-r--r--lib/dialyzer/test/opaque_SUITE_data/src/simple/rec_api.erl77
-rw-r--r--lib/dialyzer/test/opaque_SUITE_data/src/simple/simple1_adt.erl138
-rw-r--r--lib/dialyzer/test/opaque_SUITE_data/src/simple/simple1_api.erl571
-rw-r--r--lib/dialyzer/test/opaque_SUITE_data/src/simple/simple2_api.erl125
-rw-r--r--lib/dialyzer/test/opaque_SUITE_data/src/union/union_adt.erl9
-rw-r--r--lib/dialyzer/test/opaque_SUITE_data/src/zoltan_adt.erl5
-rw-r--r--lib/dialyzer/test/opaque_SUITE_data/src/zoltan_kis3.erl4
-rw-r--r--lib/dialyzer/vsn.mk2
38 files changed, 4193 insertions, 776 deletions
diff --git a/lib/dialyzer/src/dialyzer.erl b/lib/dialyzer/src/dialyzer.erl
index 35156afff2..bb7e39dfda 100644
--- a/lib/dialyzer/src/dialyzer.erl
+++ b/lib/dialyzer/src/dialyzer.erl
@@ -423,6 +423,9 @@ message_to_string({call_without_opaque, [M, F, Args, ExpectedTriples]}) ->
message_to_string({opaque_eq, [Type, _Op, OpaqueType]}) ->
io_lib:format("Attempt to test for equality between a term of type ~s"
" and a term of opaque type ~s\n", [Type, OpaqueType]);
+message_to_string({opaque_guard, [Arg1, Infix, Arg2, ArgNs]}) ->
+ io_lib:format("Guard test ~s ~s ~s contains ~s\n",
+ [Arg1, Infix, Arg2, form_positions(ArgNs)]);
message_to_string({opaque_guard, [Guard, Args]}) ->
io_lib:format("Guard test ~w~s breaks the opaqueness of its argument\n",
[Guard, Args]);
@@ -435,8 +438,16 @@ message_to_string({opaque_match, [Pat, OpaqueType, OpaqueTerm]}) ->
message_to_string({opaque_neq, [Type, _Op, OpaqueType]}) ->
io_lib:format("Attempt to test for inequality between a term of type ~s"
" and a term of opaque type ~s\n", [Type, OpaqueType]);
-message_to_string({opaque_type_test, [Fun, Opaque]}) ->
- io_lib:format("The type test ~s(~s) breaks the opaqueness of the term ~s\n", [Fun, Opaque, Opaque]);
+message_to_string({opaque_type_test, [Fun, Args, Arg, ArgType]}) ->
+ io_lib:format("The type test ~s~s breaks the opaqueness of the term ~s~s\n",
+ [Fun, Args, Arg, ArgType]);
+message_to_string({opaque_size, [SizeType, Size]}) ->
+ io_lib:format("The size ~s breaks the opaqueness of ~s\n",
+ [SizeType, Size]);
+message_to_string({opaque_call, [M, F, Args, Culprit, OpaqueType]}) ->
+ io_lib:format("The call ~s:~s~s breaks the opaqueness of the term ~s :: ~s\n",
+ [M, F, Args, Culprit, OpaqueType]);
+
%%----- Warnings for concurrency errors --------------------
message_to_string({race_condition, [M, F, Args, Reason]}) ->
io_lib:format("The call ~w:~w~s ~s\n", [M, F, Args, Reason]);
diff --git a/lib/dialyzer/src/dialyzer_cl.erl b/lib/dialyzer/src/dialyzer_cl.erl
index 365c0b36d4..a7be6e0d05 100644
--- a/lib/dialyzer/src/dialyzer_cl.erl
+++ b/lib/dialyzer/src/dialyzer_cl.erl
@@ -2,7 +2,7 @@
%%-------------------------------------------------------------------
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2006-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2006-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -613,7 +613,7 @@ cl_loop(State, LogCache) ->
-spec failed_anal_msg(string(), [_]) -> nonempty_string().
failed_anal_msg(Reason, LogCache) ->
- Msg = "Analysis failed with error:\n" ++ Reason ++ "\n",
+ Msg = "Analysis failed with error:\n" ++ lists:flatten(Reason) ++ "\n",
case LogCache =:= [] of
true -> Msg;
false ->
@@ -640,7 +640,7 @@ store_unknown_behaviours(#cl_state{unknown_behaviours = Behs} = St, Beh) ->
-spec cl_error(string()) -> no_return().
cl_error(Msg) ->
- throw({dialyzer_error, Msg}).
+ throw({dialyzer_error, lists:flatten(Msg)}).
-spec cl_error(#cl_state{}, string()) -> no_return().
@@ -650,7 +650,7 @@ cl_error(State, Msg) ->
Outfile -> io:format(Outfile, "\n~s\n", [Msg])
end,
maybe_close_output_file(State),
- throw({dialyzer_error, Msg}).
+ throw({dialyzer_error, lists:flatten(Msg)}).
return_value(State = #cl_state{erlang_mode = ErlangMode,
mod_deps = ModDeps,
diff --git a/lib/dialyzer/src/dialyzer_contracts.erl b/lib/dialyzer/src/dialyzer_contracts.erl
index 332a326b0d..3467ab4e65 100644
--- a/lib/dialyzer/src/dialyzer_contracts.erl
+++ b/lib/dialyzer/src/dialyzer_contracts.erl
@@ -2,7 +2,7 @@
%%-----------------------------------------------------------------------
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2007-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2007-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -21,10 +21,10 @@
-module(dialyzer_contracts).
-export([check_contract/2,
- check_contracts/3,
+ check_contracts/4,
contracts_without_fun/3,
contract_to_string/1,
- get_invalid_contract_warnings/3,
+ get_invalid_contract_warnings/4,
get_contract_args/1,
get_contract_return/1,
get_contract_return/2,
@@ -160,17 +160,22 @@ process_contract_remote_types(CodeServer) ->
dialyzer_codeserver:finalize_contracts(NewContractDict, NewCallbackDict,
CodeServer).
+-type opaques() :: [erl_types:erl_type()] | 'universe'.
+-type opaques_fun() :: fun((module()) -> opaques()).
+
-spec check_contracts([{mfa(), file_contract()}],
- dialyzer_callgraph:callgraph(), dict()) -> plt_contracts().
+ dialyzer_callgraph:callgraph(), dict(),
+ opaques_fun()) -> plt_contracts().
-check_contracts(Contracts, Callgraph, FunTypes) ->
+check_contracts(Contracts, Callgraph, FunTypes, FindOpaques) ->
FoldFun =
fun(Label, Type, NewContracts) ->
case dialyzer_callgraph:lookup_name(Label, Callgraph) of
{ok, {M,F,A} = MFA} ->
case orddict:find(MFA, Contracts) of
{ok, {_FileLine, Contract}} ->
- case check_contract(Contract, Type) of
+ Opaques = FindOpaques(M),
+ case check_contract(Contract, Type, Opaques) of
ok ->
case erl_bif_types:is_known(M, F, A) of
true ->
@@ -192,7 +197,10 @@ check_contracts(Contracts, Callgraph, FunTypes) ->
%% Checks all components of a contract
-spec check_contract(#contract{}, erl_types:erl_type()) -> 'ok' | {'error', term()}.
-check_contract(#contract{contracts = Contracts}, SuccType) ->
+check_contract(Contract, SuccType) ->
+ check_contract(Contract, SuccType, 'universe').
+
+check_contract(#contract{contracts = Contracts}, SuccType, Opaques) ->
try
Contracts1 = [{Contract, insert_constraints(Constraints, dict:new())}
|| {Contract, Constraints} <- Contracts],
@@ -203,9 +211,9 @@ check_contract(#contract{contracts = Contracts}, SuccType) ->
error ->
{error, {overlapping_contract, []}};
ok ->
- InfList = [erl_types:t_inf(Contract, SuccType, opaque)
+ InfList = [erl_types:t_inf(Contract, SuccType, Opaques)
|| Contract <- Contracts2],
- case check_contract_inf_list(InfList, SuccType) of
+ case check_contract_inf_list(InfList, SuccType, Opaques) of
{error, _} = Invalid -> Invalid;
ok -> check_extraneous(Contracts2, SuccType)
end
@@ -217,7 +225,7 @@ check_contract(#contract{contracts = Contracts}, SuccType) ->
check_domains([_]) -> ok;
check_domains([Dom|Doms]) ->
Fun = fun(D) ->
- erl_types:any_none_or_unit(erl_types:t_inf_lists(Dom, D, opaque))
+ erl_types:any_none_or_unit(erl_types:t_inf_lists(Dom, D))
end,
case lists:all(Fun, Doms) of
true -> check_domains(Doms);
@@ -227,23 +235,23 @@ check_domains([Dom|Doms]) ->
%% Allow a contract if one of the overloaded contracts is possible.
%% We used to be more strict, e.g., all overloaded contracts had to be
%% possible.
-check_contract_inf_list([FunType|Left], SuccType) ->
+check_contract_inf_list([FunType|Left], SuccType, Opaques) ->
FunArgs = erl_types:t_fun_args(FunType),
case lists:any(fun erl_types:t_is_none_or_unit/1, FunArgs) of
- true -> check_contract_inf_list(Left, SuccType);
+ true -> check_contract_inf_list(Left, SuccType, Opaques);
false ->
STRange = erl_types:t_fun_range(SuccType),
case erl_types:t_is_none_or_unit(STRange) of
true -> ok;
false ->
Range = erl_types:t_fun_range(FunType),
- case erl_types:t_is_none(erl_types:t_inf(STRange, Range, opaque)) of
- true -> check_contract_inf_list(Left, SuccType);
+ case erl_types:t_is_none(erl_types:t_inf(STRange, Range)) of
+ true -> check_contract_inf_list(Left, SuccType, Opaques);
false -> ok
end
end
end;
-check_contract_inf_list([], _SuccType) ->
+check_contract_inf_list([], _SuccType, _Opaques) ->
{error, invalid_contract}.
check_extraneous([], _SuccType) -> ok;
@@ -259,7 +267,7 @@ check_extraneous_1(Contract, SuccType) ->
STRng = erl_types:t_fun_range(SuccType),
?debug("CR = ~p\nSR = ~p\n", [CRngs, STRng]),
case [CR || CR <- CRngs,
- erl_types:t_is_none(erl_types:t_inf(CR, STRng, opaque))] of
+ erl_types:t_is_none(erl_types:t_inf(CR, STRng))] of
[] ->
CRngList = list_part(CRng),
STRngList = list_part(STRng),
@@ -268,7 +276,7 @@ check_extraneous_1(Contract, SuccType) ->
true ->
CRngElements = erl_types:t_list_elements(CRngList),
STRngElements = erl_types:t_list_elements(STRngList),
- Inf = erl_types:t_inf(CRngElements, STRngElements, opaque),
+ Inf = erl_types:t_inf(CRngElements, STRngElements),
case erl_types:t_is_none(Inf) of
true -> {error, invalid_contract};
false -> ok
@@ -278,7 +286,7 @@ check_extraneous_1(Contract, SuccType) ->
end.
list_part(Type) ->
- erl_types:t_inf(erl_types:t_list(), Type, opaque).
+ erl_types:t_inf(erl_types:t_list(), Type).
is_not_nil_list(Type) ->
erl_types:t_is_list(Type) andalso not erl_types:t_is_nil(Type).
@@ -374,7 +382,7 @@ insert_constraints([], Dict) -> Dict.
store_tmp_contract(MFA, FileLine, TypeSpec, SpecDict, RecordsDict) ->
%% io:format("contract from form: ~p\n", [TypeSpec]),
TmpContract = contract_from_form(TypeSpec, RecordsDict, FileLine),
- %% io:format("contract: ~p\n", [Contract]),
+ %% io:format("contract: ~p\n", [TmpContract]),
dict:store(MFA, {FileLine, TmpContract}, SpecDict).
contract_from_form(Forms, RecDict, FileLine) ->
@@ -494,30 +502,35 @@ general_domain([], AccSig) ->
AccSig1 = erl_types:subst_all_vars_to_any(AccSig),
erl_types:t_fun_args(AccSig1).
--spec get_invalid_contract_warnings([module()], dialyzer_codeserver:codeserver(), dialyzer_plt:plt()) -> [dial_warning()].
+-spec get_invalid_contract_warnings([module()],
+ dialyzer_codeserver:codeserver(),
+ dialyzer_plt:plt(),
+ opaques_fun()) -> [dial_warning()].
-get_invalid_contract_warnings(Modules, CodeServer, Plt) ->
- get_invalid_contract_warnings_modules(Modules, CodeServer, Plt, []).
+get_invalid_contract_warnings(Modules, CodeServer, Plt, FindOpaques) ->
+ get_invalid_contract_warnings_modules(Modules, CodeServer, Plt, FindOpaques, []).
-get_invalid_contract_warnings_modules([Mod|Mods], CodeServer, Plt, Acc) ->
+get_invalid_contract_warnings_modules([Mod|Mods], CodeServer, Plt, FindOpaques, Acc) ->
Contracts1 = dialyzer_codeserver:lookup_mod_contracts(Mod, CodeServer),
Contracts2 = dict:to_list(Contracts1),
Records = dialyzer_codeserver:lookup_mod_records(Mod, CodeServer),
- NewAcc = get_invalid_contract_warnings_funs(Contracts2, Plt, Records, Acc),
- get_invalid_contract_warnings_modules(Mods, CodeServer, Plt, NewAcc);
-get_invalid_contract_warnings_modules([], _CodeServer, _Plt, Acc) ->
+ NewAcc = get_invalid_contract_warnings_funs(Contracts2, Plt, Records, FindOpaques, Acc),
+ get_invalid_contract_warnings_modules(Mods, CodeServer, Plt, FindOpaques, NewAcc);
+get_invalid_contract_warnings_modules([], _CodeServer, _Plt, _FindOpaques, Acc) ->
Acc.
get_invalid_contract_warnings_funs([{MFA, {FileLine, Contract}}|Left],
- Plt, RecDict, Acc) ->
+ Plt, RecDict, FindOpaques, Acc) ->
case dialyzer_plt:lookup(Plt, MFA) of
none ->
%% This must be a contract for a non-available function. Just accept it.
- get_invalid_contract_warnings_funs(Left, Plt, RecDict, Acc);
+ get_invalid_contract_warnings_funs(Left, Plt, RecDict, FindOpaques, Acc);
{value, {Ret, Args}} ->
Sig = erl_types:t_fun(Args, Ret),
+ {M, _F, _A} = MFA,
+ Opaques = FindOpaques(M),
NewAcc =
- case check_contract(Contract, Sig) of
+ case check_contract(Contract, Sig, Opaques) of
{error, invalid_contract} ->
[invalid_contract_warning(MFA, FileLine, Sig, RecDict)|Acc];
{error, {overlapping_contract, []}} ->
@@ -551,7 +564,7 @@ get_invalid_contract_warnings_funs([{MFA, {FileLine, Contract}}|Left],
BifArgs = erl_bif_types:arg_types(M, F, A),
BifRet = erl_bif_types:type(M, F, A),
BifSig = erl_types:t_fun(BifArgs, BifRet),
- case check_contract(Contract, BifSig) of
+ case check_contract(Contract, BifSig, Opaques) of
{error, _} ->
[invalid_contract_warning(MFA, FileLine, BifSig, RecDict)
|Acc];
@@ -564,9 +577,9 @@ get_invalid_contract_warnings_funs([{MFA, {FileLine, Contract}}|Left],
RecDict, Acc)
end
end,
- get_invalid_contract_warnings_funs(Left, Plt, RecDict, NewAcc)
+ get_invalid_contract_warnings_funs(Left, Plt, RecDict, FindOpaques, NewAcc)
end;
-get_invalid_contract_warnings_funs([], _Plt, _RecDict, Acc) ->
+get_invalid_contract_warnings_funs([], _Plt, _RecDict, _FindOpaques, Acc) ->
Acc.
invalid_contract_warning({M, F, A}, FileLine, SuccType, RecDict) ->
@@ -601,16 +614,23 @@ picky_contract_check(CSig0, Sig0, MFA, FileLine, Contract, RecDict, Acc) ->
end.
extra_contract_warning({M, F, A}, FileLine, Contract, CSig, Sig, RecDict) ->
- SigString = lists:flatten(dialyzer_utils:format_sig(Sig, RecDict)),
- ContractString0 = lists:flatten(dialyzer_utils:format_sig(CSig, RecDict)),
+ %% We do not want to depend upon erl_types:t_to_string() possibly
+ %% hiding the contents of opaque types.
+ SigUnopaque = erl_types:t_unopaque(Sig),
+ CSigUnopaque = erl_types:t_unopaque(CSig),
+ SigString0 =
+ lists:flatten(dialyzer_utils:format_sig(SigUnopaque, RecDict)),
+ ContractString0 =
+ lists:flatten(dialyzer_utils:format_sig(CSigUnopaque, RecDict)),
%% The only difference is in record fields containing 'undefined' or not.
- IsUndefRecordFieldsRelated = SigString =:= ContractString0,
+ IsUndefRecordFieldsRelated = SigString0 =:= ContractString0,
{IsRemoteTypesRelated, SubtypeRelation} =
is_remote_types_related(Contract, CSig, Sig, RecDict),
case IsUndefRecordFieldsRelated orelse IsRemoteTypesRelated of
true ->
no_warning;
false ->
+ SigString = lists:flatten(dialyzer_utils:format_sig(Sig, RecDict)),
ContractString = contract_to_string(Contract),
{Tag, Msg} =
case SubtypeRelation of
diff --git a/lib/dialyzer/src/dialyzer_dataflow.erl b/lib/dialyzer/src/dialyzer_dataflow.erl
index 922ccad599..3591d5be8e 100644
--- a/lib/dialyzer/src/dialyzer_dataflow.erl
+++ b/lib/dialyzer/src/dialyzer_dataflow.erl
@@ -2,7 +2,7 @@
%%--------------------------------------------------------------------
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2006-2012. All Rights Reserved.
+%% Copyright Ericsson AB 2006-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -41,27 +41,33 @@
-include("dialyzer.hrl").
+%%-import(helper, %% 'helper' could be any module doing sanity checks...
-import(erl_types,
- [any_none/1, t_any/0, t_atom/0, t_atom/1, t_atom_vals/1,
+ [t_inf/2, t_inf/3, t_inf_lists/2, t_inf_lists/3,
+ t_inf_lists/3, t_is_equal/2, t_is_subtype/2, t_subtract/2,
+ t_sup/1, t_sup/2]).
+
+-import(erl_types,
+ [any_none/1, t_any/0, t_atom/0, t_atom/1, t_atom_vals/1, t_atom_vals/2,
t_binary/0, t_boolean/0,
t_bitstr/0, t_bitstr/2, t_bitstr_concat/1, t_bitstr_match/2,
- t_cons/0, t_cons/2, t_cons_hd/1, t_cons_tl/1, t_contains_opaque/1,
+ t_cons/0, t_cons/2, t_cons_hd/2, t_cons_tl/2,
+ t_contains_opaque/2,
t_find_opaque_mismatch/2, t_float/0, t_from_range/2, t_from_term/1,
- t_fun/0, t_fun/2, t_fun_args/1, t_fun_range/1,
- t_inf/2, t_inf/3, t_inf_lists/2, t_inf_lists/3, t_inf_lists_masked/3,
- t_integer/0, t_integers/1,
- t_is_any/1, t_is_atom/1, t_is_atom/2, t_is_boolean/1, t_is_equal/2,
- t_is_integer/1, t_is_nil/1, t_is_none/1, t_is_none_or_unit/1,
- t_is_number/1, t_is_reference/1, t_is_pid/1, t_is_port/1,
- t_is_subtype/2, t_is_unit/1,
+ t_fun/0, t_fun/2, t_fun_args/1, t_fun_args/2, t_fun_range/1,
+ t_fun_range/2, t_integer/0, t_integers/1,
+ t_is_any/1, t_is_atom/1, t_is_atom/2, t_is_any_atom/3,
+ t_is_boolean/2,
+ t_is_integer/2, t_is_nil/2, t_is_none/1, t_is_none_or_unit/1,
+ t_is_number/2, t_is_reference/2, t_is_pid/2, t_is_port/2,
+ t_is_unit/1,
t_limit/2, t_list/0, t_maybe_improper_list/0, t_module/0,
- t_none/0, t_non_neg_integer/0, t_number/0, t_number_vals/1,
- t_opaque_match_atom/2, t_opaque_match_record/2,
- t_opaque_matching_structure/2,
+ t_none/0, t_non_neg_integer/0, t_number/0, t_number_vals/2,
t_pid/0, t_port/0, t_product/1, t_reference/0,
- t_sup/1, t_sup/2, t_subtract/2, t_to_string/2, t_to_tlist/1,
- t_tuple/0, t_tuple/1, t_tuple_args/1, t_tuple_subtypes/1,
- t_unit/0, t_unopaque/1]).
+ t_to_string/2, t_to_tlist/1,
+ t_tuple/0, t_tuple/1, t_tuple_args/1, t_tuple_args/2,
+ t_tuple_subtypes/2,
+ t_unit/0, t_unopaque/2]).
%%-define(DEBUG, true).
%%-define(DEBUG_PP, true).
@@ -204,7 +210,7 @@ analyze_loop(State) ->
traverse(Tree, Map, State) ->
?debug("Handling ~p\n", [cerl:type(Tree)]),
- %%debug_pp_map(Map),
+ %% debug_pp_map(Map),
case cerl:type(Tree) of
alias ->
%% This only happens when checking for illegal record patterns
@@ -256,12 +262,7 @@ traverse(Tree, Map, State) ->
case cerl:unfold_literal(Tree) of
Tree ->
Type = literal_type(Tree),
- NewType =
- case erl_types:t_opaque_match_atom(Type, State#state.opaques) of
- [Opaque] -> Opaque;
- _ -> Type
- end,
- {State, Map, NewType};
+ {State, Map, Type};
NewTree -> traverse(NewTree, Map, State)
end;
module ->
@@ -286,8 +287,11 @@ traverse(Tree, Map, State) ->
SMA;
false ->
State2 =
- case (t_is_any(ArgType) orelse t_is_simple(ArgType)
- orelse is_call_to_send(Arg)) of
+ case
+ t_is_any(ArgType)
+ orelse t_is_simple(ArgType, State)
+ orelse is_call_to_send(Arg)
+ of
true -> % do not warn in these cases
State1;
false ->
@@ -311,15 +315,7 @@ traverse(Tree, Map, State) ->
case state__lookup_type_for_letrec(Tree, State) of
error ->
LType = lookup_type(Tree, Map),
- Opaques = State#state.opaques,
- case t_opaque_match_record(LType, Opaques) of
- [Opaque] -> {State, Map, Opaque};
- _ ->
- case t_opaque_match_atom(LType, Opaques) of
- [Opaque] -> {State, Map, Opaque};
- _ -> {State, Map, LType}
- end
- end;
+ {State, Map, LType};
{ok, Type} -> {State, Map, Type}
end;
Other ->
@@ -367,7 +363,8 @@ handle_apply(Tree, Map, State) ->
Tree, Msg),
{State3, Map2, t_none()};
false ->
- NewArgs = t_inf_lists(ArgTypes, t_fun_args(OpType1)),
+ NewArgs = t_inf_lists(ArgTypes,
+ t_fun_args(OpType1, 'universe')),
case any_none(NewArgs) of
true ->
Msg = {fun_app_args,
@@ -378,7 +375,7 @@ handle_apply(Tree, Map, State) ->
{State3, enter_type(Op, OpType1, Map2), t_none()};
false ->
Map3 = enter_type_lists(Args, NewArgs, Map2),
- Range0 = t_fun_range(OpType1),
+ Range0 = t_fun_range(OpType1, 'universe'),
Range =
case t_is_unit(Range0) of
true -> t_none();
@@ -423,83 +420,55 @@ handle_apply_or_call([{TypeOfApply, {Fun, Sig, Contr, LocalRet}}|Left],
{M, F, A} = Fun,
case erl_bif_types:is_known(M, F, A) of
true ->
- IsBIF = true,
BArgs = erl_bif_types:arg_types(M, F, A),
BRange =
fun(FunArgs) ->
- ArgPos = erl_bif_types:structure_inspecting_args(M, F, A),
- NewFunArgs =
- case ArgPos =:= [] of
- true -> FunArgs;
- false -> % some positions need to be un-opaqued
- N = length(FunArgs),
- PFs = lists:zip(lists:seq(1, N), FunArgs),
- [case ordsets:is_element(P, ArgPos) of
- true -> erl_types:t_unopaque(FArg, Opaques);
- false -> FArg
- end || {P, FArg} <- PFs]
- end,
- erl_bif_types:type(M, F, A, NewFunArgs)
+ erl_bif_types:type(M, F, A, FunArgs, Opaques)
end,
{BArgs, BRange};
- false -> IsBIF = false, GenSig
+ false ->
+ GenSig
end;
- local -> IsBIF = false, GenSig
+ local -> GenSig
end,
{SigArgs, SigRange} =
- %% if there is hard-coded or contract information with opaque types,
- %% the checking for possible type violations needs to take place w.r.t.
- %% this information and not w.r.t. the structure-based success typing.
- case prefer_opaque_types(CArgs, BifArgs) of
- true -> {AnyArgs, t_any()}; % effectively forgets the success typing
- false ->
- case Sig of
- {value, {SR, SA}} -> {SA, SR};
- none -> {AnyArgs, t_any()}
- end
- end,
- ArgModeMask = [case lists:member(Arg, Opaques) of
- true -> opaque;
- false -> structured
- end || Arg <- ArgTypes],
- NewArgsSig = t_inf_lists_masked(SigArgs, ArgTypes, ArgModeMask),
- NewArgsContract = t_inf_lists_masked(CArgs, ArgTypes, ArgModeMask),
- NewArgsBif = t_inf_lists_masked(BifArgs, ArgTypes, ArgModeMask),
- NewArgTypes0 = t_inf_lists_masked(NewArgsSig, NewArgsContract, ArgModeMask),
- NewArgTypes = t_inf_lists_masked(NewArgTypes0, NewArgsBif, ArgModeMask),
- BifRet = BifRange(NewArgTypes),
- {TmpArgTypes, TmpArgsContract} =
- case (TypeOfApply =:= remote) andalso (not IsBIF) of
- true ->
- List1 = lists:zip(CArgs, NewArgTypes),
- List2 = lists:zip(CArgs, NewArgsContract),
- {[erl_types:t_unopaque_on_mismatch(T1, T2, Opaques)
- || {T1, T2} <- List1],
- [erl_types:t_unopaque_on_mismatch(T1, T2, Opaques)
- || {T1, T2} <- List2]};
- false -> {NewArgTypes, NewArgsContract}
- end,
- ContrRet = CRange(TmpArgTypes),
- RetMode =
- case t_contains_opaque(ContrRet) orelse t_contains_opaque(BifRet) of
- true -> opaque;
- false -> structured
+ case Sig of
+ {value, {SR, SA}} -> {SA, SR};
+ none -> {AnyArgs, t_any()}
end,
- RetWithoutContr = t_inf(SigRange, BifRet, RetMode),
- RetWithoutLocal = t_inf(ContrRet, RetWithoutContr, RetMode),
+
?debug("--------------------------------------------------------\n", []),
- ?debug("Fun: ~p\n", [Fun]),
- ?debug("Args: ~s\n", [erl_types:t_to_string(t_product(ArgTypes))]),
+ ?debug("Fun: ~p\n", [state__lookup_name(Fun, State)]),
+ ?debug("Module ~p\n", [State#state.module]),
+ ?debug("CArgs ~s\n", [erl_types:t_to_string(t_product(CArgs))]),
+ ?debug("ArgTypes ~s\n", [erl_types:t_to_string(t_product(ArgTypes))]),
+ ?debug("BifArgs ~p\n", [erl_types:t_to_string(t_product(BifArgs))]),
+
+ NewArgsSig = t_inf_lists(SigArgs, ArgTypes, Opaques),
+ ?debug("SigArgs ~s\n", [erl_types:t_to_string(t_product(SigArgs))]),
?debug("NewArgsSig: ~s\n", [erl_types:t_to_string(t_product(NewArgsSig))]),
+ NewArgsContract = t_inf_lists(CArgs, ArgTypes, Opaques),
?debug("NewArgsContract: ~s\n",
[erl_types:t_to_string(t_product(NewArgsContract))]),
+ NewArgsBif = t_inf_lists(BifArgs, ArgTypes, Opaques),
?debug("NewArgsBif: ~s\n", [erl_types:t_to_string(t_product(NewArgsBif))]),
- ?debug("NewArgTypes: ~s\n", [erl_types:t_to_string(t_product(NewArgTypes))]),
+ NewArgTypes0 = t_inf_lists(NewArgsSig, NewArgsContract),
+ NewArgTypes = t_inf_lists(NewArgTypes0, NewArgsBif, Opaques),
+ ?debug("NewArgTypes ~s\n", [erl_types:t_to_string(t_product(NewArgTypes))]),
+ ?debug("\n", []),
+
+ BifRet = BifRange(NewArgTypes),
+ ContrRet = CRange(NewArgTypes),
+ RetWithoutContr = t_inf(SigRange, BifRet),
+ RetWithoutLocal = t_inf(ContrRet, RetWithoutContr),
+
?debug("RetWithoutContr: ~s\n",[erl_types:t_to_string(RetWithoutContr)]),
?debug("RetWithoutLocal: ~s\n", [erl_types:t_to_string(RetWithoutLocal)]),
?debug("BifRet: ~s\n", [erl_types:t_to_string(BifRange(NewArgTypes))]),
- ?debug("ContrRet: ~s\n", [erl_types:t_to_string(CRange(TmpArgTypes))]),
- ?debug("SigRet: ~s\n", [erl_types:t_to_string(SigRange)]),
+ ?debug("SigRange: ~s\n", [erl_types:t_to_string(SigRange)]),
+ ?debug("ContrRet: ~s\n", [erl_types:t_to_string(CRange(NewArgTypes))]),
+ ?debug("LocalRet: ~s\n", [erl_types:t_to_string(LocalRet)]),
+
State1 =
case is_race_analysis_enabled(State) of
true ->
@@ -513,6 +482,9 @@ handle_apply_or_call([{TypeOfApply, {Fun, Sig, Contr, LocalRet}}|Left],
FailedConj = any_none([RetWithoutLocal|NewArgTypes]),
IsFailBif = t_is_none(BifRange(BifArgs)),
IsFailSig = t_is_none(SigRange),
+ ?debug("FailedConj: ~p~n", [FailedConj]),
+ ?debug("IsFailBif: ~p~n", [IsFailBif]),
+ ?debug("IsFailSig: ~p~n", [IsFailSig]),
State2 =
case FailedConj andalso not (IsFailBif orelse IsFailSig) of
true ->
@@ -532,14 +504,14 @@ handle_apply_or_call([{TypeOfApply, {Fun, Sig, Contr, LocalRet}}|Left],
false ->
FailedSig = any_none(NewArgsSig),
FailedContract =
- any_none([CRange(TmpArgsContract)|NewArgsContract]),
+ any_none([CRange(NewArgsContract)|NewArgsContract]),
FailedBif = any_none([BifRange(NewArgsBif)|NewArgsBif]),
InfSig = t_inf(t_fun(SigArgs, SigRange),
- t_fun(BifArgs, BifRange(BifArgs))),
+ t_fun(BifArgs, BifRange(BifArgs))),
FailReason =
apply_fail_reason(FailedSig, FailedBif, FailedContract),
Msg = get_apply_fail_msg(Fun, Args, ArgTypes, NewArgTypes, InfSig,
- Contr, CArgs, State1, FailReason),
+ Contr, CArgs, State1, FailReason, Opaques),
WarnType = case Msg of
{call, _} -> ?WARN_FAILING_CALL;
{apply, _} -> ?WARN_FAILING_CALL;
@@ -547,7 +519,8 @@ handle_apply_or_call([{TypeOfApply, {Fun, Sig, Contr, LocalRet}}|Left],
{call_without_opaque, _} -> ?WARN_OPAQUE;
{opaque_type_test, _} -> ?WARN_OPAQUE
end,
- state__add_warning(State1, WarnType, Tree, Msg)
+ Frc = {erlang, is_record, 3} =:= state__lookup_name(Fun, State),
+ state__add_warning(State1, WarnType, Tree, Msg, Frc)
end;
false -> State1
end,
@@ -571,7 +544,7 @@ handle_apply_or_call([{TypeOfApply, {Fun, Sig, Contr, LocalRet}}|Left],
TotalRet =
case t_is_none(LocalRet) andalso t_is_unit(RetWithoutLocal) of
true -> RetWithoutLocal;
- false -> t_inf(RetWithoutLocal, LocalRet, opaque)
+ false -> t_inf(RetWithoutLocal, LocalRet)
end,
NewAccRet = t_sup(AccRet, TotalRet),
?debug("NewAccRet: ~s\n", [t_to_string(NewAccRet)]),
@@ -590,7 +563,7 @@ apply_fail_reason(FailedSig, FailedBif, FailedContract) ->
end.
get_apply_fail_msg(Fun, Args, ArgTypes, NewArgTypes,
- Sig, Contract, ContrArgs, State, FailReason) ->
+ Sig, Contract, ContrArgs, State, FailReason, Opaques) ->
ArgStrings = format_args(Args, ArgTypes, State),
ContractInfo =
case Contract of
@@ -599,44 +572,52 @@ get_apply_fail_msg(Fun, Args, ArgTypes, NewArgTypes,
dialyzer_contracts:contract_to_string(C)};
none -> {false, none}
end,
- EnumArgTypes =
- case NewArgTypes of
- [] -> [];
- _ -> lists:zip(lists:seq(1, length(NewArgTypes)), NewArgTypes)
- end,
+ EnumArgTypes = lists:zip(lists:seq(1, length(NewArgTypes)), NewArgTypes),
ArgNs = [Arg || {Arg, Type} <- EnumArgTypes, t_is_none(Type)],
case state__lookup_name(Fun, State) of
- {M, F, _A} ->
- case is_opaque_type_test_problem(Fun, NewArgTypes, State) of
- true ->
- [Opaque] = NewArgTypes,
- {opaque_type_test, [atom_to_list(F), erl_types:t_to_string(Opaque)]};
- false ->
+ {M, F, A} ->
+ case is_opaque_type_test_problem(Fun, Args, NewArgTypes, State) of
+ {yes, Arg, ArgType} ->
+ {opaque_type_test, [atom_to_list(F), ArgStrings,
+ format_arg(Arg), format_type(ArgType, State)]};
+ no ->
SigArgs = t_fun_args(Sig),
- case is_opaque_related_problem(ArgNs, ArgTypes) of
- true -> %% an opaque term is used where a structured term is expected
- ExpectedArgs =
- case FailReason of
- only_sig -> SigArgs;
- _ -> ContrArgs
- end,
- {call_with_opaque, [M, F, ArgStrings, ArgNs, ExpectedArgs]};
- false ->
- case is_opaque_related_problem(ArgNs, SigArgs) orelse
- is_opaque_related_problem(ArgNs, ContrArgs) of
- true -> %% a structured term is used where an opaque is expected
- ExpectedTriples =
- case FailReason of
- only_sig -> expected_arg_triples(ArgNs, SigArgs, State);
- _ -> expected_arg_triples(ArgNs, ContrArgs, State)
- end,
- {call_without_opaque, [M, F, ArgStrings, ExpectedTriples]};
- false -> %% there is a structured term clash in some argument
- {call, [M, F, ArgStrings,
- ArgNs, FailReason,
- format_sig_args(Sig, State),
- format_type(t_fun_range(Sig), State),
- ContractInfo]}
+ BadOpaque =
+ opaque_problems([SigArgs, ContrArgs], ArgTypes, Opaques, ArgNs),
+ %% In fact *both* 'call_with_opaque' and
+ %% 'call_without_opaque' are possible.
+ case lists:keyfind(decl, 1, BadOpaque) of
+ {decl, BadArgs} ->
+ %% a structured term is used where an opaque is expected
+ ExpectedTriples =
+ case FailReason of
+ only_sig -> expected_arg_triples(BadArgs, SigArgs, State);
+ _ -> expected_arg_triples(BadArgs, ContrArgs, State)
+ end,
+ {call_without_opaque, [M, F, ArgStrings, ExpectedTriples]};
+ false ->
+ case lists:keyfind(use, 1, BadOpaque) of
+ {use, BadArgs} ->
+ %% an opaque term is used where a structured term is expected
+ ExpectedArgs =
+ case FailReason of
+ only_sig -> SigArgs;
+ _ -> ContrArgs
+ end,
+ {call_with_opaque, [M, F, ArgStrings, BadArgs, ExpectedArgs]};
+ false ->
+ case
+ erl_bif_types:opaque_args(M, F, A, ArgTypes, Opaques)
+ of
+ [] -> %% there is a structured term clash in some argument
+ {call, [M, F, ArgStrings,
+ ArgNs, FailReason,
+ format_sig_args(Sig, State),
+ format_type(t_fun_range(Sig), State),
+ ContractInfo]};
+ Ns ->
+ {call_with_opaque, [M, F, ArgStrings, Ns, ContrArgs]}
+ end
end
end
end;
@@ -648,20 +629,28 @@ get_apply_fail_msg(Fun, Args, ArgTypes, NewArgTypes,
ContractInfo]}
end.
-%% returns 'true' if we are running with opaque on (not checked yet),
-%% and there is either a contract or hard-coded type information with
-%% opaque types
-%% TODO: check that we are running with opaque types
-%% TODO: check the return type also
-prefer_opaque_types(CArgs, BifArgs) ->
- t_contains_opaque(t_product(CArgs))
- orelse t_contains_opaque(t_product(BifArgs)).
-
-is_opaque_related_problem(ArgNs, ArgTypes) ->
- Fun = fun (N) -> erl_types:t_contains_opaque(lists:nth(N, ArgTypes)) end,
- ArgNs =/= [] andalso lists:all(Fun, ArgNs).
-
-is_opaque_type_test_problem(Fun, ArgTypes, State) ->
+%% -> [{ElementI, [ArgN]}] where [ArgN] is a non-empty list of
+%% arguments containing unknown opaque types and Element is 1 or 2.
+opaque_problems(ContractOrSigList, ArgTypes, Opaques, ArgNs) ->
+ ArgElementList = find_unknown(ContractOrSigList, ArgTypes, Opaques, ArgNs),
+ F = fun(1) -> decl; (2) -> use end,
+ [{F(ElementI), lists:usort([ArgN || {ArgN, EI} <- ArgElementList,
+ EI =:= ElementI])} ||
+ ElementI <- lists:usort([EI || {_, EI} <- ArgElementList])].
+
+%% -> [{ArgN, ElementI}] where ElementI = 1 means there is an unknown
+%% opaque type in argument ArgN of the the contract/signature,
+%% and ElementI = 2 means that there is an unknown opaque type in
+%% argument ArgN of the the (current) argument types.
+find_unknown(ContractOrSigList, ArgTypes, Opaques, NoneArgNs) ->
+ ArgNs = lists:seq(1, length(ArgTypes)),
+ [{ArgN, ElementI} ||
+ ContractOrSig <- ContractOrSigList,
+ {E1, E2, ArgN} <- lists:zip3(ContractOrSig, ArgTypes, ArgNs),
+ lists:member(ArgN, NoneArgNs),
+ ElementI <- erl_types:t_find_unknown_opaque(E1, E2, Opaques)].
+
+is_opaque_type_test_problem(Fun, Args, ArgTypes, State) ->
case Fun of
{erlang, FN, 1} when FN =:= is_atom; FN =:= is_boolean;
FN =:= is_binary; FN =:= is_bitstring;
@@ -669,10 +658,18 @@ is_opaque_type_test_problem(Fun, ArgTypes, State) ->
FN =:= is_integer; FN =:= is_list;
FN =:= is_number; FN =:= is_pid; FN =:= is_port;
FN =:= is_reference; FN =:= is_tuple ->
- [Type] = ArgTypes,
- erl_types:t_is_opaque(Type) andalso
- not lists:member(Type, State#state.opaques);
- _ -> false
+ type_test_opaque_arg(Args, ArgTypes, State#state.opaques);
+ {erlang, FN, 2} when FN =:= is_function ->
+ type_test_opaque_arg(Args, ArgTypes, State#state.opaques);
+ _ -> no
+ end.
+
+type_test_opaque_arg([], [], _Opaques) ->
+ no;
+type_test_opaque_arg([Arg|Args], [ArgType|ArgTypes], Opaques) ->
+ case erl_types:t_has_opaque_subtype(ArgType, Opaques) of
+ true -> {yes, Arg, ArgType};
+ false -> type_test_opaque_arg(Args, ArgTypes, Opaques)
end.
expected_arg_triples(ArgNs, ArgTypes, State) ->
@@ -683,47 +680,56 @@ expected_arg_triples(ArgNs, ArgTypes, State) ->
add_bif_warnings({erlang, Op, 2}, [T1, T2] = Ts, Tree, State)
when Op =:= '=:='; Op =:= '==' ->
- Type1 = erl_types:t_unopaque(T1, State#state.opaques),
- Type2 = erl_types:t_unopaque(T2, State#state.opaques),
- Inf = t_inf(T1, T2),
- Inf1 = t_inf(Type1, Type2),
- case t_is_none(Inf) andalso t_is_none(Inf1) andalso(not any_none(Ts))
- andalso (not is_int_float_eq_comp(T1, Op, T2)) of
+ Opaques = State#state.opaques,
+ Inf = t_inf(T1, T2, Opaques),
+ case
+ t_is_none(Inf) andalso (not any_none(Ts))
+ andalso (not is_int_float_eq_comp(T1, Op, T2, Opaques))
+ of
true ->
- Args = case erl_types:t_is_opaque(T1) of
- true -> [format_type(T2, State), Op, format_type(T1, State)];
- false -> [format_type(T1, State), Op, format_type(T2, State)]
- end,
- case any_opaque(Ts) of
- true ->
- state__add_warning(State, ?WARN_OPAQUE, Tree, {opaque_eq, Args});
- false ->
- state__add_warning(State, ?WARN_MATCHING, Tree, {exact_eq, Args})
+ %% Give priority to opaque warning (as usual).
+ case erl_types:t_find_unknown_opaque(T1, T2, Opaques) of
+ [] ->
+ Args = comp_format_args([], T1, Op, T2, State),
+ state__add_warning(State, ?WARN_MATCHING, Tree, {exact_eq, Args});
+ Ns ->
+ Args = comp_format_args(Ns, T1, Op, T2, State),
+ state__add_warning(State, ?WARN_OPAQUE, Tree, {opaque_eq, Args})
end;
false ->
State
end;
add_bif_warnings({erlang, Op, 2}, [T1, T2] = Ts, Tree, State)
when Op =:= '=/='; Op =:= '/=' ->
- Inf = t_inf(T1, T2),
- case t_is_none(Inf) andalso (not any_none(Ts))
- andalso (not is_int_float_eq_comp(T1, Op, T2)) andalso any_opaque(Ts) of
+ Opaques = State#state.opaques,
+ case
+ (not any_none(Ts))
+ andalso (not is_int_float_eq_comp(T1, Op, T2, Opaques))
+ of
true ->
- Args = case erl_types:t_is_opaque(T1) of
- true -> [format_type(T2, State), Op, format_type(T1, State)];
- false -> [format_type(T1, State), Op, format_type(T2, State)]
- end,
- state__add_warning(State, ?WARN_OPAQUE, Tree, {opaque_neq, Args});
+ case erl_types:t_find_unknown_opaque(T1, T2, Opaques) of
+ [] -> State;
+ Ns ->
+ Args = comp_format_args(Ns, T1, Op, T2, State),
+ state__add_warning(State, ?WARN_OPAQUE, Tree, {opaque_neq, Args})
+ end;
false ->
State
end;
add_bif_warnings(_, _, _, State) ->
State.
-is_int_float_eq_comp(T1, Op, T2) ->
+is_int_float_eq_comp(T1, Op, T2, Opaques) ->
(Op =:= '==' orelse Op =:= '/=') andalso
- ((erl_types:t_is_float(T1) andalso erl_types:t_is_integer(T2)) orelse
- (erl_types:t_is_integer(T1) andalso erl_types:t_is_float(T2))).
+ ((erl_types:t_is_float(T1, Opaques)
+ andalso t_is_integer(T2, Opaques)) orelse
+ (t_is_integer(T1, Opaques)
+ andalso erl_types:t_is_float(T2, Opaques))).
+
+comp_format_args([1|_], T1, Op, T2, State) ->
+ [format_type(T2, State), Op, format_type(T1, State)];
+comp_format_args(_, T1, Op, T2, State) ->
+ [format_type(T1, State), Op, format_type(T2, State)].
%%----------------------------------------
@@ -784,16 +790,27 @@ handle_bitstr(Tree, Map, State) ->
{State3, Map2, t_none()};
false ->
UnitVal = cerl:concrete(cerl:bitstr_unit(Tree)),
- Type =
- case t_number_vals(SizeType) of
- [OneSize] -> t_bitstr(0, OneSize * UnitVal);
- _ ->
- MinSize = erl_types:number_min(SizeType),
- t_bitstr(UnitVal, UnitVal * MinSize)
- end,
+ Opaques = State2#state.opaques,
+ NumberVals = t_number_vals(SizeType, Opaques),
+ {State3, Type} =
+ case t_contains_opaque(SizeType, Opaques) of
+ true ->
+ Msg = {opaque_size, [format_type(SizeType, State2),
+ format_cerl(Size)]},
+ {state__add_warning(State2, ?WARN_OPAQUE, Size, Msg),
+ t_none()};
+ false ->
+ case NumberVals of
+ [OneSize] -> {State2, t_bitstr(0, OneSize * UnitVal)};
+ unknown -> {State2, t_bitstr()};
+ _ ->
+ MinSize = erl_types:number_min(SizeType, Opaques),
+ {State2, t_bitstr(UnitVal, UnitVal * MinSize)}
+ end
+ end,
Map3 = enter_type_lists([Val, Size, Tree],
[ValType, SizeType, Type], Map2),
- {State2, Map3, Type}
+ {State3, Map3, Type}
end
end.
@@ -805,34 +822,47 @@ handle_call(Tree, Map, State) ->
Args = cerl:call_args(Tree),
MFAList = [M, F|Args],
{State1, Map1, [MType0, FType0|As]} = traverse_list(MFAList, Map, State),
- %% Module and function names should be treated as *structured terms*
- %% even if they happen to be identical to an atom (or tuple) which
- %% is also involved in the definition of an opaque data type.
- MType = t_inf(t_module(), t_unopaque(MType0)),
- FType = t_inf(t_atom(), t_unopaque(FType0)),
+ Opaques = State#state.opaques,
+ MType = t_inf(t_module(), MType0, Opaques),
+ FType = t_inf(t_atom(), FType0, Opaques),
Map2 = enter_type_lists([M, F], [MType, FType], Map1),
+ MOpaque = t_is_none(MType) andalso (not t_is_none(MType0)),
+ FOpaque = t_is_none(FType) andalso (not t_is_none(FType0)),
case any_none([MType, FType|As]) of
true ->
State2 =
- case t_is_none(MType) andalso (not t_is_none(MType0)) of
- true -> % This is a problem we just detected; not a known one
- MS = format_cerl(M),
- Msg = {app_call, [MS, format_cerl(F),
- format_args(Args, As, State1),
- MS, format_type(t_module(), State1),
- format_type(MType0, State1)]},
- state__add_warning(State1, ?WARN_FAILING_CALL, Tree, Msg);
- false ->
- case t_is_none(FType) andalso (not t_is_none(FType0)) of
- true ->
- FS = format_cerl(F),
- Msg = {app_call, [format_cerl(M), FS,
- format_args(Args, As, State1),
- FS, format_type(t_atom(), State1),
- format_type(FType0, State1)]},
- state__add_warning(State1, ?WARN_FAILING_CALL, Tree, Msg);
- false -> State1
- end
+ if
+ MOpaque -> % This is a problem we just detected; not a known one
+ MS = format_cerl(M),
+ case t_is_none(t_inf(t_module(), MType0)) of
+ true ->
+ Msg = {app_call, [MS, format_cerl(F),
+ format_args(Args, As, State1),
+ MS, format_type(t_module(), State1),
+ format_type(MType0, State1)]},
+ state__add_warning(State1, ?WARN_FAILING_CALL, Tree, Msg);
+ false ->
+ Msg = {opaque_call, [MS, format_cerl(F),
+ format_args(Args, As, State1),
+ MS, format_type(MType0, State1)]},
+ state__add_warning(State1, ?WARN_FAILING_CALL, Tree, Msg)
+ end;
+ FOpaque ->
+ FS = format_cerl(F),
+ case t_is_none(t_inf(t_atom(), FType0)) of
+ true ->
+ Msg = {app_call, [format_cerl(M), FS,
+ format_args(Args, As, State1),
+ FS, format_type(t_atom(), State1),
+ format_type(FType0, State1)]},
+ state__add_warning(State1, ?WARN_FAILING_CALL, Tree, Msg);
+ false ->
+ Msg = {opaque_call, [format_cerl(M), FS,
+ format_args(Args, As, State1),
+ FS, format_type(FType0, State1)]},
+ state__add_warning(State1, ?WARN_FAILING_CALL, Tree, Msg)
+ end;
+ true -> State1
end,
{State2, Map2, t_none()};
false ->
@@ -874,7 +904,7 @@ handle_case(Tree, Map, State) ->
handle_clauses(Clauses, Arg, ArgType, ArgType, State2,
[], Map2, [], []),
Map3 = join_maps_end(MapList, Map2),
- debug_pp_map(Map2),
+ debug_pp_map(Map3),
{State3, Map3, Type}
end.
@@ -886,7 +916,7 @@ handle_cons(Tree, Map, State) ->
{State1, Map1, HdType} = traverse(Hd, Map, State),
{State2, Map2, TlType} = traverse(Tl, Map1, State1),
State3 =
- case t_is_none(t_inf(TlType, t_list())) of
+ case t_is_none(t_inf(TlType, t_list(), State2#state.opaques)) of
true ->
Msg = {improper_list_constr, [format_type(TlType, State2)]},
state__add_warning(State2, ?WARN_NON_PROPER_LIST, Tree, Msg);
@@ -979,8 +1009,9 @@ handle_receive(Tree, Map, State) ->
[], []),
Map1 = join_maps(MapList, Map),
{State3, Map2, TimeoutType} = traverse(Timeout, Map1, State2),
- case (t_is_atom(TimeoutType) andalso
- (t_atom_vals(TimeoutType) =:= ['infinity'])) of
+ Opaques = State3#state.opaques,
+ case (t_is_atom(TimeoutType, Opaques) andalso
+ (t_atom_vals(TimeoutType, Opaques) =:= ['infinity'])) of
true ->
{State3, Map2, ReceiveType};
false ->
@@ -1031,55 +1062,46 @@ handle_tuple(Tree, Map, State) ->
true ->
{State1, Map1, t_none()};
false ->
- %% Let's find out if this is a record or opaque construction.
+ %% Let's find out if this is a record
case Elements of
[Tag|Left] ->
case cerl:is_c_atom(Tag) of
true ->
TagVal = cerl:atom_val(Tag),
- case t_opaque_match_record(TupleType, State1#state.opaques) of
- [Opaque] ->
- RecStruct = t_opaque_matching_structure(TupleType, Opaque),
- RecFields = t_tuple_args(RecStruct),
- case bind_pat_vars(Elements, RecFields, [], Map1, State1) of
- {error, _, ErrorPat, ErrorType, _} ->
- Msg = {record_constr,
- [TagVal, format_patterns(ErrorPat),
- format_type(ErrorType, State1)]},
- State2 = state__add_warning(State1, ?WARN_MATCHING,
- Tree, Msg),
- {State2, Map1, t_none()};
- {Map2, _ETypes} ->
- {State1, Map2, Opaque}
- end;
- _ ->
- case state__lookup_record(TagVal, length(Left), State1) of
- error -> {State1, Map1, TupleType};
- {ok, RecType} ->
- InfTupleType = t_inf(RecType, TupleType),
- case t_is_none(InfTupleType) of
- true ->
- RecC = format_type(TupleType, State1),
- FieldDiffs = format_field_diffs(TupleType, State1),
- Msg = {record_constr, [RecC, FieldDiffs]},
- State2 = state__add_warning(State1, ?WARN_MATCHING,
- Tree, Msg),
- {State2, Map1, t_none()};
- false ->
- case bind_pat_vars(Elements, t_tuple_args(RecType),
- [], Map1, State1) of
- {error, bind, ErrorPat, ErrorType, _} ->
- Msg = {record_constr,
- [TagVal, format_patterns(ErrorPat),
- format_type(ErrorType, State1)]},
- State2 = state__add_warning(State1, ?WARN_MATCHING,
- Tree, Msg),
- {State2, Map1, t_none()};
- {Map2, ETypes} ->
- {State1, Map2, t_tuple(ETypes)}
- end
- end
- end
+ case state__lookup_record(TagVal, length(Left), State1) of
+ error -> {State1, Map1, TupleType};
+ {ok, RecType} ->
+ InfTupleType = t_inf(RecType, TupleType),
+ case t_is_none(InfTupleType) of
+ true ->
+ RecC = format_type(TupleType, State1),
+ FieldDiffs = format_field_diffs(TupleType, State1),
+ Msg = {record_constr, [RecC, FieldDiffs]},
+ State2 = state__add_warning(State1, ?WARN_MATCHING,
+ Tree, Msg),
+ {State2, Map1, t_none()};
+ false ->
+ case bind_pat_vars(Elements, t_tuple_args(RecType),
+ [], Map1, State1) of
+ {error, bind, ErrorPat, ErrorType, _} ->
+ Msg = {record_constr,
+ [TagVal, format_patterns(ErrorPat),
+ format_type(ErrorType, State1)]},
+ State2 = state__add_warning(State1, ?WARN_MATCHING,
+ Tree, Msg),
+ {State2, Map1, t_none()};
+ {error, opaque, ErrorPat, ErrorType, OpaqueType} ->
+ Msg = {opaque_match,
+ [format_patterns(ErrorPat),
+ format_type(ErrorType, State1),
+ format_type(OpaqueType, State1)]},
+ State2 = state__add_warning(State1, ?WARN_OPAQUE,
+ Tree, Msg),
+ {State2, Map1, t_none()};
+ {Map2, ETypes} ->
+ {State1, Map2, t_tuple(ETypes)}
+ end
+ end
end;
false ->
{State1, Map1, t_tuple(EsType)}
@@ -1356,7 +1378,9 @@ bind_pat_vars_reverse(Pats, Types, Acc, Map, State) ->
end.
bind_pat_vars([Pat|PatLeft], [Type|TypeLeft], Acc, Map, State, Rev) ->
- ?debug("Binding pat: ~w to ~s\n", [cerl:type(Pat), format_type(Type, State)]),
+ ?debug("Binding pat: ~w to ~s\n", [cerl:type(Pat), format_type(Type, State)]
+),
+ Opaques = State#state.opaques,
{NewMap, TypeOut} =
case cerl:type(Pat) of
alias ->
@@ -1372,9 +1396,15 @@ bind_pat_vars([Pat|PatLeft], [Type|TypeLeft], Acc, Map, State, Rev) ->
case Rev of
true -> {Map, t_bitstr()};
false ->
- BinType = t_inf(t_bitstr(), Type),
+ BinType = t_inf(t_bitstr(), Type, Opaques),
case t_is_none(BinType) of
- true -> bind_error([Pat], Type, t_none(), bind);
+ true ->
+ case t_find_opaque_mismatch(t_bitstr(), Type) of
+ {ok, T1, T2} ->
+ bind_error([Pat], T1, T2, opaque);
+ error ->
+ bind_error([Pat], Type, t_none(), bind)
+ end;
false ->
Segs = cerl:binary_segments(Pat),
{Map1, SegTypes} = bind_bin_segs(Segs, BinType, Map, State),
@@ -1382,28 +1412,24 @@ bind_pat_vars([Pat|PatLeft], [Type|TypeLeft], Acc, Map, State, Rev) ->
end
end;
cons ->
- Cons = t_inf(Type, t_cons()),
+ Cons = t_inf(Type, t_cons(), Opaques),
case t_is_none(Cons) of
true ->
bind_opaque_pats(t_cons(), Type, Pat, Map, State, Rev);
false ->
{Map1, [HdType, TlType]} =
bind_pat_vars([cerl:cons_hd(Pat), cerl:cons_tl(Pat)],
- [t_cons_hd(Cons), t_cons_tl(Cons)],
+ [t_cons_hd(Cons, Opaques),
+ t_cons_tl(Cons, Opaques)],
[], Map, State, Rev),
{Map1, t_cons(HdType, TlType)}
end;
literal ->
Literal = literal_type(Pat),
- LiteralOrOpaque =
- case t_opaque_match_atom(Literal, State#state.opaques) of
- [Opaque] -> Opaque;
- _ -> Literal
- end,
- case t_is_none(t_inf(LiteralOrOpaque, Type)) of
+ case t_is_none(t_inf(Literal, Type, Opaques)) of
true ->
bind_opaque_pats(Literal, Type, Pat, Map, State, Rev);
- false -> {Map, LiteralOrOpaque}
+ false -> {Map, Literal}
end;
tuple ->
Es = cerl:tuple_es(Pat),
@@ -1419,27 +1445,28 @@ bind_pat_vars([Pat|PatLeft], [Type|TypeLeft], Acc, Map, State, Rev) ->
{ok, Record} ->
[_Head|AnyTail] = [t_any() || _ <- Es],
UntypedRecord = t_tuple([t_atom(TagAtom)|AnyTail]),
- {not erl_types:t_is_equal(Record, UntypedRecord), Record}
+ {not t_is_equal(Record, UntypedRecord), Record}
end;
false -> {false, t_tuple(length(Es))}
end
end,
- Tuple = t_inf(Prototype, Type),
+ Tuple = t_inf(Prototype, Type, Opaques),
case t_is_none(Tuple) of
true ->
bind_opaque_pats(Prototype, Type, Pat, Map, State, Rev);
false ->
- SubTuples = t_tuple_subtypes(Tuple),
+ SubTuples = t_tuple_subtypes(Tuple, Opaques),
%% Need to call the top function to get the try-catch wrapper
MapJ = join_maps_begin(Map),
Results =
case Rev of
true ->
- [bind_pat_vars_reverse(Es, t_tuple_args(SubTuple), [],
- MapJ, State)
+ [bind_pat_vars_reverse(Es, t_tuple_args(SubTuple, Opaques),
+ [], MapJ, State)
|| SubTuple <- SubTuples];
false ->
- [bind_pat_vars(Es, t_tuple_args(SubTuple), [], MapJ, State)
+ [bind_pat_vars(Es, t_tuple_args(SubTuple, Opaques), [],
+ MapJ, State)
|| SubTuple <- SubTuples]
end,
case lists:keyfind(opaque, 2, Results) of
@@ -1466,37 +1493,14 @@ bind_pat_vars([Pat|PatLeft], [Type|TypeLeft], Acc, Map, State, Rev) ->
bind_pat_vars(Es, t_to_tlist(Type), [], Map, State, Rev),
{Map1, t_product(EsTypes)};
var ->
- Opaques = State#state.opaques,
VarType1 =
case state__lookup_type_for_letrec(Pat, State) of
- error ->
- LType = lookup_type(Pat, Map),
- case t_opaque_match_record(LType, Opaques) of
- [Opaque] -> Opaque;
- _ ->
- case t_opaque_match_atom(LType, Opaques) of
- [Opaque] -> Opaque;
- _ -> LType
- end
- end;
+ error -> lookup_type(Pat, Map);
{ok, RecType} -> RecType
end,
%% Must do inf when binding args to pats. Vars in pats are fresh.
- VarType2 = t_inf(VarType1, Type),
- VarType3 =
- case Opaques =/= [] of
- true ->
- case t_opaque_match_record(VarType2, Opaques) of
- [OpaqueRec] -> OpaqueRec;
- _ ->
- case t_opaque_match_atom(VarType2, Opaques) of
- [OpaqueAtom] -> OpaqueAtom;
- _ -> VarType2
- end
- end;
- false -> VarType2
- end,
- case t_is_none(VarType3) of
+ VarType2 = t_inf(VarType1, Type, Opaques),
+ case t_is_none(VarType2) of
true ->
case t_find_opaque_mismatch(VarType1, Type) of
{ok, T1, T2} ->
@@ -1505,8 +1509,8 @@ bind_pat_vars([Pat|PatLeft], [Type|TypeLeft], Acc, Map, State, Rev) ->
bind_error([Pat], Type, t_none(), bind)
end;
false ->
- Map1 = enter_type(Pat, VarType3, Map),
- {Map1, VarType3}
+ Map1 = enter_type(Pat, VarType2, Map),
+ {Map1, VarType2}
end;
_Other ->
%% Catch all is needed when binding args to pats
@@ -1529,7 +1533,8 @@ bind_bin_segs([Seg|Segs], BinType, Acc, Map, State) ->
binary = SegType, [] = Segs, %% just an assert
T = t_inf(t_bitstr(UnitVal, 0), BinType),
{Map1, [Type]} = bind_pat_vars([Val], [T], [], Map, State, false),
- bind_bin_segs(Segs, t_bitstr(0, 0), [Type|Acc], Map1, State);
+ Type1 = remove_local_opaque_types(Type, State#state.opaques),
+ bind_bin_segs(Segs, t_bitstr(0, 0), [Type1|Acc], Map1, State);
utf -> % XXX: possibly can be strengthened
true = lists:member(SegType, [utf8, utf16, utf32]),
{Map1, [_]} = bind_pat_vars([Val], [t_integer()], [], Map, State, false),
@@ -1539,11 +1544,17 @@ bind_bin_segs([Seg|Segs], BinType, Acc, Map, State) ->
Size = cerl:bitstr_size(Seg),
{Map1, [SizeType]} =
bind_pat_vars([Size], [t_non_neg_integer()], [], Map, State, false),
+ Opaques = State#state.opaques,
+ NumberVals = t_number_vals(SizeType, Opaques),
+ case t_contains_opaque(SizeType, Opaques) of
+ true -> bind_error([Seg], SizeType, t_none(), opaque);
+ false -> ok
+ end,
Type =
- case t_number_vals(SizeType) of
+ case NumberVals of
[OneSize] -> t_bitstr(0, UnitVal * OneSize);
- _ ->
- MinSize = erl_types:number_min(SizeType),
+ _ -> % 'unknown' too
+ MinSize = erl_types:number_min(SizeType, Opaques),
t_bitstr(UnitVal, UnitVal * MinSize)
end,
ValConstr =
@@ -1551,7 +1562,7 @@ bind_bin_segs([Seg|Segs], BinType, Acc, Map, State) ->
binary -> Type; %% The same constraints as for the whole bitstr
float -> t_float();
integer ->
- case t_number_vals(SizeType) of
+ case NumberVals of
unknown -> t_integer();
List ->
SizeVal = lists:max(List),
@@ -1579,7 +1590,7 @@ bind_error(Pats, Type, OpaqueType, Error) ->
bind_opaque_pats(GenType, Type, Pat, Map, State, Rev) ->
case t_find_opaque_mismatch(GenType, Type) of
{ok, T1, T2} ->
- case lists:member(T2, State#state.opaques) of
+ case erl_types:is_opaque_type(T2, State#state.opaques) of
true ->
NewType = erl_types:t_struct_from_opaque(Type, [T2]),
{Map1, _} =
@@ -1700,19 +1711,9 @@ handle_guard_call(Guard, Map, Env, Eval, State) ->
handle_guard_gen_fun({M, F, A}, Guard, Map, Env, Eval, State) ->
Args = cerl:call_args(Guard),
- {Map1, As0} = bind_guard_list(Args, Map, Env, dont_know, State),
- MapFun = fun(Type) ->
- case lists:member(Type, State#state.opaques) of
- true -> erl_types:t_opaque_structure(Type);
- false -> Type
- end
- end,
- As = lists:map(MapFun, As0),
- Mode = case As =:= As0 of
- true -> structured;
- false -> opaque
- end,
- BifRet = erl_bif_types:type(M, F, A, As),
+ {Map1, As} = bind_guard_list(Args, Map, Env, dont_know, State),
+ Opaques = State#state.opaques,
+ BifRet = erl_bif_types:type(M, F, A, As, Opaques),
case t_is_none(BifRet) of
true ->
%% Is this an error-bif?
@@ -1721,11 +1722,8 @@ handle_guard_gen_fun({M, F, A}, Guard, Map, Env, Eval, State) ->
false -> signal_guard_fatal_fail(Eval, Guard, As, State)
end;
false ->
- BifArgs = case erl_bif_types:arg_types(M, F, A) of
- unknown -> lists:duplicate(A, t_any());
- List -> List
- end,
- Map2 = enter_type_lists(Args, t_inf_lists(BifArgs, As0, Mode), Map1),
+ BifArgs = bif_args(M, F, A),
+ Map2 = enter_type_lists(Args, t_inf_lists(BifArgs, As, Opaques), Map1),
Ret =
case Eval of
pos -> t_inf(t_atom(true), BifRet);
@@ -1771,29 +1769,19 @@ bind_type_test(Eval, TypeTest, ArgType, State) ->
is_reference -> t_reference();
is_tuple -> t_tuple()
end,
- Mode = determine_mode(ArgType, State#state.opaques),
case Eval of
pos ->
- Inf = t_inf(Type, ArgType, Mode),
+ Inf = t_inf(Type, ArgType, State#state.opaques),
case t_is_none(Inf) of
true -> error;
false -> {ok, Inf, t_atom(true)}
end;
neg ->
- case Mode of
- opaque ->
- Struct = erl_types:t_opaque_structure(ArgType),
- case t_is_none(t_subtract(Struct, Type)) of
- true -> error;
- false -> {ok, ArgType, t_atom(false)}
- end;
- structured ->
- Sub = t_subtract(ArgType, Type),
- case t_is_none(Sub) of
- true -> error;
- false -> {ok, Sub, t_atom(false)}
- end
- end;
+ Sub = t_subtract(ArgType, Type),
+ case t_is_none(Sub) of
+ true -> error;
+ false -> {ok, Sub, t_atom(false)}
+ end;
dont_know ->
{ok, ArgType, t_boolean()}
end.
@@ -1802,9 +1790,10 @@ handle_guard_comp(Guard, Comp, Map, Env, Eval, State) ->
Args = cerl:call_args(Guard),
[Arg1, Arg2] = Args,
{Map1, ArgTypes} = bind_guard_list(Args, Map, Env, dont_know, State),
+ Opaques = State#state.opaques,
[Type1, Type2] = ArgTypes,
- IsInt1 = t_is_integer(Type1),
- IsInt2 = t_is_integer(Type2),
+ IsInt1 = t_is_integer(Type1, Opaques),
+ IsInt2 = t_is_integer(Type2, Opaques),
case {cerl:type(Arg1), cerl:type(Arg2)} of
{literal, literal} ->
case erlang:Comp(cerl:concrete(Arg1), cerl:concrete(Arg2)) of
@@ -1817,12 +1806,13 @@ handle_guard_comp(Guard, Comp, Map, Env, Eval, State) ->
false when Eval =:= neg -> {Map, t_atom(false)}
end;
{literal, var} when IsInt1 andalso IsInt2 andalso (Eval =:= pos) ->
- case bind_comp_literal_var(Arg1, Arg2, Type2, Comp, Map1) of
+ case bind_comp_literal_var(Arg1, Arg2, Type2, Comp, Map1, Opaques) of
error -> signal_guard_fail(Eval, Guard, ArgTypes, State);
{ok, NewMap} -> {NewMap, t_atom(true)}
end;
{var, literal} when IsInt1 andalso IsInt2 andalso (Eval =:= pos) ->
- case bind_comp_literal_var(Arg2, Arg1, Type1, invert_comp(Comp), Map1) of
+ case bind_comp_literal_var(Arg2, Arg1, Type1, invert_comp(Comp),
+ Map1, Opaques) of
error -> signal_guard_fail(Eval, Guard, ArgTypes, State);
{ok, NewMap} -> {NewMap, t_atom(true)}
end;
@@ -1835,10 +1825,10 @@ invert_comp('<') -> '>';
invert_comp('>=') -> '=<';
invert_comp('>') -> '<'.
-bind_comp_literal_var(Lit, Var, VarType, CompOp, Map) ->
+bind_comp_literal_var(Lit, Var, VarType, CompOp, Map, Opaques) ->
LitVal = cerl:concrete(Lit),
NewVarType =
- case t_number_vals(VarType) of
+ case t_number_vals(VarType, Opaques) of
unknown ->
Range =
case CompOp of
@@ -1847,7 +1837,7 @@ bind_comp_literal_var(Lit, Var, VarType, CompOp, Map) ->
'>=' -> t_from_range(neg_inf, LitVal);
'>' -> t_from_range(neg_inf, LitVal - 1)
end,
- t_inf(Range, VarType);
+ t_inf(Range, VarType, Opaques);
NumberVals ->
NewNumberVals = [X || X <- NumberVals, erlang:CompOp(LitVal, X)],
t_integers(NewNumberVals)
@@ -1861,17 +1851,18 @@ handle_guard_is_function(Guard, Map, Env, Eval, State) ->
Args = cerl:call_args(Guard),
{Map1, ArgTypes0} = bind_guard_list(Args, Map, Env, dont_know, State),
[FunType0, ArityType0] = ArgTypes0,
- ArityType = t_inf(ArityType0, t_integer()),
+ Opaques = State#state.opaques,
+ ArityType = t_inf(ArityType0, t_integer(), Opaques),
case t_is_none(ArityType) of
true -> signal_guard_fail(Eval, Guard, ArgTypes0, State);
false ->
FunTypeConstr =
- case t_number_vals(ArityType) of
+ case t_number_vals(ArityType, State#state.opaques) of
unknown -> t_fun();
Vals ->
t_sup([t_fun(lists:duplicate(X, t_any()), t_any()) || X <- Vals])
end,
- FunType = t_inf(FunType0, FunTypeConstr),
+ FunType = t_inf(FunType0, FunTypeConstr, Opaques),
case t_is_none(FunType) of
true ->
case Eval of
@@ -1896,33 +1887,45 @@ handle_guard_is_record(Guard, Map, Env, Eval, State) ->
Arity = cerl:int_val(Arity0),
{Map1, RecType} = bind_guard(Rec, Map, Env, dont_know, State),
ArityMin1 = Arity - 1,
- TupleType =
- case state__lookup_record(Tag, ArityMin1, State) of
- error -> t_tuple([t_atom(Tag)|lists:duplicate(ArityMin1, t_any())]);
- {ok, Prototype} -> Prototype
- end,
- Mode = determine_mode(RecType, State#state.opaques),
- NewTupleType =
- case t_opaque_match_record(TupleType, State#state.opaques) of
- [Opaque] -> Opaque;
- _ -> TupleType
- end,
- Type = t_inf(NewTupleType, RecType, Mode),
- case t_is_none(Type) of
+ Opaques = State#state.opaques,
+ Tuple = t_tuple([t_atom(Tag)|lists:duplicate(ArityMin1, t_any())]),
+ case t_is_none(t_inf(Tuple, RecType, Opaques)) of
true ->
- case Eval of
- pos -> signal_guard_fail(Eval, Guard,
- [RecType, t_from_term(Tag),
- t_from_term(Arity)],
- State);
- neg -> {Map1, t_atom(false)};
- dont_know -> {Map1, t_atom(false)}
+ case erl_types:t_has_opaque_subtype(RecType, Opaques) of
+ true ->
+ signal_guard_fail(Eval, Guard,
+ [RecType, t_from_term(Tag),
+ t_from_term(Arity)],
+ State);
+ false ->
+ case Eval of
+ pos -> signal_guard_fail(Eval, Guard,
+ [RecType, t_from_term(Tag),
+ t_from_term(Arity)],
+ State);
+ neg -> {Map1, t_atom(false)};
+ dont_know -> {Map1, t_atom(false)}
+ end
end;
false ->
- case Eval of
- pos -> {enter_type(Rec, Type, Map1), t_atom(true)};
- neg -> {Map1, t_atom(false)};
- dont_know -> {Map1, t_boolean()}
+ TupleType =
+ case state__lookup_record(Tag, ArityMin1, State) of
+ error -> Tuple;
+ {ok, Prototype} -> Prototype
+ end,
+ Type = t_inf(TupleType, RecType, State#state.opaques),
+ case t_is_none(Type) of
+ true ->
+ %% No special handling of opaque errors.
+ FArgs = "record " ++ format_type(RecType, State),
+ Msg = {record_matching, [FArgs, Tag]},
+ throw({fail, {Guard, Msg}});
+ false ->
+ case Eval of
+ pos -> {enter_type(Rec, Type, Map1), t_atom(true)};
+ neg -> {Map1, t_atom(false)};
+ dont_know -> {Map1, t_boolean()}
+ end
end
end.
@@ -1975,14 +1978,24 @@ handle_guard_eq(Guard, Map, Env, Eval, State) ->
bind_eq_guard(Guard, Arg1, Arg2, Map, Env, Eval, State) ->
{Map1, Type1} = bind_guard(Arg1, Map, Env, dont_know, State),
{Map2, Type2} = bind_guard(Arg2, Map1, Env, dont_know, State),
- case (t_is_nil(Type1) orelse t_is_nil(Type2) orelse
- t_is_atom(Type1) orelse t_is_atom(Type2)) of
+ Opaques = State#state.opaques,
+ case
+ t_is_nil(Type1, Opaques) orelse t_is_nil(Type2, Opaques)
+ orelse t_is_atom(Type1, Opaques) orelse t_is_atom(Type2, Opaques)
+ of
true -> bind_eqeq_guard(Guard, Arg1, Arg2, Map, Env, Eval, State);
false ->
- case Eval of
- pos -> {Map2, t_atom(true)};
- neg -> {Map2, t_atom(false)};
- dont_know -> {Map2, t_boolean()}
+ %% XXX. Is this test OK?
+ OpArgs = erl_types:t_find_unknown_opaque(Type1, Type2, Opaques),
+ case OpArgs =:= [] of
+ true ->
+ case Eval of
+ pos -> {Map2, t_atom(true)};
+ neg -> {Map2, t_atom(false)};
+ dont_know -> {Map2, t_boolean()}
+ end;
+ false ->
+ signal_guard_fail(Eval, Guard, [Type1, Type2], State)
end
end.
@@ -2021,44 +2034,52 @@ bind_eqeq_guard(Guard, Arg1, Arg2, Map, Env, Eval, State) ->
{Map2, Type2} = bind_guard(Arg2, Map1, Env, dont_know, State),
?debug("Types are:~s =:= ~s\n", [t_to_string(Type1),
t_to_string(Type2)]),
- Inf = t_inf(Type1, Type2),
+ Opaques = State#state.opaques,
+ Inf = t_inf(Type1, Type2, Opaques),
case t_is_none(Inf) of
true ->
- case Eval of
- neg -> {Map2, t_atom(false)};
- dont_know -> {Map2, t_atom(false)};
- pos -> signal_guard_fail(Eval, Guard, [Type1, Type2], State)
+ OpArgs = erl_types:t_find_unknown_opaque(Type1, Type2, Opaques),
+ case OpArgs =:= [] of
+ true ->
+ case Eval of
+ neg -> {Map2, t_atom(false)};
+ dont_know -> {Map2, t_atom(false)};
+ pos -> signal_guard_fail(Eval, Guard, [Type1, Type2], State)
+ end;
+ false ->
+ signal_guard_fail(Eval, Guard, [Type1, Type2], State)
end;
false ->
case Eval of
- pos ->
- case {cerl:type(Arg1), cerl:type(Arg2)} of
- {var, var} ->
- Map3 = enter_subst(Arg1, Arg2, Map2),
- Map4 = enter_type(Arg2, Inf, Map3),
- {Map4, t_atom(true)};
- {var, _} ->
- Map3 = enter_type(Arg1, Inf, Map2),
- {Map3, t_atom(true)};
- {_, var} ->
- Map3 = enter_type(Arg2, Inf, Map2),
- {Map3, t_atom(true)};
- {_, _} ->
- {Map2, t_atom(true)}
- end;
- neg ->
- {Map2, t_atom(false)};
- dont_know ->
- {Map2, t_boolean()}
+ pos ->
+ case {cerl:type(Arg1), cerl:type(Arg2)} of
+ {var, var} ->
+ Map3 = enter_subst(Arg1, Arg2, Map2),
+ Map4 = enter_type(Arg2, Inf, Map3),
+ {Map4, t_atom(true)};
+ {var, _} ->
+ Map3 = enter_type(Arg1, Inf, Map2),
+ {Map3, t_atom(true)};
+ {_, var} ->
+ Map3 = enter_type(Arg2, Inf, Map2),
+ {Map3, t_atom(true)};
+ {_, _} ->
+ {Map2, t_atom(true)}
+ end;
+ neg ->
+ {Map2, t_atom(false)};
+ dont_know ->
+ {Map2, t_boolean()}
end
end.
bind_eqeq_guard_lit_other(Guard, Arg1, Arg2, Map, Env, State) ->
Eval = dont_know,
+ Opaques = State#state.opaques,
case cerl:concrete(Arg1) of
true ->
{_, Type} = MT = bind_guard(Arg2, Map, Env, pos, State),
- case t_is_atom(true, Type) of
+ case t_is_any_atom(true, Type, Opaques) of
true -> MT;
false ->
{_, Type0} = bind_guard(Arg2, Map, Env, Eval, State),
@@ -2066,7 +2087,7 @@ bind_eqeq_guard_lit_other(Guard, Arg1, Arg2, Map, Env, State) ->
end;
false ->
{Map1, Type} = bind_guard(Arg2, Map, Env, neg, State),
- case t_is_atom(false, Type) of
+ case t_is_any_atom(false, Type, Opaques) of
true -> {Map1, t_atom(true)};
false ->
{_, Type0} = bind_guard(Arg2, Map, Env, Eval, State),
@@ -2087,14 +2108,15 @@ bind_eqeq_guard_lit_other(Guard, Arg1, Arg2, Map, Env, State) ->
handle_guard_and(Guard, Map, Env, Eval, State) ->
[Arg1, Arg2] = cerl:call_args(Guard),
+ Opaques = State#state.opaques,
case Eval of
pos ->
{Map1, Type1} = bind_guard(Arg1, Map, Env, Eval, State),
- case t_is_atom(true, Type1) of
+ case t_is_any_atom(true, Type1, Opaques) of
false -> signal_guard_fail(Eval, Guard, [Type1, t_any()], State);
true ->
{Map2, Type2} = bind_guard(Arg2, Map1, Env, Eval, State),
- case t_is_atom(true, Type2) of
+ case t_is_any_atom(true, Type2, Opaques) of
false -> signal_guard_fail(Eval, Guard, [Type1, Type2], State);
true -> {Map2, t_atom(true)}
end
@@ -2109,7 +2131,10 @@ handle_guard_and(Guard, Map, Env, Eval, State) ->
try bind_guard(Arg2, MapJ, Env, neg, State)
catch throw:{fail, _} -> bind_guard(Arg1, MapJ, Env, pos, State)
end,
- case t_is_atom(false, Type1) orelse t_is_atom(false, Type2) of
+ case
+ t_is_any_atom(false, Type1, Opaques)
+ orelse t_is_any_atom(false, Type2, Opaques)
+ of
true -> {join_maps_end([Map1, Map2], MapJ), t_atom(false)};
false -> signal_guard_fail(Eval, Guard, [Type1, Type2], State)
end;
@@ -2124,11 +2149,16 @@ handle_guard_and(Guard, Map, Env, Eval, State) ->
false ->
NewMap = join_maps_end([Map1, Map2], MapJ),
NewType =
- case {t_atom_vals(Bool1), t_atom_vals(Bool2)} of
+ case {t_atom_vals(Bool1, Opaques), t_atom_vals(Bool2, Opaques)} of
{['true'] , ['true'] } -> t_atom(true);
{['false'], _ } -> t_atom(false);
{_ , ['false']} -> t_atom(false);
+ {unknown , _ } ->
+ signal_guard_fail(Eval, Guard, [Type1, Type2], State);
+ {_ , unknown } ->
+ signal_guard_fail(Eval, Guard, [Type1, Type2], State);
{_ , _ } -> t_boolean()
+
end,
{NewMap, NewType}
end
@@ -2136,6 +2166,7 @@ handle_guard_and(Guard, Map, Env, Eval, State) ->
handle_guard_or(Guard, Map, Env, Eval, State) ->
[Arg1, Arg2] = cerl:call_args(Guard),
+ Opaques = State#state.opaques,
case Eval of
pos ->
MapJ = join_maps_begin(Map),
@@ -2149,19 +2180,23 @@ handle_guard_or(Guard, Map, Env, Eval, State) ->
catch
throw:{fail,_} -> bind_guard(Arg2, MapJ, Env, dont_know, State)
end,
- case ((t_is_atom(true, Bool1) andalso t_is_boolean(Bool2))
- orelse
- (t_is_atom(true, Bool2) andalso t_is_boolean(Bool1))) of
+ case
+ ((t_is_any_atom(true, Bool1, Opaques)
+ andalso t_is_boolean(Bool2, Opaques))
+ orelse
+ (t_is_any_atom(true, Bool2, Opaques)
+ andalso t_is_boolean(Bool1, Opaques)))
+ of
true -> {join_maps_end([Map1, Map2], MapJ), t_atom(true)};
false -> signal_guard_fail(Eval, Guard, [Bool1, Bool2], State)
end;
neg ->
{Map1, Type1} = bind_guard(Arg1, Map, Env, neg, State),
- case t_is_atom(false, Type1) of
+ case t_is_any_atom(false, Type1, Opaques) of
false -> signal_guard_fail(Eval, Guard, [Type1, t_any()], State);
true ->
{Map2, Type2} = bind_guard(Arg2, Map1, Env, neg, State),
- case t_is_atom(false, Type2) of
+ case t_is_any_atom(false, Type2, Opaques) of
false -> signal_guard_fail(Eval, Guard, [Type1, Type2], State);
true -> {Map2, t_atom(false)}
end
@@ -2177,10 +2212,14 @@ handle_guard_or(Guard, Map, Env, Eval, State) ->
false ->
NewMap = join_maps_end([Map1, Map2], MapJ),
NewType =
- case {t_atom_vals(Bool1), t_atom_vals(Bool2)} of
+ case {t_atom_vals(Bool1, Opaques), t_atom_vals(Bool2, Opaques)} of
{['false'], ['false']} -> t_atom(false);
{['true'] , _ } -> t_atom(true);
{_ , ['true'] } -> t_atom(true);
+ {unknown , _ } ->
+ signal_guard_fail(Eval, Guard, [Type1, Type2], State);
+ {_ , unknown } ->
+ signal_guard_fail(Eval, Guard, [Type1, Type2], State);
{_ , _ } -> t_boolean()
end,
{NewMap, NewType}
@@ -2189,10 +2228,11 @@ handle_guard_or(Guard, Map, Env, Eval, State) ->
handle_guard_not(Guard, Map, Env, Eval, State) ->
[Arg] = cerl:call_args(Guard),
+ Opaques = State#state.opaques,
case Eval of
neg ->
{Map1, Type} = bind_guard(Arg, Map, Env, pos, State),
- case t_is_atom(true, Type) of
+ case t_is_any_atom(true, Type, Opaques) of
true -> {Map1, t_atom(false)};
false ->
{_, Type0} = bind_guard(Arg, Map, Env, Eval, State),
@@ -2200,7 +2240,7 @@ handle_guard_not(Guard, Map, Env, Eval, State) ->
end;
pos ->
{Map1, Type} = bind_guard(Arg, Map, Env, neg, State),
- case t_is_atom(false, Type) of
+ case t_is_any_atom(false, Type, Opaques) of
true -> {Map1, t_atom(true)};
false ->
{_, Type0} = bind_guard(Arg, Map, Env, Eval, State),
@@ -2212,10 +2252,11 @@ handle_guard_not(Guard, Map, Env, Eval, State) ->
case t_is_none(Bool) of
true -> throw({fatal_fail, none});
false ->
- case t_atom_vals(Bool) of
+ case t_atom_vals(Bool, Opaques) of
['true'] -> {Map1, t_atom(false)};
['false'] -> {Map1, t_atom(true)};
- [_, _] -> {Map1, Bool}
+ [_, _] -> {Map1, Bool};
+ unknown -> signal_guard_fail(Eval, Guard, [Type], State)
end
end
end.
@@ -2235,27 +2276,40 @@ bind_guard_list([], Map, _Env, _Eval, _State, Acc) ->
state()) -> no_return().
signal_guard_fail(Eval, Guard, ArgTypes, State) ->
+ signal_guard_failure(Eval, Guard, ArgTypes, fail, State).
+
+signal_guard_fatal_fail(Eval, Guard, ArgTypes, State) ->
+ signal_guard_failure(Eval, Guard, ArgTypes, fatal_fail, State).
+
+signal_guard_failure(Eval, Guard, ArgTypes, Tag, State) ->
Args = cerl:call_args(Guard),
F = cerl:atom_val(cerl:call_name(Guard)),
- MFA = {cerl:atom_val(cerl:call_module(Guard)), F, length(Args)},
- Msg =
+ {M, F, A} = MFA = {cerl:atom_val(cerl:call_module(Guard)), F, length(Args)},
+ Opaques = State#state.opaques,
+ {Kind, XInfo} =
+ case erl_bif_types:opaque_args(M, F, A, ArgTypes, Opaques) of
+ [] ->
+ {case Eval of
+ neg -> neg_guard_fail;
+ pos -> guard_fail;
+ dont_know -> guard_fail
+ end,
+ []};
+ Ns -> {opaque_guard, [Ns]}
+ end,
+ FArgs =
case is_infix_op(MFA) of
true ->
[ArgType1, ArgType2] = ArgTypes,
[Arg1, Arg2] = Args,
- Kind =
- case Eval of
- neg -> neg_guard_fail;
- pos -> guard_fail;
- dont_know -> guard_fail
- end,
- {Kind, [format_args_1([Arg1], [ArgType1], State),
- atom_to_list(F),
- format_args_1([Arg2], [ArgType2], State)]};
+ [format_args_1([Arg1], [ArgType1], State),
+ atom_to_list(F),
+ format_args_1([Arg2], [ArgType2], State)] ++ XInfo;
false ->
- mk_guard_msg(Eval, F, Args, ArgTypes, State)
+ [F, format_args(Args, ArgTypes, State)]
end,
- throw({fail, {Guard, Msg}}).
+ Msg = {Kind, FArgs},
+ throw({Tag, {Guard, Msg}}).
is_infix_op({erlang, '=:=', 2}) -> true;
is_infix_op({erlang, '==', 2}) -> true;
@@ -2268,25 +2322,10 @@ is_infix_op({erlang, '>=', 2}) -> true;
is_infix_op({M, F, A}) when is_atom(M), is_atom(F),
is_integer(A), 0 =< A, A =< 255 -> false.
--spec signal_guard_fatal_fail(eval(), cerl:c_call(), [erl_types:erl_type()],
- state()) -> no_return().
-
-signal_guard_fatal_fail(Eval, Guard, ArgTypes, State) ->
- Args = cerl:call_args(Guard),
- F = cerl:atom_val(cerl:call_name(Guard)),
- Msg = mk_guard_msg(Eval, F, Args, ArgTypes, State),
- throw({fatal_fail, {Guard, Msg}}).
-
-mk_guard_msg(Eval, F, Args, ArgTypes, State) ->
- FArgs = [F, format_args(Args, ArgTypes, State)],
- case any_has_opaque_subtype(ArgTypes) of
- true -> {opaque_guard, FArgs};
- false ->
- case Eval of
- neg -> {neg_guard_fail, FArgs};
- pos -> {guard_fail, FArgs};
- dont_know -> {guard_fail, FArgs}
- end
+bif_args(M, F, A) ->
+ case erl_bif_types:arg_types(M, F, A) of
+ unknown -> lists:duplicate(A, t_any());
+ List -> List
end.
bind_guard_case_clauses(Arg, Clauses, Map0, Env, Eval, State) ->
@@ -2366,14 +2405,15 @@ bind_guard_case_clauses(GenArgType, GenMap, ArgExpr, [Clause|Left],
end,
{NewMap3, CType} = bind_guard(cerl:clause_body(Clause), NewMap2,
Env, Eval, State),
+ Opaques = State#state.opaques,
case Eval of
pos ->
- case t_is_atom(true, CType) of
+ case t_is_any_atom(true, CType, Opaques) of
true -> ok;
false -> throw({fail, none})
end;
neg ->
- case t_is_atom(false, CType) of
+ case t_is_any_atom(false, CType, Opaques) of
true -> ok;
false -> throw({fail, none})
end;
@@ -2501,8 +2541,11 @@ enter_type(Key, Val, MS) ->
error ->
?debug("Entering ~p :: ~s\n", [KeyLabel, t_to_string(Val)]),
case dict:find(KeyLabel, Dict) of
- {ok, Val} -> MS;
- {ok, _OldVal} -> store_map(KeyLabel, Val, MS);
+ {ok, Value} ->
+ case erl_types:t_is_equal(Val, Value) of
+ true -> MS;
+ false -> store_map(KeyLabel, Val, MS)
+ end;
error -> store_map(KeyLabel, Val, MS)
end
end
@@ -2611,10 +2654,15 @@ get_label(L) when is_integer(L) ->
get_label(T) ->
cerl_trees:get_label(T).
-t_is_simple(ArgType) ->
- t_is_atom(ArgType) orelse t_is_number(ArgType) orelse t_is_port(ArgType)
- orelse t_is_pid(ArgType) orelse t_is_reference(ArgType)
- orelse t_is_nil(ArgType).
+t_is_simple(ArgType, State) ->
+ Opaques = State#state.opaques,
+ t_is_atom(ArgType, Opaques) orelse t_is_number(ArgType, Opaques)
+ orelse t_is_port(ArgType, Opaques)
+ orelse t_is_pid(ArgType, Opaques) orelse t_is_reference(ArgType, Opaques)
+ orelse t_is_nil(ArgType, Opaques).
+
+remove_local_opaque_types(Type, Opaques) ->
+ t_unopaque(Type, Opaques).
%% t_is_structured(ArgType) ->
%% case t_is_nil(ArgType) of
@@ -2638,12 +2686,6 @@ is_call_to_send(Tree) ->
andalso (Arity =:= 2)
end.
-any_opaque(Ts) ->
- lists:any(fun erl_types:t_is_opaque/1, Ts).
-
-any_has_opaque_subtype(Ts) ->
- lists:any(fun erl_types:t_has_opaque_subtype/1, Ts).
-
filter_match_fail([Clause] = Cls) ->
Body = cerl:clause_body(Clause),
case cerl:type(Body) of
@@ -2662,12 +2704,6 @@ filter_match_fail([]) ->
%% receive after 1 -> ok end
[].
-determine_mode(Type, Opaques) ->
- case lists:member(Type, Opaques) of
- true -> opaque;
- false -> structured
- end.
-
%%% ===========================================================================
%%%
%%% The State.
@@ -2679,7 +2715,7 @@ state__new(Callgraph, Tree, Plt, Module, Records) ->
erl_types:t_opaque_from_records(Records),
TreeMap = build_tree_map(Tree),
Funs = dict:fetch_keys(TreeMap),
- FunTab = init_fun_tab(Funs, dict:new(), TreeMap, Callgraph, Plt, Opaques),
+ FunTab = init_fun_tab(Funs, dict:new(), TreeMap, Callgraph, Plt),
ExportedFuns =
[Fun || Fun <- Funs--[top], dialyzer_callgraph:is_escaping(Fun, Callgraph)],
Work = init_work(ExportedFuns),
@@ -2740,12 +2776,14 @@ state__add_warning(#state{warnings = Warnings, warning_mode = true} = State,
case Force of
true ->
Warn = {Tag, {get_file(Ann), abs(get_line(Ann))}, Msg},
+ ?debug("MSG ~s\n", [dialyzer:format_warning(Warn)]),
State#state{warnings = [Warn|Warnings]};
false ->
case is_compiler_generated(Ann) of
true -> State;
false ->
Warn = {Tag, {get_file(Ann), get_line(Ann)}, Msg},
+ ?debug("MSG ~s\n", [dialyzer:format_warning(Warn)]),
State#state{warnings = [Warn|Warnings]}
end
end.
@@ -2875,10 +2913,10 @@ build_tree_map(Tree) ->
end,
cerl_trees:fold(Fun, dict:new(), Tree).
-init_fun_tab([top|Left], Dict, TreeMap, Callgraph, Plt, Opaques) ->
+init_fun_tab([top|Left], Dict, TreeMap, Callgraph, Plt) ->
NewDict = dict:store(top, {[], t_none()}, Dict),
- init_fun_tab(Left, NewDict, TreeMap, Callgraph, Plt, Opaques);
-init_fun_tab([Fun|Left], Dict, TreeMap, Callgraph, Plt, Opaques) ->
+ init_fun_tab(Left, NewDict, TreeMap, Callgraph, Plt);
+init_fun_tab([Fun|Left], Dict, TreeMap, Callgraph, Plt) ->
Arity = cerl:fun_arity(dict:fetch(Fun, TreeMap)),
FunEntry =
case dialyzer_callgraph:is_escaping(Fun, Callgraph) of
@@ -2895,8 +2933,8 @@ init_fun_tab([Fun|Left], Dict, TreeMap, Callgraph, Plt, Opaques) ->
false -> {not_handled, {lists:duplicate(Arity, t_none()), t_unit()}}
end,
NewDict = dict:store(Fun, FunEntry, Dict),
- init_fun_tab(Left, NewDict, TreeMap, Callgraph, Plt, Opaques);
-init_fun_tab([], Dict, _TreeMap, _Callgraph, _Plt, _Opaques) ->
+ init_fun_tab(Left, NewDict, TreeMap, Callgraph, Plt);
+init_fun_tab([], Dict, _TreeMap, _Callgraph, _Plt) ->
?debug("DICT:~p\n",[dict:to_list(Dict)]),
Dict.
@@ -2945,34 +2983,27 @@ state__update_fun_entry(Tree, ArgTypes, Out0,
if Fun =:= top -> Out0;
true ->
case lookup_fun_sig(Fun, CG, Plt) of
- {value, {SigRet, _}} -> t_inf(SigRet, Out0, opaque);
+ {value, {SigRet, _}} -> t_inf(SigRet, Out0);
none -> Out0
end
end,
Out = t_limit(Out1, ?TYPE_LIMIT),
- case dict:find(Fun, FunTab) of
- {ok, {ArgTypes, OldOut}} ->
- case t_is_equal(OldOut, Out) of
- true ->
- ?debug("Fixpoint for ~w: ~s\n",
- [state__lookup_name(Fun, State),
- t_to_string(t_fun(ArgTypes, Out))]),
- State;
- false ->
- NewEntry = {ArgTypes, Out},
- ?debug("New Entry for ~w: ~s\n",
- [state__lookup_name(Fun, State),
- t_to_string(t_fun(ArgTypes, Out))]),
- NewFunTab = dict:store(Fun, NewEntry, FunTab),
- State1 = State#state{fun_tab = NewFunTab},
- state__add_work_from_fun(Tree, State1)
- end;
- {ok, {NewArgTypes, _OldOut}} ->
- %% Can only happen in self-recursive functions. Only update the out type.
- NewEntry = {NewArgTypes, Out},
+ {ok, {OldArgTypes, OldOut}} = dict:find(Fun, FunTab),
+ SameArgs = lists:all(fun({A, B}) -> erl_types:t_is_equal(A, B)
+ end, lists:zip(OldArgTypes, ArgTypes)),
+ SameOut = t_is_equal(OldOut, Out),
+ if
+ SameArgs, SameOut ->
+ ?debug("Fixpoint for ~w: ~s\n",
+ [state__lookup_name(Fun, State),
+ t_to_string(t_fun(ArgTypes, Out))]),
+ State;
+ true ->
+ %% Can only happen in self-recursive functions.
+ NewEntry = {OldArgTypes, Out},
?debug("New Entry for ~w: ~s\n",
[state__lookup_name(Fun, State),
- t_to_string(t_fun(NewArgTypes, Out))]),
+ t_to_string(t_fun(OldArgTypes, Out))]),
NewFunTab = dict:store(Fun, NewEntry, FunTab),
State1 = State#state{fun_tab = NewFunTab},
state__add_work_from_fun(Tree, State1)
@@ -2993,7 +3024,7 @@ state__add_work_from_fun(Tree, #state{callgraph = Callgraph,
%% Must filter the result for results in this module.
FilteredList = [L || {ok, L} <- LabelList, dict:is_key(L, TreeMap)],
?debug("~w: Will try to add:~w\n",
- [state__lookup_name(get_label(Tree), State), MFAList]),
+ [state__lookup_name(Label, State), MFAList]),
lists:foldl(fun(L, AccState) ->
state__add_work(L, AccState)
end, State, FilteredList)
@@ -3054,7 +3085,8 @@ forward_args(Fun, ArgTypes, #state{work = Work, fun_tab = FunTab} = State) ->
case Fixpoint of
true -> State;
false ->
- NewArgTypes = [t_sup(X, Y) || {X, Y} <- lists:zip(ArgTypes, OldArgTypes)],
+ NewArgTypes = [t_sup(X, Y) ||
+ {X, Y} <- lists:zip(ArgTypes, OldArgTypes)],
NewWork = add_work(Fun, Work),
?debug("~w: forwarding args ~s\n",
[state__lookup_name(Fun, State),
@@ -3238,13 +3270,13 @@ format_field_diffs(RecConstruction, #state{records = R}) ->
-spec format_sig_args(erl_types:erl_type(), state()) -> string().
-format_sig_args(Type, #state{records = R}) ->
- SigArgs = t_fun_args(Type),
+format_sig_args(Type, #state{opaques = Opaques} = State) ->
+ SigArgs = t_fun_args(Type, Opaques),
case SigArgs of
[] -> "()";
[SArg|SArgs] ->
- lists:flatten("(" ++ t_to_string(SArg, R)
- ++ ["," ++ t_to_string(T, R) || T <- SArgs] ++ ")")
+ lists:flatten("(" ++ format_type(SArg, State)
+ ++ ["," ++ format_type(T, State) || T <- SArgs] ++ ")")
end.
format_cerl(Tree) ->
diff --git a/lib/dialyzer/src/dialyzer_succ_typings.erl b/lib/dialyzer/src/dialyzer_succ_typings.erl
index 84379642bf..f0488b5ee3 100644
--- a/lib/dialyzer/src/dialyzer_succ_typings.erl
+++ b/lib/dialyzer/src/dialyzer_succ_typings.erl
@@ -2,7 +2,7 @@
%%-----------------------------------------------------------------------
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2006-2012. All Rights Reserved.
+%% Copyright Ericsson AB 2006-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -149,8 +149,10 @@ get_warnings(Callgraph, Plt, DocPlt, Codeserver,
NewState = InitState#st{no_warn_unused = NoWarnUnused},
Mods = dialyzer_callgraph:modules(NewState#st.callgraph),
MiniPlt = NewState#st.plt,
+ FindOpaques = lookup_and_find_opaques_fun(Codeserver),
CWarns =
- dialyzer_contracts:get_invalid_contract_warnings(Mods, Codeserver, MiniPlt),
+ dialyzer_contracts:get_invalid_contract_warnings(Mods, Codeserver,
+ MiniPlt, FindOpaques),
MiniDocPlt = dialyzer_plt:get_mini_plt(DocPlt),
ModWarns =
?timing(TimingServer, "warning",
@@ -261,7 +263,16 @@ refine_one_module(M, {CodeServer, Callgraph, Plt, _Solvers}) ->
FunTypes = get_fun_types_from_plt(AllFuns, Callgraph, Plt),
NewFunTypes =
dialyzer_dataflow:get_fun_types(ModCode, Plt, Callgraph, Records),
- case reached_fixpoint(FunTypes, NewFunTypes) of
+ Contracts1 = dialyzer_codeserver:lookup_mod_contracts(M, CodeServer),
+ Contracts = orddict:from_list(dict:to_list(Contracts1)),
+ FindOpaques = find_opaques_fun(Records),
+ DecoratedFunTypes =
+ decorate_succ_typings(Contracts, Callgraph, NewFunTypes, FindOpaques),
+ %% ?debug("NewFunTypes ~p\n ~n", [dict:to_list(NewFunTypes)]),
+ %% ?debug("refine DecoratedFunTypes ~p\n ~n", [dict:to_list(DecoratedFunTypes)]),
+ debug_pp_functions("Refine", NewFunTypes, DecoratedFunTypes, Callgraph),
+
+ case reached_fixpoint(FunTypes, DecoratedFunTypes) of
true -> [];
{false, NotFixpoint} ->
?debug("Not fixpoint\n", []),
@@ -357,9 +368,16 @@ find_succ_types_for_scc(SCC, {Codeserver, Callgraph, Plt, Solvers}) ->
AllFunSet = sets:from_list([X || {X, _} <- AllFuns]),
FilteredFunTypes =
dict:filter(fun(X, _) -> sets:is_element(X, AllFunSet) end, FunTypes),
+ FindOpaques = lookup_and_find_opaques_fun(Codeserver),
+ DecoratedFunTypes =
+ decorate_succ_typings(Contracts3, Callgraph, FilteredFunTypes, FindOpaques),
%% Check contracts
PltContracts =
- dialyzer_contracts:check_contracts(Contracts3, Callgraph, FilteredFunTypes),
+ dialyzer_contracts:check_contracts(Contracts3, Callgraph,
+ DecoratedFunTypes, FindOpaques),
+ %% ?debug("FilteredFunTypes ~p\n ~n", [dict:to_list(FilteredFunTypes)]),
+ %% ?debug("SCC DecoratedFunTypes ~p\n ~n", [dict:to_list(DecoratedFunTypes)]),
+ debug_pp_functions("SCC", FilteredFunTypes, DecoratedFunTypes, Callgraph),
ContractFixpoint =
lists:all(fun({MFA, _C}) ->
%% Check the non-deleted PLT
@@ -368,16 +386,47 @@ find_succ_types_for_scc(SCC, {Codeserver, Callgraph, Plt, Solvers}) ->
{value, _} -> true
end
end, PltContracts),
- Plt = insert_into_plt(FilteredFunTypes, Callgraph, Plt),
+ Plt = insert_into_plt(DecoratedFunTypes, Callgraph, Plt),
Plt = dialyzer_plt:insert_contract_list(Plt, PltContracts),
case (ContractFixpoint andalso
- reached_fixpoint_strict(PropTypes, FilteredFunTypes)) of
+ reached_fixpoint_strict(PropTypes, DecoratedFunTypes)) of
true -> [];
false ->
?debug("Not fixpoint for: ~w\n", [AllFuns]),
[Fun || {Fun, _Arity} <- AllFuns]
end.
+decorate_succ_typings(Contracts, Callgraph, FunTypes, FindOpaques) ->
+ F = fun(Label, Type) ->
+ case dialyzer_callgraph:lookup_name(Label, Callgraph) of
+ {ok, MFA} ->
+ case orddict:find(MFA, Contracts) of
+ {ok, {_FileLine, Contract}} ->
+ Args = dialyzer_contracts:get_contract_args(Contract),
+ Ret = dialyzer_contracts:get_contract_return(Contract),
+ C = erl_types:t_fun(Args, Ret),
+ {M, _, _} = MFA,
+ Opaques = FindOpaques(M),
+ erl_types:t_decorate_with_opaque(Type, C, Opaques);
+ error -> Type
+ end;
+ error -> Type
+ end
+ end,
+ dict:map(F, FunTypes).
+
+lookup_and_find_opaques_fun(Codeserver) ->
+ fun(Module) ->
+ Records = dialyzer_codeserver:lookup_mod_records(Module, Codeserver),
+ (find_opaques_fun(Records))(Module)
+ end.
+
+find_opaques_fun(Records) ->
+ fun(Module) ->
+ erl_types:module_builtin_opaques(Module) ++
+ erl_types:t_opaque_from_records(Records)
+ end.
+
get_fun_types_from_plt(FunList, Callgraph, Plt) ->
get_fun_types_from_plt(FunList, Callgraph, Plt, dict:new()).
@@ -443,9 +492,30 @@ debug_pp_succ_typings(SuccTypes) ->
|| {MFA, {contract, RetFun, ArgT}} <- SuccTypes],
?debug("\n", []),
ok.
+
+debug_pp_functions(Header, FunTypes, DecoratedFunTypes, Callgraph) ->
+ ?debug("FunTypes (~s)\n", [Header]),
+ FTypes = lists:keysort(1, dict:to_list(FunTypes)),
+ DTypes = lists:keysort(1, dict:to_list(DecoratedFunTypes)),
+ Fun = fun({{Label, Type},{Label, DecoratedType}}) ->
+ Name = lookup_name(Label, Callgraph),
+ ?debug("~w (~w): ~s\n",
+ [Name, Label, erl_types:t_to_string(Type)]),
+ case erl_types:t_is_equal(Type, DecoratedType) of
+ true -> ok;
+ false ->
+ ?debug(" With opaque types: ~s\n",
+ [erl_types:t_to_string(DecoratedType)])
+ end
+ end,
+ lists:foreach(Fun, lists:zip(FTypes, DTypes)),
+ ?debug("\n", []).
-else.
debug_pp_succ_typings(_) ->
ok.
+
+debug_pp_functions(_, _, _, _) ->
+ ok.
-endif.
lookup_name(F, CG) ->
diff --git a/lib/dialyzer/src/dialyzer_typesig.erl b/lib/dialyzer/src/dialyzer_typesig.erl
index a418a11e65..db7875704a 100644
--- a/lib/dialyzer/src/dialyzer_typesig.erl
+++ b/lib/dialyzer/src/dialyzer_typesig.erl
@@ -2,7 +2,7 @@
%%-----------------------------------------------------------------------
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2006-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2006-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -31,28 +31,30 @@
-export([analyze_scc/6]).
-export([get_safe_underapprox/2]).
+%%-import(helper, %% 'helper' could be any module doing sanity checks...
+-import(erl_types,
+ [t_has_var/1, t_inf/2, t_is_equal/2, t_is_subtype/2,
+ t_subtract/2, t_subtract_list/2, t_sup/1, t_sup/2,t_unify/2]).
+
-import(erl_types,
[t_any/0, t_atom/0, t_atom_vals/1,
t_binary/0, t_bitstr/0, t_bitstr/2, t_bitstr_concat/1, t_boolean/0,
t_collect_vars/1, t_cons/2, t_cons_hd/1, t_cons_tl/1,
t_float/0, t_from_range/2, t_from_term/1,
t_fun/0, t_fun/2, t_fun_args/1, t_fun_range/1,
- t_has_var/1,
- t_inf/2, t_inf/3, t_integer/0,
- t_is_any/1, t_is_atom/1, t_is_atom/2, t_is_cons/1, t_is_equal/2,
+ t_integer/0,
+ t_is_any/1, t_is_atom/1, t_is_any_atom/2, t_is_cons/1,
t_is_float/1, t_is_fun/1,
t_is_integer/1, t_non_neg_integer/0,
t_is_list/1, t_is_nil/1, t_is_none/1, t_is_number/1,
- t_is_subtype/2, t_limit/2, t_list/0, t_list/1,
+ t_limit/2, t_list/0, t_list/1,
t_list_elements/1, t_nonempty_list/1, t_maybe_improper_list/0,
t_module/0, t_number/0, t_number_vals/1,
- t_opaque_match_record/2, t_opaque_matching_structure/2,
- t_opaque_from_records/1,
t_pid/0, t_port/0, t_product/1, t_reference/0,
- t_subst/2, t_subtract/2, t_subtract_list/2, t_sup/1, t_sup/2,
+ t_subst/2,
t_timeout/0, t_tuple/0, t_tuple/1,
- t_unify/3, t_var/1, t_var_name/1,
+ t_var/1, t_var_name/1,
t_none/0, t_unit/0]).
-include("dialyzer.hrl").
@@ -105,11 +107,10 @@
module :: module(),
name_map = dict:new() :: dict(),
next_label = 0 :: label(),
- self_rec :: erl_types:erl_type(),
+ self_rec :: 'false' | erl_types:erl_type(),
plt :: dialyzer_plt:plt(),
prop_types = {'d', dict:new()} :: dict_or_ets(),
records = dict:new() :: dict(),
- opaques = [] :: [erl_types:erl_type()],
scc = [] :: [type_var()],
mfas :: [tuple()],
solvers = [] :: [solver()]
@@ -192,11 +193,10 @@ solvers(Solvers) -> Solvers.
%%
%% ============================================================================
-traverse_scc([{MFA, Def, Rec}|Left], DefSet, AccState) ->
+traverse_scc([{_MFA, Def, Rec}|Left], DefSet, AccState) ->
TmpState1 = state__set_rec_dict(AccState, Rec),
- TmpState2 = state__set_opaques(TmpState1, MFA),
DummyLetrec = cerl:c_letrec([Def], cerl:c_atom(foo)),
- {NewAccState, _} = traverse(DummyLetrec, DefSet, TmpState2),
+ {NewAccState, _} = traverse(DummyLetrec, DefSet, TmpState1),
traverse_scc(Left, DefSet, NewAccState);
traverse_scc([], _DefSet, AccState) ->
AccState.
@@ -386,12 +386,7 @@ traverse(Tree, DefinedVars, State) ->
case cerl:unfold_literal(Tree) of
Tree ->
Type = t_from_term(cerl:concrete(Tree)),
- NewType =
- case erl_types:t_opaque_match_atom(Type, State#state.opaques) of
- [Opaque] -> Opaque;
- _ -> Type
- end,
- {State, NewType};
+ {State, Type};
NewTree -> traverse(NewTree, DefinedVars, State)
end;
module ->
@@ -462,25 +457,17 @@ traverse(Tree, DefinedVars, State) ->
[Tag|Fields] ->
case cerl:is_c_atom(Tag) of
true ->
- %% Check if an opaque term is constructed.
- case t_opaque_match_record(TupleType, State#state.opaques) of
- [Opaque] ->
- OpStruct = t_opaque_matching_structure(TupleType, Opaque),
- State3 = state__store_conj(TupleType, sub, OpStruct, State2),
- {State3, Opaque};
- %% Check if a record is constructed.
- _ ->
- Arity = length(Fields),
- Records = State2#state.records,
- case lookup_record(Records, cerl:atom_val(Tag), Arity) of
- error -> {State2, TupleType};
- {ok, RecType} ->
- State3 = state__store_conj(TupleType, sub, RecType, State2),
- {State3, TupleType}
- end
- end;
+ %% Check if a record is constructed.
+ Arity = length(Fields),
+ Records = State2#state.records,
+ case lookup_record(Records, cerl:atom_val(Tag), Arity) of
+ error -> {State2, TupleType};
+ {ok, RecType} ->
+ State3 = state__store_conj(TupleType, sub, RecType, State2),
+ {State3, TupleType}
+ end;
false -> {State2, TupleType}
- end;
+ end;
[] -> {State2, TupleType}
end;
values ->
@@ -591,9 +578,13 @@ handle_try(Tree, DefinedVars, State) ->
case state__is_in_guard(State) of
true ->
Conj1 = mk_conj_constraint_list([ArgBodyCs,
- mk_constraint(BodyVar, eq, TreeVar)]),
+ mk_constraint(BodyVar,
+ eq,
+ TreeVar)]),
Disj = mk_disj_constraint_list([Conj1,
- mk_constraint(HandlerVar, eq, TreeVar)]),
+ mk_constraint(HandlerVar,
+ eq,
+ TreeVar)]),
NewState1 = state__new_constraint_context(HandlerState),
Conj2 = mk_conj_constraint_list([OldCs, Disj]),
NewState2 = state__store_conj(Conj2, NewState1),
@@ -604,19 +595,27 @@ handle_try(Tree, DefinedVars, State) ->
{false, false} ->
Conj1 =
mk_conj_constraint_list([ArgBodyCs,
- mk_constraint(TreeVar, eq, BodyVar)]),
+ mk_constraint(TreeVar,
+ eq,
+ BodyVar)]),
Conj2 =
mk_conj_constraint_list([HandlerCs,
- mk_constraint(TreeVar, eq, HandlerVar)]),
+ mk_constraint(TreeVar,
+ eq,
+ HandlerVar)]),
Disj = mk_disj_constraint_list([Conj1, Conj2]),
{Disj, TreeVar};
{false, true} ->
{mk_conj_constraint_list([ArgBodyCs,
- mk_constraint(TreeVar, eq, BodyVar)]),
+ mk_constraint(TreeVar,
+ eq,
+ BodyVar)]),
BodyVar};
{true, false} ->
{mk_conj_constraint_list([HandlerCs,
- mk_constraint(TreeVar, eq, HandlerVar)]),
+ mk_constraint(TreeVar,
+ eq,
+ HandlerVar)]),
HandlerVar};
{true, true} ->
?debug("Throw failed\n", []),
@@ -668,10 +667,7 @@ handle_call(Call, DefinedVars, State) ->
get_plt_constr(MFA, Dst, ArgVars, State) ->
Plt = state__plt(State),
PltRes = dialyzer_plt:lookup(Plt, MFA),
- Opaques = State#state.opaques,
- Module = State#state.module,
SCCMFAs = State#state.mfas,
- {FunModule, _, _} = MFA,
Contract =
case lists:member(MFA, SCCMFAs) of
true -> none;
@@ -691,28 +687,24 @@ get_plt_constr(MFA, Dst, ArgVars, State) ->
none ->
{?mk_fun_var(fun(Map) ->
ArgTypes = lookup_type_list(ArgVars, Map),
- dialyzer_contracts:get_contract_return(C, ArgTypes)
+ get_contract_return(C, ArgTypes)
end, ArgVars), GenArgs};
{value, {PltRetType, PltArgTypes}} ->
%% Need to combine the contract with the success typing.
{?mk_fun_var(
fun(Map) ->
- ArgTypes0 = lookup_type_list(ArgVars, Map),
- ArgTypes = case FunModule =:= Module of
- false ->
- List = lists:zip(PltArgTypes, ArgTypes0),
- [erl_types:t_unopaque_on_mismatch(T1, T2, Opaques)
- || {T1, T2} <- List];
- true -> ArgTypes0
- end,
- CRet = dialyzer_contracts:get_contract_return(C, ArgTypes),
- t_inf(CRet, PltRetType, opaque)
+ ArgTypes = lookup_type_list(ArgVars, Map),
+ CRet = get_contract_return(C, ArgTypes),
+ t_inf(CRet, PltRetType)
end, ArgVars),
- [t_inf(X, Y, opaque) || {X, Y} <- lists:zip(GenArgs, PltArgTypes)]}
+ [t_inf(X, Y) || {X, Y} <- lists:zip(GenArgs, PltArgTypes)]}
end,
state__store_conj_lists([Dst|ArgVars], sub, [RetType|ArgCs], State)
end.
+get_contract_return(C, ArgTypes) ->
+ dialyzer_contracts:get_contract_return(C, ArgTypes).
+
filter_match_fail([Clause] = Cls) ->
Body = cerl:clause_body(Clause),
case cerl:type(Body) of
@@ -1086,7 +1078,7 @@ get_bif_constr({erlang, Op, 2}, Dst, Args = [Arg1, Arg2], _State)
when Op =:= '+'; Op =:= '-'; Op =:= '*' ->
ReturnType = ?mk_fun_var(fun(Map) ->
TmpArgTypes = lookup_type_list(Args, Map),
- erl_bif_types:type(erlang, Op, 2, TmpArgTypes)
+ bif_return(erlang, Op, 2, TmpArgTypes)
end, Args),
ArgFun =
fun(A, Pos) ->
@@ -1128,8 +1120,8 @@ get_bif_constr({erlang, Op, 2}, Dst, [Arg1, Arg2] = Args, _State)
fun(LocalArg1, LocalArg2, LocalOp) ->
fun(Map) ->
DstType = lookup_type(Dst, Map),
- IsTrue = t_is_atom(true, DstType),
- IsFalse = t_is_atom(false, DstType),
+ IsTrue = t_is_any_atom(true, DstType),
+ IsFalse = t_is_any_atom(false, DstType),
case IsTrue orelse IsFalse of
true ->
Arg1Type = lookup_type(LocalArg1, Map),
@@ -1176,7 +1168,7 @@ get_bif_constr({erlang, Op, 2}, Dst, [Arg1, Arg2] = Args, _State)
Arg2Var = ?mk_fun_var(Arg2Fun, DstArgs),
DstVar = ?mk_fun_var(fun(Map) ->
TmpArgTypes = lookup_type_list(Args, Map),
- erl_bif_types:type(erlang, Op, 2, TmpArgTypes)
+ bif_return(erlang, Op, 2, TmpArgTypes)
end, Args),
mk_conj_constraint_list([mk_constraint(Dst, sub, DstVar),
mk_constraint(Arg1, sub, Arg1Var),
@@ -1218,7 +1210,7 @@ get_bif_constr({erlang, '++', 2}, Dst, [Hd, Tl] = Args, _State) ->
ArgTypes = erl_bif_types:arg_types(erlang, '++', 2),
ReturnType = ?mk_fun_var(fun(Map) ->
TmpArgTypes = lookup_type_list(Args, Map),
- erl_bif_types:type(erlang, '++', 2, TmpArgTypes)
+ bif_return(erlang, '++', 2, TmpArgTypes)
end, Args),
Cs = mk_constraints(Args, sub, ArgTypes),
mk_conj_constraint_list([mk_constraint(Dst, sub, ReturnType),
@@ -1240,7 +1232,7 @@ get_bif_constr({erlang, is_function, 1}, Dst, [Arg], State) ->
get_bif_constr({erlang, is_function, 2}, Dst, [Fun, Arity], _State) ->
ArgFun = fun(Map) ->
DstType = lookup_type(Dst, Map),
- case t_is_atom(true, DstType) of
+ case t_is_any_atom(true, DstType) of
true ->
ArityType = lookup_type(Arity, Map),
case t_number_vals(ArityType) of
@@ -1268,7 +1260,7 @@ get_bif_constr({erlang, is_reference, 1}, Dst, [Arg], State) ->
get_bif_test_constr(Dst, Arg, t_reference(), State);
get_bif_constr({erlang, is_record, 2}, Dst, [Var, Tag] = Args, _State) ->
ArgFun = fun(Map) ->
- case t_is_atom(true, lookup_type(Dst, Map)) of
+ case t_is_any_atom(true, lookup_type(Dst, Map)) of
true -> t_tuple();
false -> t_any()
end
@@ -1276,7 +1268,7 @@ get_bif_constr({erlang, is_record, 2}, Dst, [Var, Tag] = Args, _State) ->
ArgV = ?mk_fun_var(ArgFun, [Dst]),
DstFun = fun(Map) ->
TmpArgTypes = lookup_type_list(Args, Map),
- erl_bif_types:type(erlang, is_record, 2, TmpArgTypes)
+ bif_return(erlang, is_record, 2, TmpArgTypes)
end,
DstV = ?mk_fun_var(DstFun, Args),
mk_conj_constraint_list([mk_constraint(Dst, sub, DstV),
@@ -1285,10 +1277,9 @@ get_bif_constr({erlang, is_record, 2}, Dst, [Var, Tag] = Args, _State) ->
get_bif_constr({erlang, is_record, 3}, Dst, [Var, Tag, Arity] = Args, State) ->
%% TODO: Revise this to make it precise for Tag and Arity.
Records = State#state.records,
- AllOpaques = State#state.opaques,
ArgFun =
fun(Map) ->
- case t_is_atom(true, lookup_type(Dst, Map)) of
+ case t_is_any_atom(true, lookup_type(Dst, Map)) of
true ->
ArityType = lookup_type(Arity, Map),
case t_is_integer(ArityType) of
@@ -1304,10 +1295,7 @@ get_bif_constr({erlang, is_record, 3}, Dst, [Var, Tag, Arity] = Args, State) ->
[TagVal] ->
case lookup_record(Records, TagVal, ArityVal - 1) of
{ok, Type} ->
- case t_opaque_match_record(Type, AllOpaques) of
- [Opaque] -> Opaque;
- _ -> Type
- end;
+ Type;
error -> GenRecord
end;
_ -> GenRecord
@@ -1323,38 +1311,9 @@ get_bif_constr({erlang, is_record, 3}, Dst, [Var, Tag, Arity] = Args, State) ->
end,
ArgV = ?mk_fun_var(ArgFun, [Tag, Arity, Dst]),
DstFun = fun(Map) ->
- [TmpVar, TmpTag, TmpArity] = TmpArgTypes = lookup_type_list(Args, Map),
- TmpArgTypes2 =
- case lists:member(TmpVar, AllOpaques) of
- true ->
- case t_is_integer(TmpArity) of
- true ->
- case t_number_vals(TmpArity) of
- [TmpArityVal] ->
- case t_is_atom(TmpTag) of
- true ->
- case t_atom_vals(TmpTag) of
- [TmpTagVal] ->
- case lookup_record(Records, TmpTagVal,
- TmpArityVal - 1) of
- {ok, TmpType} ->
- case t_is_none(t_inf(TmpType, TmpVar, opaque)) of
- true -> TmpArgTypes;
- false -> [TmpType, TmpTag, TmpArity]
- end;
- error -> TmpArgTypes
- end;
- _ -> TmpArgTypes
- end;
- false -> TmpArgTypes
- end;
- _ -> TmpArgTypes
- end;
- false -> TmpArgTypes
- end;
- false -> TmpArgTypes
- end,
- erl_bif_types:type(erlang, is_record, 3, TmpArgTypes2)
+ [TmpVar, TmpTag, TmpArity] = lookup_type_list(Args, Map),
+ TmpArgTypes = [TmpVar,TmpTag,TmpArity],
+ bif_return(erlang, is_record, 3, TmpArgTypes)
end,
DstV = ?mk_fun_var(DstFun, Args),
mk_conj_constraint_list([mk_constraint(Dst, sub, DstV),
@@ -1369,12 +1328,14 @@ get_bif_constr({erlang, 'and', 2}, Dst, [Arg1, Arg2] = Args, _State) ->
ArgFun = fun(Var) ->
fun(Map) ->
DstType = lookup_type(Dst, Map),
- case t_is_atom(true, DstType) of
+ case t_is_any_atom(true, DstType) of
true -> True;
false ->
- case t_is_atom(false, DstType) of
+ case t_is_any_atom(false, DstType) of
true ->
- case t_is_atom(true, lookup_type(Var, Map)) of
+ case
+ t_is_any_atom(true, lookup_type(Var, Map))
+ of
true -> False;
false -> t_boolean()
end;
@@ -1386,15 +1347,15 @@ get_bif_constr({erlang, 'and', 2}, Dst, [Arg1, Arg2] = Args, _State) ->
end,
DstFun = fun(Map) ->
Arg1Type = lookup_type(Arg1, Map),
- case t_is_atom(false, Arg1Type) of
+ case t_is_any_atom(false, Arg1Type) of
true -> False;
false ->
Arg2Type = lookup_type(Arg2, Map),
- case t_is_atom(false, Arg2Type) of
+ case t_is_any_atom(false, Arg2Type) of
true -> False;
false ->
- case (t_is_atom(true, Arg1Type)
- andalso t_is_atom(true, Arg2Type)) of
+ case (t_is_any_atom(true, Arg1Type)
+ andalso t_is_any_atom(true, Arg2Type)) of
true -> True;
false -> t_boolean()
end
@@ -1413,12 +1374,14 @@ get_bif_constr({erlang, 'or', 2}, Dst, [Arg1, Arg2] = Args, _State) ->
ArgFun = fun(Var) ->
fun(Map) ->
DstType = lookup_type(Dst, Map),
- case t_is_atom(false, DstType) of
+ case t_is_any_atom(false, DstType) of
true -> False;
false ->
- case t_is_atom(true, DstType) of
+ case t_is_any_atom(true, DstType) of
true ->
- case t_is_atom(false, lookup_type(Var, Map)) of
+ case
+ t_is_any_atom(false, lookup_type(Var, Map))
+ of
true -> True;
false -> t_boolean()
end;
@@ -1430,15 +1393,15 @@ get_bif_constr({erlang, 'or', 2}, Dst, [Arg1, Arg2] = Args, _State) ->
end,
DstFun = fun(Map) ->
Arg1Type = lookup_type(Arg1, Map),
- case t_is_atom(true, Arg1Type) of
+ case t_is_any_atom(true, Arg1Type) of
true -> True;
false ->
Arg2Type = lookup_type(Arg2, Map),
- case t_is_atom(true, Arg2Type) of
+ case t_is_any_atom(true, Arg2Type) of
true -> True;
false ->
- case (t_is_atom(false, Arg1Type)
- andalso t_is_atom(false, Arg2Type)) of
+ case (t_is_any_atom(false, Arg1Type)
+ andalso t_is_any_atom(false, Arg2Type)) of
true -> False;
false -> t_boolean()
end
@@ -1465,10 +1428,10 @@ get_bif_constr({erlang, 'not', 1}, Dst, [Arg] = Args, _State) ->
Fun = fun(Var) ->
fun(Map) ->
Type = lookup_type(Var, Map),
- case t_is_atom(true, Type) of
+ case t_is_any_atom(true, Type) of
true -> False;
false ->
- case t_is_atom(false, Type) of
+ case t_is_any_atom(false, Type) of
true -> True;
false -> t_boolean()
end
@@ -1485,10 +1448,10 @@ get_bif_constr({erlang, '=:=', 2}, Dst, [Arg1, Arg2] = Args, _State) ->
fun(Map) ->
DstType = lookup_type(Dst, Map),
OtherVarType = lookup_type(OtherVar, Map),
- case t_is_atom(true, DstType) of
+ case t_is_any_atom(true, DstType) of
true -> OtherVarType;
false ->
- case t_is_atom(false, DstType) of
+ case t_is_any_atom(false, DstType) of
true ->
case is_singleton_type(OtherVarType) of
true -> t_subtract(lookup_type(Self, Map), OtherVarType);
@@ -1518,7 +1481,7 @@ get_bif_constr({erlang, '=:=', 2}, Dst, [Arg1, Arg2] = Args, _State) ->
get_bif_constr({erlang, '==', 2}, Dst, [Arg1, Arg2] = Args, _State) ->
DstFun = fun(Map) ->
TmpArgTypes = lookup_type_list(Args, Map),
- erl_bif_types:type(erlang, '==', 2, TmpArgTypes)
+ bif_return(erlang, '==', 2, TmpArgTypes)
end,
ArgFun =
fun(Var, Self) ->
@@ -1527,16 +1490,16 @@ get_bif_constr({erlang, '==', 2}, Dst, [Arg1, Arg2] = Args, _State) ->
DstType = lookup_type(Dst, Map),
case is_singleton_non_number_type(VarType) of
true ->
- case t_is_atom(true, DstType) of
+ case t_is_any_atom(true, DstType) of
true -> VarType;
false ->
- case t_is_atom(false, DstType) of
+ case t_is_any_atom(false, DstType) of
true -> t_subtract(lookup_type(Self, Map), VarType);
false -> t_any()
end
end;
false ->
- case t_is_atom(true, DstType) of
+ case t_is_any_atom(true, DstType) of
true ->
case t_is_number(VarType) of
true -> t_number();
@@ -1560,18 +1523,14 @@ get_bif_constr({erlang, '==', 2}, Dst, [Arg1, Arg2] = Args, _State) ->
mk_constraint(Arg1, sub, ArgV1),
mk_constraint(Arg2, sub, ArgV2)]);
get_bif_constr({erlang, element, 2} = _BIF, Dst, Args,
- #state{cs = Constrs, opaques = Opaques}) ->
+ #state{cs = Constrs}) ->
GenType = erl_bif_types:type(erlang, element, 2),
case t_is_none(GenType) of
true -> ?debug("Bif: ~w failed\n", [_BIF]), throw(error);
false ->
Fun = fun(Map) ->
- [I, T] = ATs = lookup_type_list(Args, Map),
- ATs2 = case lists:member(T, Opaques) of
- true -> [I, erl_types:t_opaque_structure(T)];
- false -> ATs
- end,
- erl_bif_types:type(erlang, element, 2, ATs2)
+ ATs2 = lookup_type_list(Args, Map),
+ bif_return(erlang, element, 2, ATs2)
end,
ReturnType = ?mk_fun_var(Fun, Args),
ArgTypes = erl_bif_types:arg_types(erlang, element, 2),
@@ -1583,22 +1542,14 @@ get_bif_constr({erlang, element, 2} = _BIF, Dst, Args,
end,
mk_conj_constraint_list([mk_constraint(Dst, sub, ReturnType)|NewCs])
end;
-get_bif_constr({M, F, A} = _BIF, Dst, Args, State) ->
+get_bif_constr({M, F, A} = _BIF, Dst, Args, _State) ->
GenType = erl_bif_types:type(M, F, A),
- Opaques = State#state.opaques,
case t_is_none(GenType) of
true -> ?debug("Bif: ~w failed\n", [_BIF]), throw(error);
false ->
- UnopaqueFun =
- fun(T) -> case lists:member(T, Opaques) of
- true -> erl_types:t_unopaque(T, [T]);
- false -> T
- end
- end,
ReturnType = ?mk_fun_var(fun(Map) ->
- TmpArgTypes0 = lookup_type_list(Args, Map),
- TmpArgTypes = [UnopaqueFun(T) || T<- TmpArgTypes0],
- erl_bif_types:type(M, F, A, TmpArgTypes)
+ TmpArgTypes = lookup_type_list(Args, Map),
+ bif_return(M, F, A, TmpArgTypes)
end, Args),
case erl_bif_types:is_known(M, F, A) of
false ->
@@ -1616,12 +1567,12 @@ get_bif_constr({M, F, A} = _BIF, Dst, Args, State) ->
end.
eval_inv_arith('+', _Pos, Dst, Arg) ->
- erl_bif_types:type(erlang, '-', 2, [Dst, Arg]);
+ bif_return(erlang, '-', 2, [Dst, Arg]);
eval_inv_arith('*', _Pos, Dst, Arg) ->
case t_number_vals(Arg) of
[0] -> t_integer();
_ ->
- TmpRet = erl_bif_types:type(erlang, 'div', 2, [Dst, Arg]),
+ TmpRet = bif_return(erlang, 'div', 2, [Dst, Arg]),
Zero = t_from_term(0),
%% If 0 is not part of the result, it cannot be part of the argument.
case t_is_subtype(Zero, Dst) of
@@ -1630,9 +1581,9 @@ eval_inv_arith('*', _Pos, Dst, Arg) ->
end
end;
eval_inv_arith('-', 1, Dst, Arg) ->
- erl_bif_types:type(erlang, '-', 2, [Arg, Dst]);
+ bif_return(erlang, '-', 2, [Arg, Dst]);
eval_inv_arith('-', 2, Dst, Arg) ->
- erl_bif_types:type(erlang, '+', 2, [Arg, Dst]).
+ bif_return(erlang, '+', 2, [Arg, Dst]).
range_inc(neg_inf) -> neg_inf;
range_inc(pos_inf) -> pos_inf;
@@ -1642,33 +1593,20 @@ range_dec(neg_inf) -> neg_inf;
range_dec(pos_inf) -> pos_inf;
range_dec(Int) when is_integer(Int) -> Int - 1.
-get_bif_test_constr(Dst, Arg, Type, State) ->
+get_bif_test_constr(Dst, Arg, Type, _State) ->
ArgFun = fun(Map) ->
DstType = lookup_type(Dst, Map),
- case t_is_atom(true, DstType) of
+ case t_is_any_atom(true, DstType) of
true -> Type;
false -> t_any()
end
end,
ArgV = ?mk_fun_var(ArgFun, [Dst]),
- Opaques = State#state.opaques,
DstFun = fun(Map) ->
ArgType = lookup_type(Arg, Map),
case t_is_none(t_inf(ArgType, Type)) of
true ->
- case lists:member(ArgType, Opaques) of
- true ->
- OpaqueStruct = erl_types:t_opaque_structure(ArgType),
- case t_is_none(t_inf(OpaqueStruct, Type)) of
- true -> t_from_term(false);
- false ->
- case t_is_subtype(ArgType, Type) of
- true -> t_from_term(true);
- false -> t_boolean()
- end
- end;
- false -> t_from_term(false)
- end;
+ t_from_term(false);
false ->
case t_is_subtype(ArgType, Type) of
true -> t_from_term(true);
@@ -1784,7 +1722,6 @@ minimize_state(#state{
fun_arities = FunArities,
self_rec = SelfRec,
prop_types = {d, PropTypes},
- opaques = Opaques,
solvers = Solvers
}) ->
Opts = [{read_concurrency, true}],
@@ -1798,7 +1735,6 @@ minimize_state(#state{
fun_arities = FunArities,
self_rec = SelfRec,
prop_types = {e, ETSPropTypes},
- opaques = Opaques,
solvers = Solvers
}.
@@ -1956,8 +1892,7 @@ v2_solve_ref(Fun, Map, State) ->
{ok, NewMap}.
v2_solve(#constraint{}=C, Map, V2State) ->
- State = V2State#v2_state.state,
- case solve_one_c(C, Map, State#state.opaques) of
+ case solve_one_c(C, Map) of
error ->
report_failed_constraint(C, Map),
{error, V2State};
@@ -2031,7 +1966,7 @@ v2_solve_self_recursive(Cs, Map, Id, RecType0, V2State0) ->
{ok, NewMap, V2State, U} ->
pp_map("recursive finished", NewMap),
NewRecType = unsafe_lookup_type(Id, NewMap),
- case t_is_equal(NewRecType, RecType0) of
+ case is_equal(NewRecType, RecType0) of
true ->
{NewMap2, U1} = enter_var_type(RecVar, NewRecType, NewMap),
{ok, NewMap2, V2State, lists:umerge(U, U1)};
@@ -2397,7 +2332,7 @@ solve_self_recursive(Cs, Map, MapDict, Id, RecType0, State) ->
{ok, NewMapDict, NewMap} ->
pp_map("NewMap", NewMap),
NewRecType = unsafe_lookup_type(Id, NewMap),
- case t_is_equal(NewRecType, RecType0) of
+ case is_equal(NewRecType, RecType0) of
true ->
{ok, NewMapDict, enter_type(RecVar, NewRecType, NewMap)};
false ->
@@ -2447,7 +2382,7 @@ solve_cs([#constraint_list{} = C|Tail], Map, MapDict, State) ->
{error, _NewMapDict} = Error -> Error
end;
solve_cs([#constraint{} = C|Tail], Map, MapDict, State) ->
- case solve_one_c(C, Map, State#state.opaques) of
+ case solve_one_c(C, Map) of
error ->
report_failed_constraint(C, Map),
{error, MapDict};
@@ -2457,10 +2392,10 @@ solve_cs([#constraint{} = C|Tail], Map, MapDict, State) ->
solve_cs([], Map, MapDict, _State) ->
{ok, MapDict, Map}.
-solve_one_c(#constraint{lhs = Lhs, rhs = Rhs, op = Op}, Map, Opaques) ->
+solve_one_c(#constraint{lhs = Lhs, rhs = Rhs, op = Op}, Map) ->
LhsType = lookup_type(Lhs, Map),
RhsType = lookup_type(Rhs, Map),
- Inf = t_inf(LhsType, RhsType, opaque),
+ Inf = t_inf(LhsType, RhsType),
?debug("Solving: ~s :: ~s ~w ~s :: ~s\n\tInf: ~s\n",
[format_type(Lhs), format_type(LhsType), Op,
format_type(Rhs), format_type(RhsType), format_type(Inf)]),
@@ -2468,12 +2403,12 @@ solve_one_c(#constraint{lhs = Lhs, rhs = Rhs, op = Op}, Map, Opaques) ->
true -> error;
false ->
case Op of
- sub -> solve_subtype(Lhs, Inf, Map, Opaques);
+ sub -> solve_subtype(Lhs, Inf, Map);
eq ->
- case solve_subtype(Lhs, Inf, Map, Opaques) of
+ case solve_subtype(Lhs, Inf, Map) of
error -> error;
{ok, {Map1, U1}} ->
- case solve_subtype(Rhs, Inf, Map1, Opaques) of
+ case solve_subtype(Rhs, Inf, Map1) of
error -> error;
{ok, {Map2, U2}} -> {ok, {Map2, lists:umerge(U1, U2)}}
end
@@ -2481,7 +2416,7 @@ solve_one_c(#constraint{lhs = Lhs, rhs = Rhs, op = Op}, Map, Opaques) ->
end
end.
-solve_subtype(Type, Inf, Map, Opaques) ->
+solve_subtype(Type, Inf, Map) ->
%% case cerl:is_literal(Type) of
%% true ->
%% case t_is_subtype(t_from_term(cerl:concrete(Type)), Inf) of
@@ -2489,7 +2424,7 @@ solve_subtype(Type, Inf, Map, Opaques) ->
%% false -> error
%% end;
%% false ->
- try t_unify(Type, Inf, Opaques) of
+ try t_unify(Type, Inf) of
{_, List} -> {ok, enter_type_list(List, Map)}
catch
throw:{mismatch, _T1, _T2} ->
@@ -2540,7 +2475,7 @@ join_one_key(Key, [Map|Maps], Type) ->
true -> Type;
false ->
NewType = lookup_type(Key, Map),
- case t_is_equal(NewType, Type) of
+ case is_equal(NewType, Type) of
true -> join_one_key(Key, Maps, Type);
false -> join_one_key(Key, Maps, t_sup(NewType, Type))
end
@@ -2555,7 +2490,7 @@ maps_are_equal(Map1, Map2, Deps) ->
maps_are_equal_1(Map1, Map2, [H|Tail]) ->
T1 = lookup_type(H, Map1),
T2 = lookup_type(H, Map2),
- case t_is_equal(T1, T2) of
+ case is_equal(T1, T2) of
true -> maps_are_equal_1(Map1, Map2, Tail);
false ->
?debug("~w: ~s =/= ~s\n", [H, format_type(T1), format_type(T2)]),
@@ -2587,14 +2522,20 @@ prune_keys(Map1, Map2, Deps) ->
enter_type(Key, Val, Map) when is_integer(Key) ->
?debug("Entering ~s :: ~s\n", [format_type(t_var(Key)), format_type(Val)]),
- case t_is_any(Val) of
+ %% Keep any() in the map if it is opaque:
+ case is_equal(Val, t_any()) of
true ->
erase_type(Key, Map);
false ->
LimitedVal = t_limit(Val, ?INTERNAL_TYPE_LIMIT),
+ [?debug("LimitedVal ~s\n", [format_type(LimitedVal)]) ||
+ not is_equal(LimitedVal, Val)],
case dict:find(Key, Map) of
- {ok, LimitedVal} -> Map;
- {ok, _} -> map_store(Key, LimitedVal, Map);
+ {ok, Value} ->
+ case is_equal(Value, LimitedVal) of
+ true -> Map;
+ false -> map_store(Key, LimitedVal, Map)
+ end;
error -> map_store(Key, LimitedVal, Map)
end
end;
@@ -2681,7 +2622,10 @@ updated_vars_only(U, OldMap, NewMap) ->
[V || V <- U, not is_same(V, OldMap, NewMap)].
is_same(Key, Map1, Map2) ->
- t_is_equal(lookup_type(Key, Map1), lookup_type(Key, Map2)).
+ is_equal(lookup_type(Key, Map1), lookup_type(Key, Map2)).
+
+is_equal(Type1, Type2) ->
+ t_is_equal(Type1, Type2).
pp_map(_S, _Map) ->
?debug("\t~s: ~p\n",
@@ -2716,11 +2660,6 @@ new_state(SCC0, NextLabel, CallGraph, Plt, PropTypes, Solvers) ->
state__set_rec_dict(State, RecDict) ->
State#state{records = RecDict}.
-state__set_opaques(#state{records = RecDict} = State, {M, _F, _A}) ->
- Opaques =
- erl_types:module_builtin_opaques(M) ++ t_opaque_from_records(RecDict),
- State#state{opaques = Opaques, module = M}.
-
state__set_in_match(State, Bool) ->
State#state{in_match = Bool}.
@@ -2760,7 +2699,8 @@ state__lookup_undef_var(Tree, #state{callgraph = CG, plt = Plt}) ->
{ok, MFA} ->
case dialyzer_plt:lookup(Plt, MFA) of
none -> error;
- {value, {RetType, ArgTypes}} -> {ok, t_fun(ArgTypes, RetType)}
+ {value, {RetType, ArgTypes}} ->
+ {ok, t_fun(ArgTypes, RetType)}
end
end.
@@ -2897,7 +2837,7 @@ state__get_cs(Var, #state{cmap = {d, Dict}}) ->
dict:fetch(Var, Dict).
state__is_self_rec(Fun, #state{self_rec = SelfRec}) ->
- Fun =:= SelfRec.
+ not (SelfRec =:= 'false') andalso is_equal(Fun, SelfRec).
state__store_funs(Vars0, Funs0, #state{fun_map = Map} = State) ->
debug_make_name_map(Vars0, Funs0),
@@ -2923,7 +2863,9 @@ state__finalize(State) ->
%%
%% ============================================================================
--spec mk_constraint(erl_types:erl_type(), constr_op(), fvar_or_type()) -> #constraint{}.
+-spec mk_constraint(erl_types:erl_type(),
+ constr_op(),
+ fvar_or_type()) -> #constraint{}.
mk_constraint(Lhs, Op, Rhs) ->
case t_is_any(Lhs) orelse constraint_opnd_is_any(Rhs) of
@@ -2934,9 +2876,9 @@ mk_constraint(Lhs, Op, Rhs) ->
case Deps =:= [] of
true ->
%% This constraint is constant. Solve it immediately.
- case solve_one_c(C, map_new(), []) of
+ case solve_one_c(C, map_new()) of
error -> throw(error);
- _ ->
+ _R ->
%% This is always true, keep it anyway for logistic reasons
C
end;
@@ -2944,10 +2886,13 @@ mk_constraint(Lhs, Op, Rhs) ->
C
end;
true ->
- C = mk_constraint_1(t_any(), Op, t_any()),
- C#constraint{deps = []}
+ mk_constraint_any(Op)
end.
+mk_constraint_any(Op) ->
+ C = mk_constraint_1(t_any(), Op, t_any()),
+ C#constraint{deps = []}.
+
%% the following function is used so that we do not call
%% erl_types:t_is_any/1 with a term other than an erl_type()
-spec constraint_opnd_is_any(fvar_or_type()) -> boolean().
@@ -3002,7 +2947,8 @@ mk_constraint_1(Lhs, Op, Rhs) ->
#constraint{lhs = Lhs, op = Op, rhs = Rhs}.
mk_constraints([Lhs|LhsTail], Op, [Rhs|RhsTail]) ->
- [mk_constraint(Lhs, Op, Rhs)|mk_constraints(LhsTail, Op, RhsTail)];
+ [mk_constraint(Lhs, Op, Rhs) |
+ mk_constraints(LhsTail, Op, RhsTail)];
mk_constraints([], _Op, []) ->
[].
@@ -3017,7 +2963,7 @@ mk_constraint_list(Type, List) ->
Deps = calculate_deps(List2),
case Deps =:= [] of
true -> #constraint_list{type = conj,
- list = [mk_constraint(t_any(), eq, t_any())],
+ list = [mk_constraint_any(eq)],
deps = []};
false -> #constraint_list{type = Type, list = List2, deps = Deps}
end.
@@ -3236,6 +3182,9 @@ calculate_masks([], _I, L) ->
%%
%% ============================================================================
+bif_return(M, F, A, Xs) ->
+ erl_bif_types:type(M, F, A, Xs).
+
is_singleton_non_number_type(Type) ->
case t_is_number(Type) of
true -> false;
@@ -3265,7 +3214,7 @@ is_singleton_type(Type) ->
find_element(Args, Cs) ->
[Pos, Tuple] = Args,
- case erl_types:t_is_number(Pos) of
+ case t_is_number(Pos) of
true ->
case erl_types:t_number_vals(Pos) of
'unknown' -> 'unknown';
@@ -3301,8 +3250,10 @@ find_constraint(Tuple, [_|Cs]) ->
lookup_record(Records, Tag, Arity) ->
case erl_types:lookup_record(Tag, Arity, Records) of
{ok, Fields} ->
- {ok, t_tuple([t_from_term(Tag)|
- [FieldType || {_FieldName, FieldType} <- Fields]])};
+ RecType =
+ t_tuple([t_from_term(Tag)|
+ [FieldType || {_FieldName, FieldType} <- Fields]]),
+ {ok, RecType};
error ->
error
end.
diff --git a/lib/dialyzer/test/Makefile b/lib/dialyzer/test/Makefile
index 9f8a3f1194..27cabc8ef8 100644
--- a/lib/dialyzer/test/Makefile
+++ b/lib/dialyzer/test/Makefile
@@ -7,6 +7,7 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk
AUXILIARY_FILES=\
dialyzer.spec\
+ dialyzer.cover\
dialyzer_test_constants.hrl\
dialyzer_common.erl\
file_utils.erl\
diff --git a/lib/dialyzer/test/dialyzer.cover b/lib/dialyzer/test/dialyzer.cover
new file mode 100644
index 0000000000..cc61ea1901
--- /dev/null
+++ b/lib/dialyzer/test/dialyzer.cover
@@ -0,0 +1,3 @@
+%% -*- erlang -*-
+{incl_app,dialyzer,details}.
+%{incl_mods,dialyzer,[erl_types,erl_bif_types]}.
diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/crash b/lib/dialyzer/test/opaque_SUITE_data/results/crash
index 1ddae5149f..69bdc00257 100644
--- a/lib/dialyzer/test/opaque_SUITE_data/results/crash
+++ b/lib/dialyzer/test/opaque_SUITE_data/results/crash
@@ -1,6 +1,6 @@
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:48: The call crash_1:get_using_branch2(Branch::maybe_improper_list(),L::'undefined' | crash_1:target()) will never return since it differs in the 2nd argument from the success typing arguments: (any(),maybe_improper_list())
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/ets b/lib/dialyzer/test/opaque_SUITE_data/results/ets
index 5498ba1538..e79696bc30 100644
--- a/lib/dialyzer/test/opaque_SUITE_data/results/ets
+++ b/lib/dialyzer/test/opaque_SUITE_data/results/ets
@@ -1,3 +1,4 @@
ets_use.erl:12: Guard test is_integer(T::atom() | tid()) breaks the opaqueness of its argument
+ets_use.erl:20: The type test is_integer(atom() | tid()) breaks the opaqueness of the term atom() | tid()
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/ewgi b/lib/dialyzer/test/opaque_SUITE_data/results/ewgi
index 3c8cfb59f8..5bc6b87fbb 100644
--- a/lib/dialyzer/test/opaque_SUITE_data/results/ewgi
+++ b/lib/dialyzer/test/opaque_SUITE_data/results/ewgi
@@ -1,4 +1,4 @@
ewgi_api.erl:55: The call gb_trees:to_list({non_neg_integer(),'nil' | {_,_,_,_}}) does not have an opaque term of type gb_tree() as 1st argument
-ewgi_testapp.erl:35: The call ewgi_testapp:htmlise_data("request_data",{non_neg_integer(),'nil' | {_,_,_,_}}) will never return since it differs in the 2nd argument from the success typing arguments: ([95 | 97 | 100 | 101 | 104 | 112 | 113 | 114 | 115 | 116 | 117,...],[{_,_}])
+ewgi_testapp.erl:35: The call ewgi_testapp:htmlise_data("request_data",{non_neg_integer(),'nil' | {_,_,_,_}}) does not have a term of type [{_,_}] | gb_tree() (with opaque subterms) as 2nd argument
ewgi_testapp.erl:43: The call gb_trees:to_list(T::{non_neg_integer(),'nil' | {_,_,_,_}}) does not have an opaque term of type gb_tree() as 1st argument
diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/inf_loop1 b/lib/dialyzer/test/opaque_SUITE_data/results/inf_loop1
index eb8f304905..4fe5fcfe2d 100644
--- a/lib/dialyzer/test/opaque_SUITE_data/results/inf_loop1
+++ b/lib/dialyzer/test/opaque_SUITE_data/results/inf_loop1
@@ -2,4 +2,4 @@
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
+inf_loop1.erl:71: The call gb_trees:get(Edge::any(),Etab::array()) does not have an opaque term of type gb_tree() as 2nd argument
diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/inf_loop2 b/lib/dialyzer/test/opaque_SUITE_data/results/inf_loop2
new file mode 100644
index 0000000000..4f0b79eb35
--- /dev/null
+++ b/lib/dialyzer/test/opaque_SUITE_data/results/inf_loop2
@@ -0,0 +1,5 @@
+
+inf_loop2.erl:122: The pattern [{_, LNorms}] can never match the type []
+inf_loop2.erl:124: The pattern [{LinksA, LNormA}, {LinksB, LNormB}] can never match the type []
+inf_loop2.erl:132: The pattern [{_, Norm} | _] can never match the type []
+inf_loop2.erl:74: The call gb_trees:get(Edge::any(),Etab::array()) does not have an opaque term of type gb_tree() as 2nd argument
diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/int b/lib/dialyzer/test/opaque_SUITE_data/results/int
index 3ee4def34b..dc806fa12c 100644
--- a/lib/dialyzer/test/opaque_SUITE_data/results/int
+++ b/lib/dialyzer/test/opaque_SUITE_data/results/int
@@ -1,3 +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()
+int_adt.erl:28: Invalid type specification for function int_adt:add_f/2. The success typing is (number() | int_adt:int(),float()) -> number() | int_adt:int()
+int_adt.erl:32: Invalid type specification for function int_adt:div_f/2. The success typing is (number() | int_adt:int(),number() | int_adt:int()) -> float()
diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/mixed_opaque b/lib/dialyzer/test/opaque_SUITE_data/results/mixed_opaque
index ab850b613e..0363be544d 100644
--- a/lib/dialyzer/test/opaque_SUITE_data/results/mixed_opaque
+++ b/lib/dialyzer/test/opaque_SUITE_data/results/mixed_opaque
@@ -1,2 +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
+mixed_opaque_use.erl:31: The call mixed_opaque_rec_adt:get_a(Q::mixed_opaque_queue_adt:my_queue()) does not have an opaque term of type mixed_opaque_rec_adt:rec() as 1st argument
diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/modules b/lib/dialyzer/test/opaque_SUITE_data/results/modules
new file mode 100644
index 0000000000..f71334b9de
--- /dev/null
+++ b/lib/dialyzer/test/opaque_SUITE_data/results/modules
@@ -0,0 +1,3 @@
+
+opaque_digraph.erl:353: Cons will produce an improper list since its 2nd argument is number()
+opaque_digraph.erl:365: Cons will produce an improper list since its 2nd argument is number()
diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/my_queue b/lib/dialyzer/test/opaque_SUITE_data/results/my_queue
index 2860b91084..1f25a6f9c3 100644
--- a/lib/dialyzer/test/opaque_SUITE_data/results/my_queue
+++ b/lib/dialyzer/test/opaque_SUITE_data/results/my_queue
@@ -4,4 +4,4 @@ my_queue_use.erl:19: The call my_queue_adt:add(42,Q0::[]) does not have an opaqu
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
+my_queue_use.erl:34: The call my_queue_adt:dequeue(nonempty_maybe_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
index ca76f57b54..5747f9061f 100644
--- a/lib/dialyzer/test/opaque_SUITE_data/results/opaque
+++ b/lib/dialyzer/test/opaque_SUITE_data/results/opaque
@@ -1,2 +1,3 @@
+opaque_bug3.erl:19: The pattern 'a' can never match the type #c{}
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
index c3f04ea64d..59ce33f098 100644
--- a/lib/dialyzer/test/opaque_SUITE_data/results/queue
+++ b/lib/dialyzer/test/opaque_SUITE_data/results/queue
@@ -5,7 +5,6 @@ queue_use.erl:27: The attempt to match a term of type queue() against the patter
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:48: The call queue_use:add_unique(42,#db{p::[],q::queue()}) contains an opaque term as 2nd argument when terms of different types are expected in these positions
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
diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/simple b/lib/dialyzer/test/opaque_SUITE_data/results/simple
new file mode 100644
index 0000000000..f55b384cbe
--- /dev/null
+++ b/lib/dialyzer/test/opaque_SUITE_data/results/simple
@@ -0,0 +1,87 @@
+
+exact_api.erl:17: The call exact_api:set_type(A::#digraph{vtab::'notable',etab::'notable',ntab::'notable',cyclic::'true'}) does not have an opaque term of type digraph() as 1st argument
+exact_api.erl:23: The call digraph:delete(G::#digraph{vtab::'notable',etab::'notable',ntab::'notable',cyclic::'true'}) does not have an opaque term of type digraph() as 1st argument
+exact_api.erl:55: The attempt to match a term of type exact_adt:exact_adt() against the pattern {'exact_adt'} breaks the opaqueness of the term
+exact_api.erl:59: The call exact_adt:exact_adt_set_type2(A::#exact_adt{}) does not have an opaque term of type exact_adt:exact_adt() as 1st argument
+is_rec.erl:10: The call erlang:is_record(simple1_adt:d1(),'r',2) contains an opaque term as 1st argument when terms of different types are expected in these positions
+is_rec.erl:15: The call erlang:is_record(A::simple1_adt:d1(),'r',I::1 | 2 | 3) contains an opaque term as 1st argument when terms of different types are expected in these positions
+is_rec.erl:19: Guard test is_record(A::simple1_adt:d1(),'r',2) breaks the opaqueness of its argument
+is_rec.erl:23: Guard test is_record({simple1_adt:d1(),1},'r',2) breaks the opaqueness of its argument
+is_rec.erl:41: The call erlang:is_record(A::simple1_adt:d1(),R::'a') contains an opaque term as 1st argument when terms of different types are expected in these positions
+is_rec.erl:45: The call erlang:is_record(A::simple1_adt:d1(),A::simple1_adt:d1(),1) contains an opaque term as 2nd argument when terms of different types are expected in these positions
+is_rec.erl:49: The call erlang:is_record(A::simple1_adt:d1(),any(),1) contains an opaque term as 1st argument when terms of different types are expected in these positions
+is_rec.erl:53: The call erlang:is_record(A::simple1_adt:d1(),A::simple1_adt:d1(),any()) contains an opaque term as 2nd argument when terms of different types are expected in these positions
+is_rec.erl:57: Guard test is_record(A::simple1_adt:d1(),'r',2) breaks the opaqueness of its argument
+is_rec.erl:61: The record #r{f1::simple1_adt:d1()} violates the declared type for #r{}
+is_rec.erl:65: The call erlang:is_record({simple1_adt:d1(),1},'r',2) contains an opaque term as 1st argument when terms of different types are expected in these positions
+rec_api.erl:22: Record construction #r1{f1::10} violates the declared type of field f1::'undefined' | rec_api:a()
+rec_api.erl:23: The pattern {'r1', 10} violates the declared type for #r1{}
+rec_api.erl:27: The attempt to match a term of type rec_adt:r1() against the pattern {'r1', 'a'} breaks the opaqueness of the term
+rec_api.erl:29: Invalid type specification for function rec_api:adt_t1/1. The success typing is (#r1{f1::'a'}) -> #r1{f1::'a'}
+rec_api.erl:34: Invalid type specification for function rec_api:adt_r1/0. The success typing is () -> #r1{f1::'a'}
+rec_api.erl:77: The attempt to match a term of type rec_api:f() against the variable _ breaks the opaqueness of the term
+simple1_api.erl:113: The test simple1_api:d1() =:= simple1_api:d2() can never evaluate to 'true'
+simple1_api.erl:118: Guard test simple1_api:d2() =:= A::simple1_api:d1() can never succeed
+simple1_api.erl:142: Attempt to test for equality between a term of type simple1_adt:o2() and a term of opaque type simple1_adt:o1()
+simple1_api.erl:148: Guard test simple1_adt:o2() =:= A::simple1_adt:o1() contains an opaque term as 1st argument
+simple1_api.erl:154: Attempt to test for inequality between a term of type simple1_adt:o2() and a term of opaque type simple1_adt:o1()
+simple1_api.erl:160: Attempt to test for inequality between a term of type simple1_adt:o2() and a term of opaque type simple1_adt:o1()
+simple1_api.erl:165: Attempt to test for equality between a term of type simple1_adt:c2() and a term of opaque type simple1_adt:c1()
+simple1_api.erl:181: Guard test A::simple1_adt:d1() =< B::simple1_adt:d2() contains an opaque term as 1st argument
+simple1_api.erl:185: Guard test 'a' =< B::simple1_adt:d2() contains an opaque term as 2nd argument
+simple1_api.erl:189: Guard test A::simple1_adt:d1() =< 'd' contains an opaque term as 1st argument
+simple1_api.erl:197: The type test is_integer(A::simple1_adt:d1()) breaks the opaqueness of the term A::simple1_adt:d1()
+simple1_api.erl:221: Guard test A::simple1_api:i1() > 3 can never succeed
+simple1_api.erl:225: Guard test A::simple1_adt:i1() > 3 contains an opaque term as 1st argument
+simple1_api.erl:233: Guard test A::simple1_adt:i1() < 3 contains an opaque term as 1st argument
+simple1_api.erl:239: Guard test A::1 > 3 can never succeed
+simple1_api.erl:243: Guard test A::1 > 3 can never succeed
+simple1_api.erl:257: Guard test is_function(T::simple1_api:o1()) can never succeed
+simple1_api.erl:265: Guard test is_function(T::simple1_adt:o1()) breaks the opaqueness of its argument
+simple1_api.erl:269: The type test is_function(T::simple1_adt:o1()) breaks the opaqueness of the term T::simple1_adt:o1()
+simple1_api.erl:274: Guard test is_function(T::simple1_api:o1(),A::simple1_api:i1()) can never succeed
+simple1_api.erl:284: Guard test is_function(T::simple1_adt:o1(),A::simple1_adt:i1()) breaks the opaqueness of its argument
+simple1_api.erl:289: The type test is_function(T::simple1_adt:o1(),A::simple1_adt:i1()) breaks the opaqueness of the term T::simple1_adt:o1()
+simple1_api.erl:294: The call erlang:is_function(T::simple1_api:o1(),A::simple1_adt:i1()) contains an opaque term as 2nd argument when terms of different types are expected in these positions
+simple1_api.erl:300: The type test is_function(T::simple1_adt:o1(),A::simple1_api:i1()) breaks the opaqueness of the term T::simple1_adt:o1()
+simple1_api.erl:306: Guard test B::simple1_api:b2() =:= 'true' can never succeed
+simple1_api.erl:315: Guard test A::simple1_api:b1() =:= 'false' can never succeed
+simple1_api.erl:319: Guard test not('and'('true','true')) can never succeed
+simple1_api.erl:337: Clause guard cannot succeed.
+simple1_api.erl:342: Guard test B::simple1_adt:b2() =:= 'true' contains an opaque term as 1st argument
+simple1_api.erl:347: Guard test A::simple1_adt:b1() =:= 'true' contains an opaque term as 1st argument
+simple1_api.erl:355: Invalid type specification for function simple1_api:bool_adt_t6/1. The success typing is ('true') -> 1
+simple1_api.erl:365: Clause guard cannot succeed.
+simple1_api.erl:368: Invalid type specification for function simple1_api:bool_adt_t8/2. The success typing is (boolean(),boolean()) -> 1
+simple1_api.erl:378: Clause guard cannot succeed.
+simple1_api.erl:381: Invalid type specification for function simple1_api:bool_adt_t9/2. The success typing is ('false','false') -> 1
+simple1_api.erl:407: The size simple1_adt:i1() breaks the opaqueness of A
+simple1_api.erl:418: The attempt to match a term of type non_neg_integer() against the variable A breaks the opaqueness of simple1_adt:i1()
+simple1_api.erl:425: The attempt to match a term of type non_neg_integer() against the variable B breaks the opaqueness of simple1_adt:i1()
+simple1_api.erl:432: The attempt to match a term of type non_neg_integer() against the variable B breaks the opaqueness of simple1_api:o1()
+simple1_api.erl:448: The attempt to match a term of type non_neg_integer() against the variable Sz breaks the opaqueness of simple1_adt:i1()
+simple1_api.erl:460: The attempt to match a term of type simple1_adt:bit1() against the pattern <<_/binary-unit:8>> breaks the opaqueness of the term
+simple1_api.erl:478: The call 'foo':A(A::simple1_adt:a()) breaks the opaqueness of the term A :: simple1_adt:a()
+simple1_api.erl:486: The call A:'foo'(A::simple1_adt:a()) breaks the opaqueness of the term A :: simple1_adt:a()
+simple1_api.erl:499: The call 'foo':A(A::simple1_api:i()) requires that A is of type atom() not simple1_api:i()
+simple1_api.erl:503: The call 'foo':A(A::simple1_adt:i()) requires that A is of type atom() not simple1_adt:i()
+simple1_api.erl:507: The call A:'foo'(A::simple1_api:i()) requires that A is of type atom() | tuple() not simple1_api:i()
+simple1_api.erl:511: The call A:'foo'(A::simple1_adt:i()) requires that A is of type atom() | tuple() not simple1_adt:i()
+simple1_api.erl:519: Guard test A::simple1_adt:d2() == B::simple1_adt:d1() contains an opaque term as 1st argument
+simple1_api.erl:534: Guard test A::simple1_adt:d1() >= 3 contains an opaque term as 1st argument
+simple1_api.erl:536: Guard test A::simple1_adt:d1() == 3 contains an opaque term as 1st argument
+simple1_api.erl:538: Guard test A::simple1_adt:d1() =:= 3 contains an opaque term as 1st argument
+simple1_api.erl:548: The call erlang:'<'(A::simple1_adt:d1(),3) contains an opaque term as 1st argument when terms of different types are expected in these positions
+simple1_api.erl:558: The call erlang:'=<'(A::simple1_adt:d1(),B::simple1_adt:d2()) contains an opaque term as 1st argument when terms of different types are expected in these positions
+simple1_api.erl:565: Guard test {digraph(),3} > {digraph(),atom() | tid()} contains an opaque term as 2nd argument
+simple1_api.erl:91: Invalid type specification for function simple1_api:tup/0. The success typing is () -> {'a','b'}
+simple2_api.erl:100: The call lists:flatten(A::simple1_adt:tuple1()) contains an opaque term as 1st argument when a structured term of type [any()] is expected
+simple2_api.erl:116: The call lists:flatten({simple1_adt:tuple1()}) will never return since it differs in the 1st argument from the success typing arguments: ([any()])
+simple2_api.erl:121: Guard test {simple1_adt:d1(),3} > {simple1_adt:d1(),simple1_adt:tuple1()} contains an opaque term as 2nd argument
+simple2_api.erl:125: The call erlang:tuple_to_list(B::simple1_adt:tuple1()) contains an opaque term as 1st argument when a structured term of type tuple() is expected
+simple2_api.erl:31: The call erlang:'!'(A::simple1_adt:d1(),'foo') contains an opaque term as 1st argument when terms of different types are expected in these positions
+simple2_api.erl:35: The call erlang:send(A::simple1_adt:d1(),'foo') contains an opaque term as 1st argument when terms of different types are expected in these positions
+simple2_api.erl:51: The call erlang:'<'(A::simple1_adt:d1(),3) contains an opaque term as 1st argument when terms of different types are expected in these positions
+simple2_api.erl:59: The call lists:keysearch(1,A::simple1_adt:d1(),[]) contains an opaque term as 2nd argument when terms of different types are expected in these positions
+simple2_api.erl:67: The call lists:keysearch('key',1,A::simple1_adt:tuple1()) contains an opaque term as 3rd argument when terms of different types are expected in these positions
+simple2_api.erl:96: The call lists:keyreplace('a',1,[{1, 2}],A::simple1_adt:tuple1()) contains an opaque term as 4th argument when terms of different types are expected in these positions
diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/wings b/lib/dialyzer/test/opaque_SUITE_data/results/wings
index a9571441f8..0ca91ae331 100644
--- a/lib/dialyzer/test/opaque_SUITE_data/results/wings
+++ b/lib/dialyzer/test/opaque_SUITE_data/results/wings
@@ -4,7 +4,7 @@ wings_dissolve.erl:19: Guard test is_list(Faces::gb_set()) breaks the opaqueness
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:30: The call gb_trees:size(P::gb_set()) does not have an opaque term of type gb_tree() as 1st argument
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()
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
index d65af0af4e..4eb202f16a 100644
--- a/lib/dialyzer/test/opaque_SUITE_data/src/ets/ets_use.erl
+++ b/lib/dialyzer/test/opaque_SUITE_data/src/ets/ets_use.erl
@@ -1,5 +1,5 @@
-module(ets_use).
--export([t1/0, t2/0]).
+-export([t1/0, t2/0, t3/0, t4/0]).
t1() ->
case n() of
@@ -13,4 +13,10 @@ t2() ->
T when is_atom(T) -> atm
end.
-n() -> ets:new(n, [named_table]).
+t3() ->
+ is_atom(n()). % no warning since atom() is possible
+
+t4() ->
+ is_integer(n()). % opaque warning since tid() is opaque
+
+n() -> ets:new(n, [named_table]). % -> atom() | tid()
diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/inf_loop2.erl b/lib/dialyzer/test/opaque_SUITE_data/src/inf_loop2.erl
new file mode 100644
index 0000000000..659ccaf015
--- /dev/null
+++ b/lib/dialyzer/test/opaque_SUITE_data/src/inf_loop2.erl
@@ -0,0 +1,175 @@
+%% -*- erlang-indent-level: 2 -*-
+%%----------------------------------------------------------------------------
+%% Copy of inf_loop1.erl, where the calls mentioned below have been
+%% restored.
+
+%% 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_loop2).
+
+-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 = gb_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, gb_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/modules/opaque_digraph.erl b/lib/dialyzer/test/opaque_SUITE_data/src/modules/opaque_digraph.erl
new file mode 100644
index 0000000000..09d4229e28
--- /dev/null
+++ b/lib/dialyzer/test/opaque_SUITE_data/src/modules/opaque_digraph.erl
@@ -0,0 +1,655 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2014. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+
+%%% The Erlang scanner. All types are opaque, which puts some stress
+%%% on Dialyzer.
+
+-module(opaque_digraph).
+
+-export([new/0, new/1, delete/1, info/1]).
+
+-export([add_vertex/1, add_vertex/2, add_vertex/3]).
+-export([del_vertex/2, del_vertices/2]).
+-export([vertex/2, no_vertices/1, vertices/1]).
+-export([source_vertices/1, sink_vertices/1]).
+
+-export([add_edge/3, add_edge/4, add_edge/5]).
+-export([del_edge/2, del_edges/2, del_path/3]).
+-export([edge/2, no_edges/1, edges/1]).
+
+-export([out_neighbours/2, in_neighbours/2]).
+-export([out_edges/2, in_edges/2, edges/2]).
+-export([out_degree/2, in_degree/2]).
+-export([get_path/3, get_cycle/2]).
+
+-export([get_short_path/3, get_short_cycle/2]).
+
+-export_type([local_digraph/0, d_type/0, vertex/0]).
+
+-record(digraph, {vtab = notable :: ets:tab(),
+ etab = notable :: ets:tab(),
+ ntab = notable :: ets:tab(),
+ cyclic = true :: boolean()}).
+
+-opaque local_digraph() :: #digraph{}.
+
+-export_type([edge/0, label/0, add_edge_err_rsn/0,
+ d_protection/0, d_cyclicity/0]).
+
+-opaque edge() :: term().
+-opaque label() :: term().
+-opaque vertex() :: term().
+
+-opaque add_edge_err_rsn() :: {'bad_edge', Path :: [vertex()]}
+ | {'bad_vertex', V :: vertex()}.
+
+%%
+%% Type is a list of
+%% protected | private
+%% acyclic | cyclic
+%%
+%% default is [cyclic,protected]
+%%
+-opaque d_protection() :: 'private' | 'protected'.
+-opaque d_cyclicity() :: 'acyclic' | 'cyclic'.
+-opaque d_type() :: d_cyclicity() | d_protection().
+
+-spec new() -> local_digraph().
+
+new() -> new([]).
+
+-spec new(Type) -> local_digraph() when
+ Type :: [d_type()].
+
+new(Type) ->
+ case 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, #digraph{vtab=V, etab=E, ntab=N});
+ error ->
+ erlang:error(badarg)
+ end.
+
+%%
+%% Check type of graph
+%%
+%-spec check_type([d_type()], 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([], A, L) -> {A, L};
+check_type(_, _, _) -> error.
+
+%%
+%% Set graph type
+%%
+-spec set_type([{'cyclic', boolean()}], local_digraph()) -> local_digraph().
+
+set_type([{cyclic,V} | Ks], G) ->
+ set_type(Ks, G#digraph{cyclic = V});
+set_type([], G) -> G.
+
+
+%% Data access functions
+
+-spec delete(G) -> 'true' when
+ G :: local_digraph().
+
+delete(G) ->
+ ets:delete(G#digraph.vtab),
+ ets:delete(G#digraph.etab),
+ ets:delete(G#digraph.ntab).
+
+-spec info(G) -> InfoList when
+ G :: local_digraph(),
+ InfoList :: [{'cyclicity', Cyclicity :: d_cyclicity()} |
+ {'memory', NoWords :: non_neg_integer()} |
+ {'protection', Protection :: d_protection()}].
+
+info(G) ->
+ VT = G#digraph.vtab,
+ ET = G#digraph.etab,
+ NT = G#digraph.ntab,
+ Cyclicity = case G#digraph.cyclic of
+ true -> cyclic;
+ false -> acyclic
+ end,
+ Protection = ets:info(VT, protection),
+ Memory = ets:info(VT, memory) + ets:info(ET, memory) + ets:info(NT, memory),
+ [{cyclicity, Cyclicity}, {memory, Memory}, {protection, Protection}].
+
+-spec add_vertex(G) -> vertex() when
+ G :: local_digraph().
+
+add_vertex(G) ->
+ do_add_vertex({new_vertex_id(G), []}, G).
+
+-spec add_vertex(G, V) -> vertex() when
+ G :: local_digraph(),
+ V :: vertex().
+
+add_vertex(G, V) ->
+ do_add_vertex({V, []}, G).
+
+-spec add_vertex(G, V, Label) -> vertex() when
+ G :: local_digraph(),
+ V :: vertex(),
+ Label :: label().
+
+add_vertex(G, V, D) ->
+ do_add_vertex({V, D}, G).
+
+-spec del_vertex(G, V) -> 'true' when
+ G :: local_digraph(),
+ V :: vertex().
+
+del_vertex(G, V) ->
+ do_del_vertex(V, G).
+
+-spec del_vertices(G, Vertices) -> 'true' when
+ G :: local_digraph(),
+ Vertices :: [vertex()].
+
+del_vertices(G, Vs) ->
+ do_del_vertices(Vs, G).
+
+-spec vertex(G, V) -> {V, Label} | 'false' when
+ G :: local_digraph(),
+ V :: vertex(),
+ Label :: label().
+
+vertex(G, V) ->
+ case ets:lookup(G#digraph.vtab, V) of
+ [] -> false;
+ [Vertex] -> Vertex
+ end.
+
+-spec no_vertices(G) -> non_neg_integer() when
+ G :: local_digraph().
+
+no_vertices(G) ->
+ ets:info(G#digraph.vtab, size).
+
+-spec vertices(G) -> Vertices when
+ G :: local_digraph(),
+ Vertices :: [vertex()].
+
+vertices(G) ->
+ ets:select(G#digraph.vtab, [{{'$1', '_'}, [], ['$1']}]).
+
+-spec source_vertices(local_digraph()) -> [vertex()].
+
+source_vertices(G) ->
+ collect_vertices(G, in).
+
+-spec sink_vertices(local_digraph()) -> [vertex()].
+
+sink_vertices(G) ->
+ collect_vertices(G, out).
+
+-spec in_degree(G, V) -> non_neg_integer() when
+ G :: local_digraph(),
+ V :: vertex().
+
+in_degree(G, V) ->
+ length(ets:lookup(G#digraph.ntab, {in, V})).
+
+-spec in_neighbours(G, V) -> Vertex when
+ G :: local_digraph(),
+ V :: vertex(),
+ Vertex :: [vertex()].
+
+in_neighbours(G, V) ->
+ ET = G#digraph.etab,
+ NT = G#digraph.ntab,
+ collect_elems(ets:lookup(NT, {in, V}), ET, 2).
+
+-spec in_edges(G, V) -> Edges when
+ G :: local_digraph(),
+ V :: vertex(),
+ Edges :: [edge()].
+
+in_edges(G, V) ->
+ ets:select(G#digraph.ntab, [{{{in, V}, '$1'}, [], ['$1']}]).
+
+-spec out_degree(G, V) -> non_neg_integer() when
+ G :: local_digraph(),
+ V :: vertex().
+
+out_degree(G, V) ->
+ length(ets:lookup(G#digraph.ntab, {out, V})).
+
+-spec out_neighbours(G, V) -> Vertices when
+ G :: local_digraph(),
+ V :: vertex(),
+ Vertices :: [vertex()].
+
+out_neighbours(G, V) ->
+ ET = G#digraph.etab,
+ NT = G#digraph.ntab,
+ collect_elems(ets:lookup(NT, {out, V}), ET, 3).
+
+-spec out_edges(G, V) -> Edges when
+ G :: local_digraph(),
+ V :: vertex(),
+ Edges :: [edge()].
+
+out_edges(G, V) ->
+ ets:select(G#digraph.ntab, [{{{out, V}, '$1'}, [], ['$1']}]).
+
+-spec add_edge(G, V1, V2) -> edge() | {'error', add_edge_err_rsn()} when
+ G :: local_digraph(),
+ V1 :: vertex(),
+ V2 :: vertex().
+
+add_edge(G, V1, V2) ->
+ do_add_edge({new_edge_id(G), V1, V2, []}, G).
+
+-spec add_edge(G, V1, V2, Label) -> edge() | {'error', add_edge_err_rsn()} when
+ G :: local_digraph(),
+ V1 :: vertex(),
+ V2 :: vertex(),
+ Label :: label().
+
+add_edge(G, V1, V2, D) ->
+ do_add_edge({new_edge_id(G), V1, V2, D}, G).
+
+-spec add_edge(G, E, V1, V2, Label) -> edge() | {'error', add_edge_err_rsn()} when
+ G :: local_digraph(),
+ E :: edge(),
+ V1 :: vertex(),
+ V2 :: vertex(),
+ Label :: label().
+
+add_edge(G, E, V1, V2, D) ->
+ do_add_edge({E, V1, V2, D}, G).
+
+-spec del_edge(G, E) -> 'true' when
+ G :: local_digraph(),
+ E :: edge().
+
+del_edge(G, E) ->
+ do_del_edges([E], G).
+
+-spec del_edges(G, Edges) -> 'true' when
+ G :: local_digraph(),
+ Edges :: [edge()].
+
+del_edges(G, Es) ->
+ do_del_edges(Es, G).
+
+-spec no_edges(G) -> non_neg_integer() when
+ G :: local_digraph().
+
+no_edges(G) ->
+ ets:info(G#digraph.etab, size).
+
+-spec edges(G) -> Edges when
+ G :: local_digraph(),
+ Edges :: [edge()].
+
+edges(G) ->
+ ets:select(G#digraph.etab, [{{'$1', '_', '_', '_'}, [], ['$1']}]).
+
+-spec edges(G, V) -> Edges when
+ G :: local_digraph(),
+ V :: vertex(),
+ Edges :: [edge()].
+
+edges(G, V) ->
+ ets:select(G#digraph.ntab, [{{{out, V},'$1'}, [], ['$1']},
+ {{{in, V}, '$1'}, [], ['$1']}]).
+
+-spec edge(G, E) -> {E, V1, V2, Label} | 'false' when
+ G :: local_digraph(),
+ E :: edge(),
+ V1 :: vertex(),
+ V2 :: vertex(),
+ Label :: label().
+
+edge(G, E) ->
+ case ets:lookup(G#digraph.etab,E) of
+ [] -> false;
+ [Edge] -> Edge
+ end.
+
+%%
+%% Generate a "unique" edge identifier (relative to this graph)
+%%
+-spec new_edge_id(local_digraph()) -> edge().
+
+new_edge_id(G) ->
+ NT = G#digraph.ntab,
+ [{'$eid', K}] = ets:lookup(NT, '$eid'),
+ true = ets:delete(NT, '$eid'),
+ true = ets:insert(NT, {'$eid', K+1}),
+ ['$e' | K].
+
+%%
+%% Generate a "unique" vertex identifier (relative to this graph)
+%%
+-spec new_vertex_id(local_digraph()) -> vertex().
+
+new_vertex_id(G) ->
+ NT = G#digraph.ntab,
+ [{'$vid', K}] = ets:lookup(NT, '$vid'),
+ true = ets:delete(NT, '$vid'),
+ true = ets:insert(NT, {'$vid', K+1}),
+ ['$v' | K].
+
+%%
+%% Collect elements for a index in a tuple
+%%
+collect_elems(Keys, Table, Index) ->
+ collect_elems(Keys, Table, Index, []).
+
+collect_elems([{_,Key}|Keys], Table, Index, Acc) ->
+ collect_elems(Keys, Table, Index,
+ [ets:lookup_element(Table, Key, Index)|Acc]);
+collect_elems([], _, _, Acc) -> Acc.
+
+-spec do_add_vertex({vertex(), label()}, local_digraph()) -> vertex().
+
+do_add_vertex({V, _Label} = VL, G) ->
+ ets:insert(G#digraph.vtab, VL),
+ V.
+
+%%
+%% Collect either source or sink vertices.
+%%
+collect_vertices(G, Type) ->
+ Vs = vertices(G),
+ lists:foldl(fun(V, A) ->
+ case ets:member(G#digraph.ntab, {Type, V}) of
+ true -> A;
+ false -> [V|A]
+ end
+ end, [], Vs).
+
+%%
+%% Delete vertices
+%%
+do_del_vertices([V | Vs], G) ->
+ do_del_vertex(V, G),
+ do_del_vertices(Vs, G);
+do_del_vertices([], #digraph{}) -> true.
+
+do_del_vertex(V, G) ->
+ do_del_nedges(ets:lookup(G#digraph.ntab, {in, V}), G),
+ do_del_nedges(ets:lookup(G#digraph.ntab, {out, V}), G),
+ ets:delete(G#digraph.vtab, V).
+
+do_del_nedges([{_, E}|Ns], G) ->
+ case ets:lookup(G#digraph.etab, E) of
+ [{E, V1, V2, _}] ->
+ do_del_edge(E, V1, V2, G),
+ do_del_nedges(Ns, G);
+ [] -> % cannot happen
+ do_del_nedges(Ns, G)
+ end;
+do_del_nedges([], #digraph{}) -> true.
+
+%%
+%% Delete edges
+%%
+do_del_edges([E|Es], G) ->
+ case ets:lookup(G#digraph.etab, E) of
+ [{E,V1,V2,_}] ->
+ do_del_edge(E,V1,V2,G),
+ do_del_edges(Es, G);
+ [] ->
+ do_del_edges(Es, G)
+ end;
+do_del_edges([], #digraph{}) -> true.
+
+do_del_edge(E, V1, V2, G) ->
+ ets:select_delete(G#digraph.ntab, [{{{in, V2}, E}, [], [true]},
+ {{{out,V1}, E}, [], [true]}]),
+ ets:delete(G#digraph.etab, E).
+
+-spec rm_edges([vertex(),...], local_digraph()) -> 'true'.
+
+rm_edges([V1, V2|Vs], G) ->
+ rm_edge(V1, V2, G),
+ rm_edges([V2|Vs], G);
+rm_edges(_, _) -> true.
+
+-spec rm_edge(vertex(), vertex(), local_digraph()) -> 'ok'.
+
+rm_edge(V1, V2, G) ->
+ Es = out_edges(G, V1),
+ rm_edge_0(Es, V1, V2, G).
+
+rm_edge_0([E|Es], V1, V2, G) ->
+ case ets:lookup(G#digraph.etab, E) of
+ [{E, V1, V2, _}] ->
+ do_del_edge(E, V1, V2, G),
+ rm_edge_0(Es, V1, V2, G);
+ _ ->
+ rm_edge_0(Es, V1, V2, G)
+ end;
+rm_edge_0([], _, _, #digraph{}) -> ok.
+
+%%
+%% Check that endpoints exist
+%%
+-spec do_add_edge({edge(), vertex(), vertex(), label()}, local_digraph()) ->
+ edge() | {'error', add_edge_err_rsn()}.
+
+do_add_edge({E, V1, V2, Label}, G) ->
+ case ets:member(G#digraph.vtab, V1) of
+ false -> {error, {bad_vertex, V1}};
+ true ->
+ case ets:member(G#digraph.vtab, V2) of
+ false -> {error, {bad_vertex, V2}};
+ true ->
+ case other_edge_exists(G, E, V1, V2) of
+ true -> {error, {bad_edge, [V1, V2]}};
+ false when G#digraph.cyclic =:= false ->
+ acyclic_add_edge(E, V1, V2, Label, G);
+ false ->
+ do_insert_edge(E, V1, V2, Label, G)
+ end
+ end
+ end.
+
+other_edge_exists(#digraph{etab = ET}, E, V1, V2) ->
+ case ets:lookup(ET, E) of
+ [{E, Vert1, Vert2, _}] when Vert1 =/= V1; Vert2 =/= V2 ->
+ true;
+ _ ->
+ false
+ end.
+
+-spec do_insert_edge(edge(), vertex(), vertex(), label(), local_digraph()) -> edge().
+
+do_insert_edge(E, V1, V2, Label, #digraph{ntab=NT, etab=ET}) ->
+ ets:insert(NT, [{{out, V1}, E}, {{in, V2}, E}]),
+ ets:insert(ET, {E, V1, V2, Label}),
+ E.
+
+-spec acyclic_add_edge(edge(), vertex(), vertex(), label(), local_digraph()) ->
+ edge() | {'error', {'bad_edge', [vertex()]}}.
+
+acyclic_add_edge(_E, V1, V2, _L, _G) when V1 =:= V2 ->
+ {error, {bad_edge, [V1, V2]}};
+acyclic_add_edge(E, V1, V2, Label, G) ->
+ case get_path(G, V2, V1) of
+ false -> do_insert_edge(E, V1, V2, Label, G);
+ Path -> {error, {bad_edge, Path}}
+ end.
+
+%%
+%% Delete all paths from vertex V1 to vertex V2
+%%
+
+-spec del_path(G, V1, V2) -> 'true' when
+ G :: local_digraph(),
+ V1 :: vertex(),
+ V2 :: vertex().
+
+del_path(G, V1, V2) ->
+ case get_path(G, V1, V2) of
+ false -> true;
+ Path ->
+ rm_edges(Path, G),
+ del_path(G, V1, V2)
+ end.
+
+%%
+%% Find a cycle through V
+%% return the cycle as list of vertices [V ... V]
+%% if no cycle exists false is returned
+%% if only a cycle of length one exists it will be
+%% returned as [V] but only after longer cycles have
+%% been searched.
+%%
+
+-spec get_cycle(G, V) -> Vertices | 'false' when
+ G :: local_digraph(),
+ V :: vertex(),
+ Vertices :: [vertex(),...].
+
+get_cycle(G, V) ->
+ case one_path(out_neighbours(G, V), V, [], [V], [V], 2, G, 1) of
+ false ->
+ case lists:member(V, out_neighbours(G, V)) of
+ true -> [V];
+ false -> false
+ end;
+ Vs -> Vs
+ end.
+
+%%
+%% Find a path from V1 to V2
+%% return the path as list of vertices [V1 ... V2]
+%% if no path exists false is returned
+%%
+
+-spec get_path(G, V1, V2) -> Vertices | 'false' when
+ G :: local_digraph(),
+ V1 :: vertex(),
+ V2 :: vertex(),
+ Vertices :: [vertex(),...].
+
+get_path(G, V1, V2) ->
+ one_path(out_neighbours(G, V1), V2, [], [V1], [V1], 1, G, 1).
+
+%%
+%% prune_short_path (evaluate conditions on path)
+%% short : if path is too short
+%% ok : if path is ok
+%%
+prune_short_path(Counter, Min) when Counter < Min ->
+ short;
+prune_short_path(_Counter, _Min) ->
+ ok.
+
+one_path([W|Ws], W, Cont, Xs, Ps, Prune, G, Counter) ->
+ case prune_short_path(Counter, Prune) of
+ short -> one_path(Ws, W, Cont, Xs, Ps, Prune, G, Counter);
+ ok -> lists:reverse([W|Ps])
+ end;
+one_path([V|Vs], W, Cont, Xs, Ps, Prune, G, Counter) ->
+ case lists:member(V, Xs) of
+ true -> one_path(Vs, W, Cont, Xs, Ps, Prune, G, Counter);
+ false -> one_path(out_neighbours(G, V), W,
+ [{Vs,Ps} | Cont], [V|Xs], [V|Ps],
+ Prune, G, Counter+1)
+ end;
+one_path([], W, [{Vs,Ps}|Cont], Xs, _, Prune, G, Counter) ->
+ one_path(Vs, W, Cont, Xs, Ps, Prune, G, Counter-1);
+one_path([], _, [], _, _, _, _, _Counter) -> false.
+
+%%
+%% Like get_cycle/2, but a cycle of length one is preferred.
+%%
+
+-spec get_short_cycle(G, V) -> Vertices | 'false' when
+ G :: local_digraph(),
+ V :: vertex(),
+ Vertices :: [vertex(),...].
+
+get_short_cycle(G, V) ->
+ get_short_path(G, V, V).
+
+%%
+%% Like get_path/3, but using a breadth-first search makes it possible
+%% to find a short path.
+%%
+
+-spec get_short_path(G, V1, V2) -> Vertices | 'false' when
+ G :: local_digraph(),
+ V1 :: vertex(),
+ V2 :: vertex(),
+ Vertices :: [vertex(),...].
+
+get_short_path(G, V1, V2) ->
+ T = new(),
+ add_vertex(T, V1),
+ Q = queue:new(),
+ Q1 = queue_out_neighbours(V1, G, Q),
+ L = spath(Q1, G, V2, T),
+ delete(T),
+ L.
+
+spath(Q, G, Sink, T) ->
+ case queue:out(Q) of
+ {{value, E}, Q1} ->
+ {_E, V1, V2, _Label} = edge(G, E),
+ if
+ Sink =:= V2 ->
+ follow_path(V1, T, [V2]);
+ true ->
+ case vertex(T, V2) of
+ false ->
+ add_vertex(T, V2),
+ add_edge(T, V2, V1),
+ NQ = queue_out_neighbours(V2, G, Q1),
+ spath(NQ, G, Sink, T);
+ _V ->
+ spath(Q1, G, Sink, T)
+ end
+ end;
+ {empty, _Q1} ->
+ false
+ end.
+
+follow_path(V, T, P) ->
+ P1 = [V | P],
+ case out_neighbours(T, V) of
+ [N] ->
+ follow_path(N, T, P1);
+ [] ->
+ P1
+ end.
+
+queue_out_neighbours(V, G, Q0) ->
+ lists:foldl(fun(E, Q) -> queue:in(E, Q) end, Q0, out_edges(G, V)).
diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/modules/opaque_erl_scan.erl b/lib/dialyzer/test/opaque_SUITE_data/src/modules/opaque_erl_scan.erl
new file mode 100644
index 0000000000..9ecd4f92a1
--- /dev/null
+++ b/lib/dialyzer/test/opaque_SUITE_data/src/modules/opaque_erl_scan.erl
@@ -0,0 +1,1300 @@
+%% -*- coding: utf-8 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2014. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+
+%%% The Erlang scanner. All types are opaque, which puts some stress
+%%% on Dialyzer.
+
+-module(opaque_erl_scan).
+
+%%% External exports
+
+-export([string/1,string/2,string/3,tokens/3,tokens/4,
+ format_error/1,reserved_word/1,
+ token_info/1,token_info/2,
+ attributes_info/1,attributes_info/2,set_attribute/3]).
+
+%%% Private
+-export([continuation_location/1]).
+
+-export_type([error_info/0,
+ line/0,
+ location/0,
+ options/0,
+ return_cont/0,
+ token/0,
+ tokens_result/0]).
+
+%%%
+%%% Defines and type definitions
+%%%
+
+-define(COLUMN(C), (is_integer(C) andalso C >= 1)).
+%% Line numbers less than zero have always been allowed:
+-define(ALINE(L), is_integer(L)).
+-define(STRING(S), is_list(S)).
+-define(RESWORDFUN(F), is_function(F, 1)).
+-define(SETATTRFUN(F), is_function(F, 1)).
+
+-export_type([category/0, column/0, resword_fun/0, option/0, symbol/0,
+ info_line/0, attributes_data/0, attributes/0, tokens/0,
+ error_description/0, char_spec/0, cont_fun/0,
+ attribute_item/0, info_location/0, attribute_info/0,
+ token_item/0, token_info/0]).
+
+-opaque category() :: atom().
+-opaque column() :: pos_integer().
+-opaque line() :: integer().
+-opaque location() :: line() | {line(),column()}.
+-opaque resword_fun() :: fun((atom()) -> boolean()).
+-opaque option() :: 'return' | 'return_white_spaces' | 'return_comments'
+ | 'text' | {'reserved_word_fun', resword_fun()}.
+-opaque options() :: option() | [option()].
+-opaque symbol() :: atom() | float() | integer() | string().
+-opaque info_line() :: integer() | term().
+-opaque attributes_data()
+ :: [{'column', column()} | {'line', info_line()} | {'text', string()}]
+ | {line(), column()}.
+%% The fact that {line(),column()} is a possible attributes() type
+%% is hidden.
+-opaque attributes() :: line() | attributes_data().
+-opaque token() :: {category(), attributes(), symbol()}
+ | {category(), attributes()}.
+-opaque tokens() :: [token()].
+-opaque error_description() :: term().
+-opaque error_info() :: {location(), module(), error_description()}.
+
+%%% Local record.
+-record(erl_scan,
+ {resword_fun = fun reserved_word/1 :: resword_fun(),
+ ws = false :: boolean(),
+ comment = false :: boolean(),
+ text = false :: boolean()}).
+
+%%----------------------------------------------------------------------------
+
+-spec format_error(ErrorDescriptor) -> string() when
+ ErrorDescriptor :: error_description().
+format_error({string,Quote,Head}) ->
+ lists:flatten(["unterminated " ++ string_thing(Quote) ++
+ " starting with " ++
+ io_lib:write_string(Head, Quote)]);
+format_error({illegal,Type}) ->
+ lists:flatten(io_lib:fwrite("illegal ~w", [Type]));
+format_error(char) -> "unterminated character";
+format_error({base,Base}) ->
+ lists:flatten(io_lib:fwrite("illegal base '~w'", [Base]));
+format_error(Other) ->
+ lists:flatten(io_lib:write(Other)).
+
+-spec string(String) -> Return when
+ String :: string(),
+ Return :: {'ok', Tokens :: tokens(), EndLocation}
+ | {'error', ErrorInfo :: error_info(), ErrorLocation},
+ EndLocation :: location(),
+ ErrorLocation :: location().
+string(String) ->
+ string(String, 1, []).
+
+-spec string(String, StartLocation) -> Return when
+ String :: string(),
+ Return :: {'ok', Tokens :: tokens(), EndLocation}
+ | {'error', ErrorInfo :: error_info(), ErrorLocation},
+ StartLocation :: location(),
+ EndLocation :: location(),
+ ErrorLocation :: location().
+string(String, StartLocation) ->
+ string(String, StartLocation, []).
+
+-spec string(String, StartLocation, Options) -> Return when
+ String :: string(),
+ Options :: options(),
+ Return :: {'ok', Tokens :: tokens(), EndLocation}
+ | {'error', ErrorInfo :: error_info(), ErrorLocation},
+ StartLocation :: location(),
+ EndLocation :: location(),
+ ErrorLocation :: location().
+string(String, Line, Options) when ?STRING(String), ?ALINE(Line) ->
+ string1(String, options(Options), Line, no_col, []);
+string(String, {Line,Column}, Options) when ?STRING(String),
+ ?ALINE(Line),
+ ?COLUMN(Column) ->
+ string1(String, options(Options), Line, Column, []).
+
+-opaque char_spec() :: string() | 'eof'.
+-opaque cont_fun() :: fun((char_spec(), #erl_scan{}, line(), column(),
+ tokens(), any()) -> any()).
+-opaque return_cont() :: {erl_scan_continuation,
+ string(), column(), tokens(), line(),
+ #erl_scan{}, any(), cont_fun()}.
+-opaque tokens_result() :: {'ok', Tokens :: tokens(), EndLocation :: location()}
+ | {'eof', EndLocation :: location()}
+ | {'error', ErrorInfo :: error_info(),
+ EndLocation :: location()}.
+
+-spec tokens(Continuation, CharSpec, StartLocation) -> Return when
+ Continuation :: return_cont() | [],
+ CharSpec :: char_spec(),
+ StartLocation :: location(),
+ Return :: {'done',Result :: tokens_result(),LeftOverChars :: char_spec()}
+ | {'more', Continuation1 :: return_cont()}.
+tokens(Cont, CharSpec, StartLocation) ->
+ tokens(Cont, CharSpec, StartLocation, []).
+
+-spec tokens(Continuation, CharSpec, StartLocation, Options) -> Return when
+ Continuation :: return_cont() | [],
+ CharSpec :: char_spec(),
+ StartLocation :: location(),
+ Options :: options(),
+ Return :: {'done',Result :: tokens_result(),LeftOverChars :: char_spec()}
+ | {'more', Continuation1 :: return_cont()}.
+tokens([], CharSpec, Line, Options) when ?ALINE(Line) ->
+ tokens1(CharSpec, options(Options), Line, no_col, [], fun scan/6, []);
+tokens([], CharSpec, {Line,Column}, Options) when ?ALINE(Line),
+ ?COLUMN(Column) ->
+ tokens1(CharSpec, options(Options), Line, Column, [], fun scan/6, []);
+tokens({erl_scan_continuation,Cs,Col,Toks,Line,St,Any,Fun},
+ CharSpec, _Loc, _Opts) ->
+ tokens1(Cs++CharSpec, St, Line, Col, Toks, Fun, Any).
+
+continuation_location({erl_scan_continuation,_,no_col,_,Line,_,_,_}) ->
+ Line;
+continuation_location({erl_scan_continuation,_,Col,_,Line,_,_,_}) ->
+ {Line,Col}.
+
+-opaque attribute_item() :: 'column' | 'length' | 'line'
+ | 'location' | 'text'.
+-opaque info_location() :: location() | term().
+-opaque attribute_info() :: {'column', column()}| {'length', pos_integer()}
+ | {'line', info_line()}
+ | {'location', info_location()}
+ | {'text', string()}.
+-opaque token_item() :: 'category' | 'symbol' | attribute_item().
+-opaque token_info() :: {'category', category()} | {'symbol', symbol()}
+ | attribute_info().
+
+-spec token_info(Token) -> TokenInfo when
+ Token :: token(),
+ TokenInfo :: [TokenInfoTuple :: token_info()].
+token_info(Token) ->
+ Items = [category,column,length,line,symbol,text], % undefined order
+ token_info(Token, Items).
+
+-spec token_info(Token, TokenItem) -> TokenInfoTuple | 'undefined' when
+ Token :: token(),
+ TokenItem :: token_item(),
+ TokenInfoTuple :: token_info();
+ (Token, TokenItems) -> TokenInfo when
+ Token :: token(),
+ TokenItems :: [TokenItem :: token_item()],
+ TokenInfo :: [TokenInfoTuple :: token_info()].
+token_info(_Token, []) ->
+ [];
+token_info(Token, [Item|Items]) when is_atom(Item) ->
+ case token_info(Token, Item) of
+ undefined ->
+ token_info(Token, Items);
+ TokenInfo when is_tuple(TokenInfo) ->
+ [TokenInfo|token_info(Token, Items)]
+ end;
+token_info({Category,_Attrs}, category=Item) ->
+ {Item,Category};
+token_info({Category,_Attrs,_Symbol}, category=Item) ->
+ {Item,Category};
+token_info({Category,_Attrs}, symbol=Item) ->
+ {Item,Category};
+token_info({_Category,_Attrs,Symbol}, symbol=Item) ->
+ {Item,Symbol};
+token_info({_Category,Attrs}, Item) ->
+ attributes_info(Attrs, Item);
+token_info({_Category,Attrs,_Symbol}, Item) ->
+ attributes_info(Attrs, Item).
+
+-spec attributes_info(Attributes) -> AttributesInfo when
+ Attributes :: attributes(),
+ AttributesInfo :: [AttributeInfoTuple :: attribute_info()].
+attributes_info(Attributes) ->
+ Items = [column,length,line,text], % undefined order
+ attributes_info(Attributes, Items).
+
+-spec attributes_info
+ (Attributes, AttributeItem) -> AttributeInfoTuple | 'undefined' when
+ Attributes :: attributes(),
+ AttributeItem :: attribute_item(),
+ AttributeInfoTuple :: attribute_info();
+ (Attributes, AttributeItems) -> AttributeInfo when
+ Attributes :: attributes(),
+ AttributeItems :: [AttributeItem :: attribute_item()],
+ AttributeInfo :: [AttributeInfoTuple :: attribute_info()].
+attributes_info(_Attrs, []) ->
+ [];
+attributes_info(Attrs, [A|As]) when is_atom(A) ->
+ case attributes_info(Attrs, A) of
+ undefined ->
+ attributes_info(Attrs, As);
+ AttributeInfo when is_tuple(AttributeInfo) ->
+ [AttributeInfo|attributes_info(Attrs, As)]
+ end;
+attributes_info({Line,Column}, column=Item) when ?ALINE(Line),
+ ?COLUMN(Column) ->
+ {Item,Column};
+attributes_info(Line, column) when ?ALINE(Line) ->
+ undefined;
+attributes_info(Attrs, column=Item) ->
+ attr_info(Attrs, Item);
+attributes_info(Attrs, length=Item) ->
+ case attributes_info(Attrs, text) of
+ undefined ->
+ undefined;
+ {text,Text} ->
+ {Item,length(Text)}
+ end;
+attributes_info(Line, line=Item) when ?ALINE(Line) ->
+ {Item,Line};
+attributes_info({Line,Column}, line=Item) when ?ALINE(Line),
+ ?COLUMN(Column) ->
+ {Item,Line};
+attributes_info(Attrs, line=Item) ->
+ attr_info(Attrs, Item);
+attributes_info({Line,Column}=Location, location=Item) when ?ALINE(Line),
+ ?COLUMN(Column) ->
+ {Item,Location};
+attributes_info(Line, location=Item) when ?ALINE(Line) ->
+ {Item,Line};
+attributes_info(Attrs, location=Item) ->
+ {line,Line} = attributes_info(Attrs, line), % assume line is present
+ case attributes_info(Attrs, column) of
+ undefined ->
+ %% If set_attribute() has assigned a term such as {17,42}
+ %% to 'line', then Line will look like {Line,Column}. One
+ %% should not use 'location' but 'line' and 'column' in
+ %% such special cases.
+ {Item,Line};
+ {column,Column} ->
+ {Item,{Line,Column}}
+ end;
+attributes_info({Line,Column}, text) when ?ALINE(Line), ?COLUMN(Column) ->
+ undefined;
+attributes_info(Line, text) when ?ALINE(Line) ->
+ undefined;
+attributes_info(Attrs, text=Item) ->
+ attr_info(Attrs, Item);
+attributes_info(T1, T2) ->
+ erlang:error(badarg, [T1,T2]).
+
+-spec set_attribute(AttributeItem, Attributes, SetAttributeFun) -> Attributes when
+ AttributeItem :: 'line',
+ Attributes :: attributes(),
+ SetAttributeFun :: fun((info_line()) -> info_line()).
+set_attribute(Tag, Attributes, Fun) when ?SETATTRFUN(Fun) ->
+ set_attr(Tag, Attributes, Fun).
+
+%%%
+%%% Local functions
+%%%
+
+string_thing($') -> "atom"; %' Stupid Emacs
+string_thing(_) -> "string".
+
+-define(WHITE_SPACE(C),
+ is_integer(C) andalso
+ (C >= $\000 andalso C =< $\s orelse C >= $\200 andalso C =< $\240)).
+-define(DIGIT(C), C >= $0, C =< $9).
+-define(CHAR(C), is_integer(C), C >= 0).
+-define(UNICODE(C),
+ is_integer(C) andalso
+ (C >= 0 andalso C < 16#D800 orelse
+ C > 16#DFFF andalso C < 16#FFFE orelse
+ C > 16#FFFF andalso C =< 16#10FFFF)).
+
+-define(UNI255(C), C >= 0, C =< 16#ff).
+
+options(Opts0) when is_list(Opts0) ->
+ Opts = lists:foldr(fun expand_opt/2, [], Opts0),
+ [RW_fun] =
+ case opts(Opts, [reserved_word_fun], []) of
+ badarg ->
+ erlang:error(badarg, [Opts0]);
+ R ->
+ R
+ end,
+ Comment = proplists:get_bool(return_comments, Opts),
+ WS = proplists:get_bool(return_white_spaces, Opts),
+ Txt = proplists:get_bool(text, Opts),
+ #erl_scan{resword_fun = RW_fun,
+ comment = Comment,
+ ws = WS,
+ text = Txt};
+options(Opt) ->
+ options([Opt]).
+
+opts(Options, [Key|Keys], L) ->
+ V = case lists:keyfind(Key, 1, Options) of
+ {reserved_word_fun,F} when ?RESWORDFUN(F) ->
+ {ok,F};
+ {Key,_} ->
+ badarg;
+ false ->
+ {ok,default_option(Key)}
+ end,
+ case V of
+ badarg ->
+ badarg;
+ {ok,Value} ->
+ opts(Options, Keys, [Value|L])
+ end;
+opts(_Options, [], L) ->
+ lists:reverse(L).
+
+default_option(reserved_word_fun) ->
+ fun reserved_word/1.
+
+expand_opt(return, Os) ->
+ [return_comments,return_white_spaces|Os];
+expand_opt(O, Os) ->
+ [O|Os].
+
+attr_info(Attrs, Item) ->
+ try lists:keyfind(Item, 1, Attrs) of
+ {_Item, _Value} = T ->
+ T;
+ false ->
+ undefined
+ catch
+ _:_ ->
+ erlang:error(badarg, [Attrs, Item])
+ end.
+
+-spec set_attr('line', attributes(), fun((line()) -> line())) -> attributes().
+
+set_attr(line, Line, Fun) when ?ALINE(Line) ->
+ Ln = Fun(Line),
+ if
+ ?ALINE(Ln) ->
+ Ln;
+ true ->
+ [{line,Ln}]
+ end;
+set_attr(line, {Line,Column}, Fun) when ?ALINE(Line), ?COLUMN(Column) ->
+ Ln = Fun(Line),
+ if
+ ?ALINE(Ln) ->
+ {Ln,Column};
+ true ->
+ [{line,Ln},{column,Column}]
+ end;
+set_attr(line=Tag, Attrs, Fun) when is_list(Attrs) ->
+ {line,Line} = lists:keyfind(Tag, 1, Attrs),
+ case lists:keyreplace(Tag, 1, Attrs, {line,Fun(Line)}) of
+ [{line,Ln}] when ?ALINE(Ln) ->
+ Ln;
+ As ->
+ As
+ end;
+set_attr(T1, T2, T3) ->
+ erlang:error(badarg, [T1,T2,T3]).
+
+tokens1(Cs, St, Line, Col, Toks, Fun, Any) when ?STRING(Cs); Cs =:= eof ->
+ case Fun(Cs, St, Line, Col, Toks, Any) of
+ {more,{Cs0,Ncol,Ntoks,Nline,Nany,Nfun}} ->
+ {more,{erl_scan_continuation,Cs0,Ncol,Ntoks,Nline,St,Nany,Nfun}};
+ {ok,Toks0,eof,Nline,Ncol} ->
+ Res = case Toks0 of
+ [] ->
+ {eof,location(Nline, Ncol)};
+ _ ->
+ {ok,lists:reverse(Toks0),location(Nline,Ncol)}
+ end,
+ {done,Res,eof};
+ {ok,Toks0,Rest,Nline,Ncol} ->
+ {done,{ok,lists:reverse(Toks0),location(Nline, Ncol)},Rest};
+ {{error,_,_}=Error,Rest} ->
+ {done,Error,Rest}
+ end.
+
+string1(Cs, St, Line, Col, Toks) ->
+ case scan1(Cs, St, Line, Col, Toks) of
+ {more,{Cs0,Ncol,Ntoks,Nline,Any,Fun}} ->
+ case Fun(Cs0++eof, St, Nline, Ncol, Ntoks, Any) of
+ {ok,Toks1,_Rest,Line2,Col2} ->
+ {ok,lists:reverse(Toks1),location(Line2, Col2)};
+ {{error,_,_}=Error,_Rest} ->
+ Error
+ end;
+ {ok,Ntoks,[_|_]=Rest,Nline,Ncol} ->
+ string1(Rest, St, Nline, Ncol, Ntoks);
+ {ok,Ntoks,_,Nline,Ncol} ->
+ {ok,lists:reverse(Ntoks),location(Nline, Ncol)};
+ {{error,_,_}=Error,_Rest} ->
+ Error
+ end.
+
+scan(Cs, St, Line, Col, Toks, _) ->
+ scan1(Cs, St, Line, Col, Toks).
+
+scan1([$\s|Cs], St, Line, Col, Toks) when St#erl_scan.ws ->
+ scan_spcs(Cs, St, Line, Col, Toks, 1);
+scan1([$\s|Cs], St, Line, Col, Toks) ->
+ skip_white_space(Cs, St, Line, Col, Toks, 1);
+scan1([$\n|Cs], St, Line, Col, Toks) when St#erl_scan.ws ->
+ scan_newline(Cs, St, Line, Col, Toks);
+scan1([$\n|Cs], St, Line, Col, Toks) ->
+ skip_white_space(Cs, St, Line+1, new_column(Col, 1), Toks, 0);
+scan1([C|Cs], St, Line, Col, Toks) when C >= $A, C =< $Z ->
+ scan_variable(Cs, St, Line, Col, Toks, [C]);
+scan1([C|Cs], St, Line, Col, Toks) when C >= $a, C =< $z ->
+ scan_atom(Cs, St, Line, Col, Toks, [C]);
+%% Optimization: some very common punctuation characters:
+scan1([$,|Cs], St, Line, Col, Toks) ->
+ tok2(Cs, St, Line, Col, Toks, ",", ',', 1);
+scan1([$(|Cs], St, Line, Col, Toks) ->
+ tok2(Cs, St, Line, Col, Toks, "(", '(', 1);
+scan1([$)|Cs], St, Line, Col, Toks) ->
+ tok2(Cs, St, Line, Col, Toks, ")", ')', 1);
+scan1([${|Cs], St, Line, Col, Toks) ->
+ tok2(Cs, St, Line, Col, Toks, "{", '{', 1);
+scan1([$}|Cs], St, Line, Col, Toks) ->
+ tok2(Cs, St, Line, Col, Toks, "}", '}', 1);
+scan1([$[|Cs], St, Line, Col, Toks) ->
+ tok2(Cs, St, Line, Col, Toks, "[", '[', 1);
+scan1([$]|Cs], St, Line, Col, Toks) ->
+ tok2(Cs, St, Line, Col, Toks, "]", ']', 1);
+scan1([$;|Cs], St, Line, Col, Toks) ->
+ tok2(Cs, St, Line, Col, Toks, ";", ';', 1);
+scan1([$_=C|Cs], St, Line, Col, Toks) ->
+ scan_variable(Cs, St, Line, Col, Toks, [C]);
+%% More punctuation characters below.
+scan1([$\%|Cs], St, Line, Col, Toks) when not St#erl_scan.comment ->
+ skip_comment(Cs, St, Line, Col, Toks, 1);
+scan1([$\%=C|Cs], St, Line, Col, Toks) ->
+ scan_comment(Cs, St, Line, Col, Toks, [C]);
+scan1([C|Cs], St, Line, Col, Toks) when ?DIGIT(C) ->
+ scan_number(Cs, St, Line, Col, Toks, [C]);
+scan1("..."++Cs, St, Line, Col, Toks) ->
+ tok2(Cs, St, Line, Col, Toks, "...", '...', 3);
+scan1(".."=Cs, _St, Line, Col, Toks) ->
+ {more,{Cs,Col,Toks,Line,[],fun scan/6}};
+scan1(".."++Cs, St, Line, Col, Toks) ->
+ tok2(Cs, St, Line, Col, Toks, "..", '..', 2);
+scan1("."=Cs, _St, Line, Col, Toks) ->
+ {more,{Cs,Col,Toks,Line,[],fun scan/6}};
+scan1([$.=C|Cs], St, Line, Col, Toks) ->
+ scan_dot(Cs, St, Line, Col, Toks, [C]);
+scan1([$"|Cs], St, Line, Col, Toks) -> %" Emacs
+ State0 = {[],[],Line,Col},
+ scan_string(Cs, St, Line, incr_column(Col, 1), Toks, State0);
+scan1([$'|Cs], St, Line, Col, Toks) -> %' Emacs
+ State0 = {[],[],Line,Col},
+ scan_qatom(Cs, St, Line, incr_column(Col, 1), Toks, State0);
+scan1([$$|Cs], St, Line, Col, Toks) ->
+ scan_char(Cs, St, Line, Col, Toks);
+scan1([$\r|Cs], St, Line, Col, Toks) when St#erl_scan.ws ->
+ white_space_end(Cs, St, Line, Col, Toks, 1, "\r");
+scan1([C|Cs], St, Line, Col, Toks) when C >= $ß, C =< $ÿ, C =/= $÷ ->
+ scan_atom(Cs, St, Line, Col, Toks, [C]);
+scan1([C|Cs], St, Line, Col, Toks) when C >= $À, C =< $Þ, C /= $× ->
+ scan_variable(Cs, St, Line, Col, Toks, [C]);
+scan1([$\t|Cs], St, Line, Col, Toks) when St#erl_scan.ws ->
+ scan_tabs(Cs, St, Line, Col, Toks, 1);
+scan1([$\t|Cs], St, Line, Col, Toks) ->
+ skip_white_space(Cs, St, Line, Col, Toks, 1);
+scan1([C|Cs], St, Line, Col, Toks) when ?WHITE_SPACE(C) ->
+ case St#erl_scan.ws of
+ true ->
+ scan_white_space(Cs, St, Line, Col, Toks, [C]);
+ false ->
+ skip_white_space(Cs, St, Line, Col, Toks, 1)
+ end;
+%% Punctuation characters and operators, first recognise multiples.
+%% << <- <=
+scan1("<<"++Cs, St, Line, Col, Toks) ->
+ tok2(Cs, St, Line, Col, Toks, "<<", '<<', 2);
+scan1("<-"++Cs, St, Line, Col, Toks) ->
+ tok2(Cs, St, Line, Col, Toks, "<-", '<-', 2);
+scan1("<="++Cs, St, Line, Col, Toks) ->
+ tok2(Cs, St, Line, Col, Toks, "<=", '<=', 2);
+scan1("<"=Cs, _St, Line, Col, Toks) ->
+ {more,{Cs,Col,Toks,Line,[],fun scan/6}};
+%% >> >=
+scan1(">>"++Cs, St, Line, Col, Toks) ->
+ tok2(Cs, St, Line, Col, Toks, ">>", '>>', 2);
+scan1(">="++Cs, St, Line, Col, Toks) ->
+ tok2(Cs, St, Line, Col, Toks, ">=", '>=', 2);
+scan1(">"=Cs, _St, Line, Col, Toks) ->
+ {more,{Cs,Col,Toks,Line,[],fun scan/6}};
+%% -> --
+scan1("->"++Cs, St, Line, Col, Toks) ->
+ tok2(Cs, St, Line, Col, Toks, "->", '->', 2);
+scan1("--"++Cs, St, Line, Col, Toks) ->
+ tok2(Cs, St, Line, Col, Toks, "--", '--', 2);
+scan1("-"=Cs, _St, Line, Col, Toks) ->
+ {more,{Cs,Col,Toks,Line,[],fun scan/6}};
+%% ++
+scan1("++"++Cs, St, Line, Col, Toks) ->
+ tok2(Cs, St, Line, Col, Toks, "++", '++', 2);
+scan1("+"=Cs, _St, Line, Col, Toks) ->
+ {more,{Cs,Col,Toks,Line,[],fun scan/6}};
+%% =:= =/= =< ==
+scan1("=:="++Cs, St, Line, Col, Toks) ->
+ tok2(Cs, St, Line, Col, Toks, "=:=", '=:=', 3);
+scan1("=:"=Cs, _St, Line, Col, Toks) ->
+ {more,{Cs,Col,Toks,Line,[],fun scan/6}};
+scan1("=/="++Cs, St, Line, Col, Toks) ->
+ tok2(Cs, St, Line, Col, Toks, "=/=", '=/=', 3);
+scan1("=/"=Cs, _St, Line, Col, Toks) ->
+ {more,{Cs,Col,Toks,Line,[],fun scan/6}};
+scan1("=<"++Cs, St, Line, Col, Toks) ->
+ tok2(Cs, St, Line, Col, Toks, "=<", '=<', 2);
+scan1("=="++Cs, St, Line, Col, Toks) ->
+ tok2(Cs, St, Line, Col, Toks, "==", '==', 2);
+scan1("="=Cs, _St, Line, Col, Toks) ->
+ {more,{Cs,Col,Toks,Line,[],fun scan/6}};
+%% /=
+scan1("/="++Cs, St, Line, Col, Toks) ->
+ tok2(Cs, St, Line, Col, Toks, "/=", '/=', 2);
+scan1("/"=Cs, _St, Line, Col, Toks) ->
+ {more,{Cs,Col,Toks,Line,[],fun scan/6}};
+%% ||
+scan1("||"++Cs, St, Line, Col, Toks) ->
+ tok2(Cs, St, Line, Col, Toks, "||", '||', 2);
+scan1("|"=Cs, _St, Line, Col, Toks) ->
+ {more,{Cs,Col,Toks,Line,[],fun scan/6}};
+%% :-
+scan1(":-"++Cs, St, Line, Col, Toks) ->
+ tok2(Cs, St, Line, Col, Toks, ":-", ':-', 2);
+%% :: for typed records
+scan1("::"++Cs, St, Line, Col, Toks) ->
+ tok2(Cs, St, Line, Col, Toks, "::", '::', 2);
+scan1(":"=Cs, _St, Line, Col, Toks) ->
+ {more,{Cs,Col,Toks,Line,[],fun scan/6}};
+%% Optimization: punctuation characters less than 127:
+scan1([$=|Cs], St, Line, Col, Toks) ->
+ tok2(Cs, St, Line, Col, Toks, "=", '=', 1);
+scan1([$:|Cs], St, Line, Col, Toks) ->
+ tok2(Cs, St, Line, Col, Toks, ":", ':', 1);
+scan1([$||Cs], St, Line, Col, Toks) ->
+ tok2(Cs, St, Line, Col, Toks, "|", '|', 1);
+scan1([$#|Cs], St, Line, Col, Toks) ->
+ tok2(Cs, St, Line, Col, Toks, "#", '#', 1);
+scan1([$/|Cs], St, Line, Col, Toks) ->
+ tok2(Cs, St, Line, Col, Toks, "/", '/', 1);
+scan1([$?|Cs], St, Line, Col, Toks) ->
+ tok2(Cs, St, Line, Col, Toks, "?", '?', 1);
+scan1([$-|Cs], St, Line, Col, Toks) ->
+ tok2(Cs, St, Line, Col, Toks, "-", '-', 1);
+scan1([$+|Cs], St, Line, Col, Toks) ->
+ tok2(Cs, St, Line, Col, Toks, "+", '+', 1);
+scan1([$*|Cs], St, Line, Col, Toks) ->
+ tok2(Cs, St, Line, Col, Toks, "*", '*', 1);
+scan1([$<|Cs], St, Line, Col, Toks) ->
+ tok2(Cs, St, Line, Col, Toks, "<", '<', 1);
+scan1([$>|Cs], St, Line, Col, Toks) ->
+ tok2(Cs, St, Line, Col, Toks, ">", '>', 1);
+scan1([$!|Cs], St, Line, Col, Toks) ->
+ tok2(Cs, St, Line, Col, Toks, "!", '!', 1);
+scan1([$@|Cs], St, Line, Col, Toks) ->
+ tok2(Cs, St, Line, Col, Toks, "@", '@', 1);
+scan1([$\\|Cs], St, Line, Col, Toks) ->
+ tok2(Cs, St, Line, Col, Toks, "\\", '\\', 1);
+scan1([$^|Cs], St, Line, Col, Toks) ->
+ tok2(Cs, St, Line, Col, Toks, "^", '^', 1);
+scan1([$`|Cs], St, Line, Col, Toks) ->
+ tok2(Cs, St, Line, Col, Toks, "`", '`', 1);
+scan1([$~|Cs], St, Line, Col, Toks) ->
+ tok2(Cs, St, Line, Col, Toks, "~", '~', 1);
+scan1([$&|Cs], St, Line, Col, Toks) ->
+ tok2(Cs, St, Line, Col, Toks, "&", '&', 1);
+%% End of optimization.
+scan1([C|Cs], St, Line, Col, Toks) when ?UNI255(C) ->
+ Str = [C],
+ tok2(Cs, St, Line, Col, Toks, Str, list_to_atom(Str), 1);
+scan1([C|Cs], _St, Line, Col, _Toks) when ?CHAR(C) ->
+ Ncol = incr_column(Col, 1),
+ scan_error({illegal,character}, Line, Col, Line, Ncol, Cs);
+scan1([]=Cs, _St, Line, Col, Toks) ->
+ {more,{Cs,Col,Toks,Line,[],fun scan/6}};
+scan1(eof=Cs, _St, Line, Col, Toks) ->
+ {ok,Toks,Cs,Line,Col}.
+
+scan_atom(Cs0, St, Line, Col, Toks, Ncs0) ->
+ case scan_name(Cs0, Ncs0) of
+ {more,Ncs} ->
+ {more,{[],Col,Toks,Line,Ncs,fun scan_atom/6}};
+ {Wcs,Cs} ->
+ case catch list_to_atom(Wcs) of
+ Name when is_atom(Name) ->
+ case (St#erl_scan.resword_fun)(Name) of
+ true ->
+ tok2(Cs, St, Line, Col, Toks, Wcs, Name);
+ false ->
+ tok3(Cs, St, Line, Col, Toks, atom, Wcs, Name)
+ end;
+ _Error ->
+ Ncol = incr_column(Col, length(Wcs)),
+ scan_error({illegal,atom}, Line, Col, Line, Ncol, Cs)
+ end
+ end.
+
+scan_variable(Cs0, St, Line, Col, Toks, Ncs0) ->
+ case scan_name(Cs0, Ncs0) of
+ {more,Ncs} ->
+ {more,{[],Col,Toks,Line,Ncs,fun scan_variable/6}};
+ {Wcs,Cs} ->
+ case catch list_to_atom(Wcs) of
+ Name when is_atom(Name) ->
+ tok3(Cs, St, Line, Col, Toks, var, Wcs, Name);
+ _Error ->
+ Ncol = incr_column(Col, length(Wcs)),
+ scan_error({illegal,var}, Line, Col, Line, Ncol, Cs)
+ end
+ end.
+
+scan_name([C|Cs], Ncs) when C >= $a, C =< $z ->
+ scan_name(Cs, [C|Ncs]);
+scan_name([C|Cs], Ncs) when C >= $A, C =< $Z ->
+ scan_name(Cs, [C|Ncs]);
+scan_name([$_=C|Cs], Ncs) ->
+ scan_name(Cs, [C|Ncs]);
+scan_name([C|Cs], Ncs) when ?DIGIT(C) ->
+ scan_name(Cs, [C|Ncs]);
+scan_name([$@=C|Cs], Ncs) ->
+ scan_name(Cs, [C|Ncs]);
+scan_name([C|Cs], Ncs) when C >= $ß, C =< $ÿ, C =/= $÷ ->
+ scan_name(Cs, [C|Ncs]);
+scan_name([C|Cs], Ncs) when C >= $À, C =< $Þ, C =/= $× ->
+ scan_name(Cs, [C|Ncs]);
+scan_name([], Ncs) ->
+ {more,Ncs};
+scan_name(Cs, Ncs) ->
+ {lists:reverse(Ncs),Cs}.
+
+-define(STR(St, S), if St#erl_scan.text -> S; true -> [] end).
+
+scan_dot([$%|_]=Cs, St, Line, Col, Toks, Ncs) ->
+ Attrs = attributes(Line, Col, St, Ncs),
+ {ok,[{dot,Attrs}|Toks],Cs,Line,incr_column(Col, 1)};
+scan_dot([$\n=C|Cs], St, Line, Col, Toks, Ncs) ->
+ Attrs = attributes(Line, Col, St, ?STR(St, Ncs++[C])),
+ {ok,[{dot,Attrs}|Toks],Cs,Line+1,new_column(Col, 1)};
+scan_dot([C|Cs], St, Line, Col, Toks, Ncs) when ?WHITE_SPACE(C) ->
+ Attrs = attributes(Line, Col, St, ?STR(St, Ncs++[C])),
+ {ok,[{dot,Attrs}|Toks],Cs,Line,incr_column(Col, 2)};
+scan_dot(eof=Cs, St, Line, Col, Toks, Ncs) ->
+ Attrs = attributes(Line, Col, St, Ncs),
+ {ok,[{dot,Attrs}|Toks],Cs,Line,incr_column(Col, 1)};
+scan_dot(Cs, St, Line, Col, Toks, Ncs) ->
+ tok2(Cs, St, Line, Col, Toks, Ncs, '.', 1).
+
+%%% White space characters are very common, so it is worthwhile to
+%%% scan them fast and store them compactly. (The words "whitespace"
+%%% and "white space" usually mean the same thing. The Erlang
+%%% specification denotes the characters with ASCII code in the
+%%% interval 0 to 32 as "white space".)
+%%%
+%%% Convention: if there is a white newline ($\n) it will always be
+%%% the first character in the text string. As a consequence, there
+%%% cannot be more than one newline in a white_space token string.
+%%%
+%%% Some common combinations are recognized, some are not. Examples
+%%% of the latter are tab(s) followed by space(s), like "\t ".
+%%% (They will be represented by two (or more) tokens.)
+%%%
+%%% Note: the character sequence "\r\n" is *not* recognized since it
+%%% would violate the property that $\n will always be the first
+%%% character. (But since "\r\n\r\n" is common, it pays off to
+%%% recognize "\n\r".)
+
+scan_newline([$\s|Cs], St, Line, Col, Toks) ->
+ scan_nl_spcs(Cs, St, Line, Col, Toks, 2);
+scan_newline([$\t|Cs], St, Line, Col, Toks) ->
+ scan_nl_tabs(Cs, St, Line, Col, Toks, 2);
+scan_newline([$\r|Cs], St, Line, Col, Toks) ->
+ newline_end(Cs, St, Line, Col, Toks, 2, "\n\r");
+scan_newline([$\f|Cs], St, Line, Col, Toks) ->
+ newline_end(Cs, St, Line, Col, Toks, 2, "\n\f");
+scan_newline([], _St, Line, Col, Toks) ->
+ {more,{[$\n],Col,Toks,Line,[],fun scan/6}};
+scan_newline(Cs, St, Line, Col, Toks) ->
+ scan_nl_white_space(Cs, St, Line, Col, Toks, "\n").
+
+scan_nl_spcs([$\s|Cs], St, Line, Col, Toks, N) when N < 17 ->
+ scan_nl_spcs(Cs, St, Line, Col, Toks, N+1);
+scan_nl_spcs([]=Cs, _St, Line, Col, Toks, N) ->
+ {more,{Cs,Col,Toks,Line,N,fun scan_nl_spcs/6}};
+scan_nl_spcs(Cs, St, Line, Col, Toks, N) ->
+ newline_end(Cs, St, Line, Col, Toks, N, nl_spcs(N)).
+
+scan_nl_tabs([$\t|Cs], St, Line, Col, Toks, N) when N < 11 ->
+ scan_nl_tabs(Cs, St, Line, Col, Toks, N+1);
+scan_nl_tabs([]=Cs, _St, Line, Col, Toks, N) ->
+ {more,{Cs,Col,Toks,Line,N,fun scan_nl_tabs/6}};
+scan_nl_tabs(Cs, St, Line, Col, Toks, N) ->
+ newline_end(Cs, St, Line, Col, Toks, N, nl_tabs(N)).
+
+%% Note: returning {more,Cont} is meaningless here; one could just as
+%% well return several tokens. But since tokens() scans up to a full
+%% stop anyway, nothing is gained by not collecting all white spaces.
+scan_nl_white_space([$\n|Cs], #erl_scan{text = false}=St, Line, no_col=Col,
+ Toks0, Ncs) ->
+ Toks = [{white_space,Line,lists:reverse(Ncs)}|Toks0],
+ scan_newline(Cs, St, Line+1, Col, Toks);
+scan_nl_white_space([$\n|Cs], St, Line, Col, Toks, Ncs0) ->
+ Ncs = lists:reverse(Ncs0),
+ Attrs = attributes(Line, Col, St, Ncs),
+ Token = {white_space,Attrs,Ncs},
+ scan_newline(Cs, St, Line+1, new_column(Col, length(Ncs)), [Token|Toks]);
+scan_nl_white_space([C|Cs], St, Line, Col, Toks, Ncs) when ?WHITE_SPACE(C) ->
+ scan_nl_white_space(Cs, St, Line, Col, Toks, [C|Ncs]);
+scan_nl_white_space([]=Cs, _St, Line, Col, Toks, Ncs) ->
+ {more,{Cs,Col,Toks,Line,Ncs,fun scan_nl_white_space/6}};
+scan_nl_white_space(Cs, #erl_scan{text = false}=St, Line, no_col=Col,
+ Toks, Ncs) ->
+ scan1(Cs, St, Line+1, Col, [{white_space,Line,lists:reverse(Ncs)}|Toks]);
+scan_nl_white_space(Cs, St, Line, Col, Toks, Ncs0) ->
+ Ncs = lists:reverse(Ncs0),
+ Attrs = attributes(Line, Col, St, Ncs),
+ Token = {white_space,Attrs,Ncs},
+ scan1(Cs, St, Line+1, new_column(Col, length(Ncs)), [Token|Toks]).
+
+newline_end(Cs, #erl_scan{text = false}=St, Line, no_col=Col,
+ Toks, _N, Ncs) ->
+ scan1(Cs, St, Line+1, Col, [{white_space,Line,Ncs}|Toks]);
+newline_end(Cs, St, Line, Col, Toks, N, Ncs) ->
+ Attrs = attributes(Line, Col, St, Ncs),
+ scan1(Cs, St, Line+1, new_column(Col, N), [{white_space,Attrs,Ncs}|Toks]).
+
+scan_spcs([$\s|Cs], St, Line, Col, Toks, N) when N < 16 ->
+ scan_spcs(Cs, St, Line, Col, Toks, N+1);
+scan_spcs([]=Cs, _St, Line, Col, Toks, N) ->
+ {more,{Cs,Col,Toks,Line,N,fun scan_spcs/6}};
+scan_spcs(Cs, St, Line, Col, Toks, N) ->
+ white_space_end(Cs, St, Line, Col, Toks, N, spcs(N)).
+
+scan_tabs([$\t|Cs], St, Line, Col, Toks, N) when N < 10 ->
+ scan_tabs(Cs, St, Line, Col, Toks, N+1);
+scan_tabs([]=Cs, _St, Line, Col, Toks, N) ->
+ {more,{Cs,Col,Toks,Line,N,fun scan_tabs/6}};
+scan_tabs(Cs, St, Line, Col, Toks, N) ->
+ white_space_end(Cs, St, Line, Col, Toks, N, tabs(N)).
+
+skip_white_space([$\n|Cs], St, Line, Col, Toks, _N) ->
+ skip_white_space(Cs, St, Line+1, new_column(Col, 1), Toks, 0);
+skip_white_space([C|Cs], St, Line, Col, Toks, N) when ?WHITE_SPACE(C) ->
+ skip_white_space(Cs, St, Line, Col, Toks, N+1);
+skip_white_space([]=Cs, _St, Line, Col, Toks, N) ->
+ {more,{Cs,Col,Toks,Line,N,fun skip_white_space/6}};
+skip_white_space(Cs, St, Line, Col, Toks, N) ->
+ scan1(Cs, St, Line, incr_column(Col, N), Toks).
+
+%% Maybe \t and \s should break the loop.
+scan_white_space([$\n|_]=Cs, St, Line, Col, Toks, Ncs) ->
+ white_space_end(Cs, St, Line, Col, Toks, length(Ncs), lists:reverse(Ncs));
+scan_white_space([C|Cs], St, Line, Col, Toks, Ncs) when ?WHITE_SPACE(C) ->
+ scan_white_space(Cs, St, Line, Col, Toks, [C|Ncs]);
+scan_white_space([]=Cs, _St, Line, Col, Toks, Ncs) ->
+ {more,{Cs,Col,Toks,Line,Ncs,fun scan_white_space/6}};
+scan_white_space(Cs, St, Line, Col, Toks, Ncs) ->
+ white_space_end(Cs, St, Line, Col, Toks, length(Ncs), lists:reverse(Ncs)).
+
+-compile({inline,[white_space_end/7]}).
+
+white_space_end(Cs, St, Line, Col, Toks, N, Ncs) ->
+ tok3(Cs, St, Line, Col, Toks, white_space, Ncs, Ncs, N).
+
+scan_char([$\\|Cs]=Cs0, St, Line, Col, Toks) ->
+ case scan_escape(Cs, incr_column(Col, 2)) of
+ more ->
+ {more,{[$$|Cs0],Col,Toks,Line,[],fun scan/6}};
+ {error,Ncs,Error,Ncol} ->
+ scan_error(Error, Line, Col, Line, Ncol, Ncs);
+ {eof,Ncol} ->
+ scan_error(char, Line, Col, Line, Ncol, eof);
+ {nl,Val,Str,Ncs,Ncol} ->
+ Attrs = attributes(Line, Col, St, ?STR(St, "$\\"++Str)), %"
+ Ntoks = [{char,Attrs,Val}|Toks],
+ scan1(Ncs, St, Line+1, Ncol, Ntoks);
+ {Val,Str,Ncs,Ncol} ->
+ Attrs = attributes(Line, Col, St, ?STR(St, "$\\"++Str)), %"
+ Ntoks = [{char,Attrs,Val}|Toks],
+ scan1(Ncs, St, Line, Ncol, Ntoks)
+ end;
+scan_char([$\n=C|Cs], St, Line, Col, Toks) ->
+ Attrs = attributes(Line, Col, St, ?STR(St, [$$,C])),
+ scan1(Cs, St, Line+1, new_column(Col, 1), [{char,Attrs,C}|Toks]);
+scan_char([C|Cs], St, Line, Col, Toks) when ?UNICODE(C) ->
+ Attrs = attributes(Line, Col, St, ?STR(St, [$$,C])),
+ scan1(Cs, St, Line, incr_column(Col, 2), [{char,Attrs,C}|Toks]);
+scan_char([C|_Cs], _St, Line, Col, _Toks) when ?CHAR(C) ->
+ scan_error({illegal,character}, Line, Col, Line, incr_column(Col, 1), eof);
+scan_char([], _St, Line, Col, Toks) ->
+ {more,{[$$],Col,Toks,Line,[],fun scan/6}};
+scan_char(eof, _St, Line, Col, _Toks) ->
+ scan_error(char, Line, Col, Line, incr_column(Col, 1), eof).
+
+scan_string(Cs, St, Line, Col, Toks, {Wcs,Str,Line0,Col0}) ->
+ case scan_string0(Cs, St, Line, Col, $\", Str, Wcs) of %"
+ {more,Ncs,Nline,Ncol,Nstr,Nwcs} ->
+ State = {Nwcs,Nstr,Line0,Col0},
+ {more,{Ncs,Ncol,Toks,Nline,State,fun scan_string/6}};
+ {char_error,Ncs,Error,Nline,Ncol,EndCol} ->
+ scan_error(Error, Nline, Ncol, Nline, EndCol, Ncs);
+ {error,Nline,Ncol,Nwcs,Ncs} ->
+ Estr = string:substr(Nwcs, 1, 16), % Expanded escape chars.
+ scan_error({string,$\",Estr}, Line0, Col0, Nline, Ncol, Ncs); %"
+ {Ncs,Nline,Ncol,Nstr,Nwcs} ->
+ Attrs = attributes(Line0, Col0, St, Nstr),
+ scan1(Ncs, St, Nline, Ncol, [{string,Attrs,Nwcs}|Toks])
+ end.
+
+scan_qatom(Cs, St, Line, Col, Toks, {Wcs,Str,Line0,Col0}) ->
+ case scan_string0(Cs, St, Line, Col, $\', Str, Wcs) of %'
+ {more,Ncs,Nline,Ncol,Nstr,Nwcs} ->
+ State = {Nwcs,Nstr,Line0,Col0},
+ {more,{Ncs,Ncol,Toks,Nline,State,fun scan_qatom/6}};
+ {char_error,Ncs,Error,Nline,Ncol,EndCol} ->
+ scan_error(Error, Nline, Ncol, Nline, EndCol, Ncs);
+ {error,Nline,Ncol,Nwcs,Ncs} ->
+ Estr = string:substr(Nwcs, 1, 16), % Expanded escape chars.
+ scan_error({string,$\',Estr}, Line0, Col0, Nline, Ncol, Ncs); %'
+ {Ncs,Nline,Ncol,Nstr,Nwcs} ->
+ case catch list_to_atom(Nwcs) of
+ A when is_atom(A) ->
+ Attrs = attributes(Line0, Col0, St, Nstr),
+ scan1(Ncs, St, Nline, Ncol, [{atom,Attrs,A}|Toks]);
+ _ ->
+ scan_error({illegal,atom}, Line0, Col0, Nline, Ncol, Ncs)
+ end
+ end.
+
+scan_string0(Cs, #erl_scan{text=false}, Line, no_col=Col, Q, [], Wcs) ->
+ scan_string_no_col(Cs, Line, Col, Q, Wcs);
+scan_string0(Cs, #erl_scan{text=true}, Line, no_col=Col, Q, Str, Wcs) ->
+ scan_string1(Cs, Line, Col, Q, Str, Wcs);
+scan_string0(Cs, St, Line, Col, Q, [], Wcs) ->
+ scan_string_col(Cs, St, Line, Col, Q, Wcs);
+scan_string0(Cs, _St, Line, Col, Q, Str, Wcs) ->
+ scan_string1(Cs, Line, Col, Q, Str, Wcs).
+
+%% Optimization. Col =:= no_col.
+scan_string_no_col([Q|Cs], Line, Col, Q, Wcs) ->
+ {Cs,Line,Col,_DontCare=[],lists:reverse(Wcs)};
+scan_string_no_col([$\n=C|Cs], Line, Col, Q, Wcs) ->
+ scan_string_no_col(Cs, Line+1, Col, Q, [C|Wcs]);
+scan_string_no_col([C|Cs], Line, Col, Q, Wcs) when C =/= $\\, ?UNICODE(C) ->
+ scan_string_no_col(Cs, Line, Col, Q, [C|Wcs]);
+scan_string_no_col(Cs, Line, Col, Q, Wcs) ->
+ scan_string1(Cs, Line, Col, Q, Wcs, Wcs).
+
+%% Optimization. Col =/= no_col.
+scan_string_col([Q|Cs], St, Line, Col, Q, Wcs0) ->
+ Wcs = lists:reverse(Wcs0),
+ Str = ?STR(St, [Q|Wcs++[Q]]),
+ {Cs,Line,Col+1,Str,Wcs};
+scan_string_col([$\n=C|Cs], St, Line, _xCol, Q, Wcs) ->
+ scan_string_col(Cs, St, Line+1, 1, Q, [C|Wcs]);
+scan_string_col([C|Cs], St, Line, Col, Q, Wcs) when C =/= $\\, ?UNICODE(C) ->
+ scan_string_col(Cs, St, Line, Col+1, Q, [C|Wcs]);
+scan_string_col(Cs, _St, Line, Col, Q, Wcs) ->
+ scan_string1(Cs, Line, Col, Q, Wcs, Wcs).
+
+%% Note: in those cases when a 'char_error' tuple is returned below it
+%% is tempting to skip over characters up to the first Q character,
+%% but then the end location of the error tuple would not correspond
+%% to the start location of the returned Rest string. (Maybe the end
+%% location could be modified, but that too is ugly.)
+scan_string1([Q|Cs], Line, Col, Q, Str0, Wcs0) ->
+ Wcs = lists:reverse(Wcs0),
+ Str = [Q|lists:reverse(Str0, [Q])],
+ {Cs,Line,incr_column(Col, 1),Str,Wcs};
+scan_string1([$\n=C|Cs], Line, Col, Q, Str, Wcs) ->
+ Ncol = new_column(Col, 1),
+ scan_string1(Cs, Line+1, Ncol, Q, [C|Str], [C|Wcs]);
+scan_string1([$\\|Cs]=Cs0, Line, Col, Q, Str, Wcs) ->
+ case scan_escape(Cs, Col) of
+ more ->
+ {more,Cs0,Line,Col,Str,Wcs};
+ {error,Ncs,Error,Ncol} ->
+ {char_error,Ncs,Error,Line,Col,incr_column(Ncol, 1)};
+ {eof,Ncol} ->
+ {error,Line,incr_column(Ncol, 1),lists:reverse(Wcs),eof};
+ {nl,Val,ValStr,Ncs,Ncol} ->
+ Nstr = lists:reverse(ValStr, [$\\|Str]),
+ Nwcs = [Val|Wcs],
+ scan_string1(Ncs, Line+1, Ncol, Q, Nstr, Nwcs);
+ {Val,ValStr,Ncs,Ncol} ->
+ Nstr = lists:reverse(ValStr, [$\\|Str]),
+ Nwcs = [Val|Wcs],
+ scan_string1(Ncs, Line, incr_column(Ncol, 1), Q, Nstr, Nwcs)
+ end;
+scan_string1([C|Cs], Line, no_col=Col, Q, Str, Wcs) when ?UNICODE(C) ->
+ scan_string1(Cs, Line, Col, Q, [C|Str], [C|Wcs]);
+scan_string1([C|Cs], Line, Col, Q, Str, Wcs) when ?UNICODE(C) ->
+ scan_string1(Cs, Line, Col+1, Q, [C|Str], [C|Wcs]);
+scan_string1([C|Cs], Line, Col, _Q, _Str, _Wcs) when ?CHAR(C) ->
+ {char_error,Cs,{illegal,character},Line,Col,incr_column(Col, 1)};
+scan_string1([]=Cs, Line, Col, _Q, Str, Wcs) ->
+ {more,Cs,Line,Col,Str,Wcs};
+scan_string1(eof, Line, Col, _Q, _Str, Wcs) ->
+ {error,Line,Col,lists:reverse(Wcs),eof}.
+
+-define(OCT(C), C >= $0, C =< $7).
+-define(HEX(C), C >= $0 andalso C =< $9 orelse
+ C >= $A andalso C =< $F orelse
+ C >= $a andalso C =< $f).
+
+%% \<1-3> octal digits
+scan_escape([O1,O2,O3|Cs], Col) when ?OCT(O1), ?OCT(O2), ?OCT(O3) ->
+ Val = (O1*8 + O2)*8 + O3 - 73*$0,
+ {Val,[O1,O2,O3],Cs,incr_column(Col, 3)};
+scan_escape([O1,O2], _Col) when ?OCT(O1), ?OCT(O2) ->
+ more;
+scan_escape([O1,O2|Cs], Col) when ?OCT(O1), ?OCT(O2) ->
+ Val = (O1*8 + O2) - 9*$0,
+ {Val,[O1,O2],Cs,incr_column(Col, 2)};
+scan_escape([O1], _Col) when ?OCT(O1) ->
+ more;
+scan_escape([O1|Cs], Col) when ?OCT(O1) ->
+ {O1 - $0,[O1],Cs,incr_column(Col, 1)};
+%% \x{<hex digits>}
+scan_escape([$x,${|Cs], Col) ->
+ scan_hex(Cs, incr_column(Col, 2), []);
+scan_escape([$x], _Col) ->
+ more;
+scan_escape([$x|eof], Col) ->
+ {eof,incr_column(Col, 1)};
+%% \x<2> hexadecimal digits
+scan_escape([$x,H1,H2|Cs], Col) when ?HEX(H1), ?HEX(H2) ->
+ Val = erlang:list_to_integer([H1,H2], 16),
+ {Val,[$x,H1,H2],Cs,incr_column(Col, 3)};
+scan_escape([$x,H1], _Col) when ?HEX(H1) ->
+ more;
+scan_escape([$x|Cs], Col) ->
+ {error,Cs,{illegal,character},incr_column(Col, 1)};
+%% \^X -> CTL-X
+scan_escape([$^=C0,$\n=C|Cs], Col) ->
+ {nl,C,[C0,C],Cs,new_column(Col, 1)};
+scan_escape([$^=C0,C|Cs], Col) when ?CHAR(C) ->
+ Val = C band 31,
+ {Val,[C0,C],Cs,incr_column(Col, 2)};
+scan_escape([$^], _Col) ->
+ more;
+scan_escape([$^|eof], Col) ->
+ {eof,incr_column(Col, 1)};
+scan_escape([$\n=C|Cs], Col) ->
+ {nl,C,[C],Cs,new_column(Col, 1)};
+scan_escape([C0|Cs], Col) when ?UNICODE(C0) ->
+ C = escape_char(C0),
+ {C,[C0],Cs,incr_column(Col, 1)};
+scan_escape([C|Cs], Col) when ?CHAR(C) ->
+ {error,Cs,{illegal,character},incr_column(Col, 1)};
+scan_escape([], _Col) ->
+ more;
+scan_escape(eof, Col) ->
+ {eof,Col}.
+
+scan_hex([C|Cs], no_col=Col, Wcs) when ?HEX(C) ->
+ scan_hex(Cs, Col, [C|Wcs]);
+scan_hex([C|Cs], Col, Wcs) when ?HEX(C) ->
+ scan_hex(Cs, Col+1, [C|Wcs]);
+scan_hex(Cs, Col, Wcs) ->
+ scan_esc_end(Cs, Col, Wcs, 16, "x{").
+
+scan_esc_end([$}|Cs], Col, Wcs0, B, Str0) ->
+ Wcs = lists:reverse(Wcs0),
+ case catch erlang:list_to_integer(Wcs, B) of
+ Val when ?UNICODE(Val) ->
+ {Val,Str0++Wcs++[$}],Cs,incr_column(Col, 1)};
+ _ ->
+ {error,Cs,{illegal,character},incr_column(Col, 1)}
+ end;
+scan_esc_end([], _Col, _Wcs, _B, _Str0) ->
+ more;
+scan_esc_end(eof, Col, _Wcs, _B, _Str0) ->
+ {eof,Col};
+scan_esc_end(Cs, Col, _Wcs, _B, _Str0) ->
+ {error,Cs,{illegal,character},Col}.
+
+escape_char($n) -> $\n; % \n = LF
+escape_char($r) -> $\r; % \r = CR
+escape_char($t) -> $\t; % \t = TAB
+escape_char($v) -> $\v; % \v = VT
+escape_char($b) -> $\b; % \b = BS
+escape_char($f) -> $\f; % \f = FF
+escape_char($e) -> $\e; % \e = ESC
+escape_char($s) -> $\s; % \s = SPC
+escape_char($d) -> $\d; % \d = DEL
+escape_char(C) -> C.
+
+scan_number([C|Cs], St, Line, Col, Toks, Ncs) when ?DIGIT(C) ->
+ scan_number(Cs, St, Line, Col, Toks, [C|Ncs]);
+scan_number([$.,C|Cs], St, Line, Col, Toks, Ncs) when ?DIGIT(C) ->
+ scan_fraction(Cs, St, Line, Col, Toks, [C,$.|Ncs]);
+scan_number([$.]=Cs, _St, Line, Col, Toks, Ncs) ->
+ {more,{Cs,Col,Toks,Line,Ncs,fun scan_number/6}};
+scan_number([$#|Cs]=Cs0, St, Line, Col, Toks, Ncs0) ->
+ Ncs = lists:reverse(Ncs0),
+ case catch list_to_integer(Ncs) of
+ B when B >= 2, B =< 1+$Z-$A+10 ->
+ Bcs = ?STR(St, Ncs++[$#]),
+ scan_based_int(Cs, St, Line, Col, Toks, {B,[],Bcs});
+ B ->
+ Len = length(Ncs),
+ scan_error({base,B}, Line, Col, Line, incr_column(Col, Len), Cs0)
+ end;
+scan_number([]=Cs, _St, Line, Col, Toks, Ncs) ->
+ {more,{Cs,Col,Toks,Line,Ncs,fun scan_number/6}};
+scan_number(Cs, St, Line, Col, Toks, Ncs0) ->
+ Ncs = lists:reverse(Ncs0),
+ case catch list_to_integer(Ncs) of
+ N when is_integer(N) ->
+ tok3(Cs, St, Line, Col, Toks, integer, Ncs, N);
+ _ ->
+ Ncol = incr_column(Col, length(Ncs)),
+ scan_error({illegal,integer}, Line, Col, Line, Ncol, Cs)
+ end.
+
+scan_based_int([C|Cs], St, Line, Col, Toks, {B,Ncs,Bcs})
+ when ?DIGIT(C), C < $0+B ->
+ scan_based_int(Cs, St, Line, Col, Toks, {B,[C|Ncs],Bcs});
+scan_based_int([C|Cs], St, Line, Col, Toks, {B,Ncs,Bcs})
+ when C >= $A, B > 10, C < $A+B-10 ->
+ scan_based_int(Cs, St, Line, Col, Toks, {B,[C|Ncs],Bcs});
+scan_based_int([C|Cs], St, Line, Col, Toks, {B,Ncs,Bcs})
+ when C >= $a, B > 10, C < $a+B-10 ->
+ scan_based_int(Cs, St, Line, Col, Toks, {B,[C|Ncs],Bcs});
+scan_based_int([]=Cs, _St, Line, Col, Toks, State) ->
+ {more,{Cs,Col,Toks,Line,State,fun scan_based_int/6}};
+scan_based_int(Cs, St, Line, Col, Toks, {B,Ncs0,Bcs}) ->
+ Ncs = lists:reverse(Ncs0),
+ case catch erlang:list_to_integer(Ncs, B) of
+ N when is_integer(N) ->
+ tok3(Cs, St, Line, Col, Toks, integer, ?STR(St, Bcs++Ncs), N);
+ _ ->
+ Len = length(Bcs)+length(Ncs),
+ Ncol = incr_column(Col, Len),
+ scan_error({illegal,integer}, Line, Col, Line, Ncol, Cs)
+ end.
+
+scan_fraction([C|Cs], St, Line, Col, Toks, Ncs) when ?DIGIT(C) ->
+ scan_fraction(Cs, St, Line, Col, Toks, [C|Ncs]);
+scan_fraction([E|Cs], St, Line, Col, Toks, Ncs) when E =:= $e; E =:= $E ->
+ scan_exponent_sign(Cs, St, Line, Col, Toks, [E|Ncs]);
+scan_fraction([]=Cs, _St, Line, Col, Toks, Ncs) ->
+ {more,{Cs,Col,Toks,Line,Ncs,fun scan_fraction/6}};
+scan_fraction(Cs, St, Line, Col, Toks, Ncs) ->
+ float_end(Cs, St, Line, Col, Toks, Ncs).
+
+scan_exponent_sign([C|Cs], St, Line, Col, Toks, Ncs) when C =:= $+; C =:= $- ->
+ scan_exponent(Cs, St, Line, Col, Toks, [C|Ncs]);
+scan_exponent_sign([]=Cs, _St, Line, Col, Toks, Ncs) ->
+ {more,{Cs,Col,Toks,Line,Ncs,fun scan_exponent_sign/6}};
+scan_exponent_sign(Cs, St, Line, Col, Toks, Ncs) ->
+ scan_exponent(Cs, St, Line, Col, Toks, Ncs).
+
+scan_exponent([C|Cs], St, Line, Col, Toks, Ncs) when ?DIGIT(C) ->
+ scan_exponent(Cs, St, Line, Col, Toks, [C|Ncs]);
+scan_exponent([]=Cs, _St, Line, Col, Toks, Ncs) ->
+ {more,{Cs,Col,Toks,Line,Ncs,fun scan_exponent/6}};
+scan_exponent(Cs, St, Line, Col, Toks, Ncs) ->
+ float_end(Cs, St, Line, Col, Toks, Ncs).
+
+float_end(Cs, St, Line, Col, Toks, Ncs0) ->
+ Ncs = lists:reverse(Ncs0),
+ case catch list_to_float(Ncs) of
+ F when is_float(F) ->
+ tok3(Cs, St, Line, Col, Toks, float, Ncs, F);
+ _ ->
+ Ncol = incr_column(Col, length(Ncs)),
+ scan_error({illegal,float}, Line, Col, Line, Ncol, Cs)
+ end.
+
+skip_comment([C|Cs], St, Line, Col, Toks, N) when C =/= $\n, ?CHAR(C) ->
+ case ?UNICODE(C) of
+ true ->
+ skip_comment(Cs, St, Line, Col, Toks, N+1);
+ false ->
+ Ncol = incr_column(Col, N+1),
+ scan_error({illegal,character}, Line, Col, Line, Ncol, Cs)
+ end;
+skip_comment([]=Cs, _St, Line, Col, Toks, N) ->
+ {more,{Cs,Col,Toks,Line,N,fun skip_comment/6}};
+skip_comment(Cs, St, Line, Col, Toks, N) ->
+ scan1(Cs, St, Line, incr_column(Col, N), Toks).
+
+scan_comment([C|Cs], St, Line, Col, Toks, Ncs) when C =/= $\n, ?CHAR(C) ->
+ case ?UNICODE(C) of
+ true ->
+ scan_comment(Cs, St, Line, Col, Toks, [C|Ncs]);
+ false ->
+ Ncol = incr_column(Col, length(Ncs)+1),
+ scan_error({illegal,character}, Line, Col, Line, Ncol, Cs)
+ end;
+scan_comment([]=Cs, _St, Line, Col, Toks, Ncs) ->
+ {more,{Cs,Col,Toks,Line,Ncs,fun scan_comment/6}};
+scan_comment(Cs, St, Line, Col, Toks, Ncs0) ->
+ Ncs = lists:reverse(Ncs0),
+ tok3(Cs, St, Line, Col, Toks, comment, Ncs, Ncs).
+
+tok2(Cs, #erl_scan{text = false}=St, Line, no_col=Col, Toks, _Wcs, P) ->
+ scan1(Cs, St, Line, Col, [{P,Line}|Toks]);
+tok2(Cs, St, Line, Col, Toks, Wcs, P) ->
+ Attrs = attributes(Line, Col, St, Wcs),
+ scan1(Cs, St, Line, incr_column(Col, length(Wcs)), [{P,Attrs}|Toks]).
+
+tok2(Cs, #erl_scan{text = false}=St, Line, no_col=Col, Toks, _Wcs, P, _N) ->
+ scan1(Cs, St, Line, Col, [{P,Line}|Toks]);
+tok2(Cs, St, Line, Col, Toks, Wcs, P, N) ->
+ Attrs = attributes(Line, Col, St, Wcs),
+ scan1(Cs, St, Line, incr_column(Col, N), [{P,Attrs}|Toks]).
+
+tok3(Cs, #erl_scan{text = false}=St, Line, no_col=Col, Toks, Item, _S, Sym) ->
+ scan1(Cs, St, Line, Col, [{Item,Line,Sym}|Toks]);
+tok3(Cs, St, Line, Col, Toks, Item, String, Sym) ->
+ Token = {Item,attributes(Line, Col, St, String),Sym},
+ scan1(Cs, St, Line, incr_column(Col, length(String)), [Token|Toks]).
+
+tok3(Cs, #erl_scan{text = false}=St, Line, no_col=Col, Toks, Item,
+ _String, Sym, _Length) ->
+ scan1(Cs, St, Line, Col, [{Item,Line,Sym}|Toks]);
+tok3(Cs, St, Line, Col, Toks, Item, String, Sym, Length) ->
+ Token = {Item,attributes(Line, Col, St, String),Sym},
+ scan1(Cs, St, Line, incr_column(Col, Length), [Token|Toks]).
+
+scan_error(Error, Line, Col, EndLine, EndCol, Rest) ->
+ Loc = location(Line, Col),
+ EndLoc = location(EndLine, EndCol),
+ scan_error(Error, Loc, EndLoc, Rest).
+
+scan_error(Error, ErrorLoc, EndLoc, Rest) ->
+ {{error,{ErrorLoc,?MODULE,Error},EndLoc},Rest}.
+
+-compile({inline,[attributes/4]}).
+
+attributes(Line, no_col, #erl_scan{text = false}, _String) ->
+ Line;
+attributes(Line, no_col, #erl_scan{text = true}, String) ->
+ [{line,Line},{text,String}];
+attributes(Line, Col, #erl_scan{text = false}, _String) ->
+ {Line,Col};
+attributes(Line, Col, #erl_scan{text = true}, String) ->
+ [{line,Line},{column,Col},{text,String}].
+
+location(Line, no_col) ->
+ Line;
+location(Line, Col) when is_integer(Col) ->
+ {Line,Col}.
+
+-compile({inline,[incr_column/2,new_column/2]}).
+
+incr_column(no_col=Col, _N) ->
+ Col;
+incr_column(Col, N) when is_integer(Col) ->
+ Col + N.
+
+new_column(no_col=Col, _Ncol) ->
+ Col;
+new_column(Col, Ncol) when is_integer(Col) ->
+ Ncol.
+
+nl_spcs(2) -> "\n ";
+nl_spcs(3) -> "\n ";
+nl_spcs(4) -> "\n ";
+nl_spcs(5) -> "\n ";
+nl_spcs(6) -> "\n ";
+nl_spcs(7) -> "\n ";
+nl_spcs(8) -> "\n ";
+nl_spcs(9) -> "\n ";
+nl_spcs(10) -> "\n ";
+nl_spcs(11) -> "\n ";
+nl_spcs(12) -> "\n ";
+nl_spcs(13) -> "\n ";
+nl_spcs(14) -> "\n ";
+nl_spcs(15) -> "\n ";
+nl_spcs(16) -> "\n ";
+nl_spcs(17) -> "\n ".
+
+spcs(1) -> " ";
+spcs(2) -> " ";
+spcs(3) -> " ";
+spcs(4) -> " ";
+spcs(5) -> " ";
+spcs(6) -> " ";
+spcs(7) -> " ";
+spcs(8) -> " ";
+spcs(9) -> " ";
+spcs(10) -> " ";
+spcs(11) -> " ";
+spcs(12) -> " ";
+spcs(13) -> " ";
+spcs(14) -> " ";
+spcs(15) -> " ";
+spcs(16) -> " ".
+
+nl_tabs(2) -> "\n\t";
+nl_tabs(3) -> "\n\t\t";
+nl_tabs(4) -> "\n\t\t\t";
+nl_tabs(5) -> "\n\t\t\t\t";
+nl_tabs(6) -> "\n\t\t\t\t\t";
+nl_tabs(7) -> "\n\t\t\t\t\t\t";
+nl_tabs(8) -> "\n\t\t\t\t\t\t\t";
+nl_tabs(9) -> "\n\t\t\t\t\t\t\t\t";
+nl_tabs(10) -> "\n\t\t\t\t\t\t\t\t\t";
+nl_tabs(11) -> "\n\t\t\t\t\t\t\t\t\t\t".
+
+tabs(1) -> "\t";
+tabs(2) -> "\t\t";
+tabs(3) -> "\t\t\t";
+tabs(4) -> "\t\t\t\t";
+tabs(5) -> "\t\t\t\t\t";
+tabs(6) -> "\t\t\t\t\t\t";
+tabs(7) -> "\t\t\t\t\t\t\t";
+tabs(8) -> "\t\t\t\t\t\t\t\t";
+tabs(9) -> "\t\t\t\t\t\t\t\t\t";
+tabs(10) -> "\t\t\t\t\t\t\t\t\t\t".
+
+-spec reserved_word(Atom :: atom()) -> boolean().
+reserved_word('after') -> true;
+reserved_word('begin') -> true;
+reserved_word('case') -> true;
+reserved_word('try') -> true;
+reserved_word('cond') -> true;
+reserved_word('catch') -> true;
+reserved_word('andalso') -> true;
+reserved_word('orelse') -> true;
+reserved_word('end') -> true;
+reserved_word('fun') -> true;
+reserved_word('if') -> true;
+reserved_word('let') -> true;
+reserved_word('of') -> true;
+reserved_word('receive') -> true;
+reserved_word('when') -> true;
+reserved_word('bnot') -> true;
+reserved_word('not') -> true;
+reserved_word('div') -> true;
+reserved_word('rem') -> true;
+reserved_word('band') -> true;
+reserved_word('and') -> true;
+reserved_word('bor') -> true;
+reserved_word('bxor') -> true;
+reserved_word('bsl') -> true;
+reserved_word('bsr') -> true;
+reserved_word('or') -> true;
+reserved_word('xor') -> true;
+reserved_word(_) -> false.
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
index 3456f0e9c6..cdcaa5f9e8 100644
--- a/lib/dialyzer/test/opaque_SUITE_data/src/opaque/opaque_adt.erl
+++ b/lib/dialyzer/test/opaque_SUITE_data/src/opaque/opaque_adt.erl
@@ -3,6 +3,8 @@
-opaque abc() :: 'a' | 'b' | 'c'.
+-spec atom_or_list(_) -> abc() | list().
+
atom_or_list(1) -> a;
atom_or_list(2) -> b;
atom_or_list(3) -> c;
diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/simple/exact_adt.erl b/lib/dialyzer/test/opaque_SUITE_data/src/simple/exact_adt.erl
new file mode 100644
index 0000000000..7103847ae7
--- /dev/null
+++ b/lib/dialyzer/test/opaque_SUITE_data/src/simple/exact_adt.erl
@@ -0,0 +1,17 @@
+-module(exact_adt).
+
+-export([exact_adt_set_type/1, exact_adt_set_type2/1]).
+
+-export_type([exact_adt/0]).
+
+-record(exact_adt, {}).
+
+-opaque exact_adt() :: #exact_adt{}.
+
+-spec exact_adt_set_type(_) -> exact_adt().
+
+exact_adt_set_type(G) -> G.
+
+-spec exact_adt_set_type2(exact_adt()) -> exact_adt().
+
+exact_adt_set_type2(G) -> G.
diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/simple/exact_api.erl b/lib/dialyzer/test/opaque_SUITE_data/src/simple/exact_api.erl
new file mode 100644
index 0000000000..5f7ab4f3aa
--- /dev/null
+++ b/lib/dialyzer/test/opaque_SUITE_data/src/simple/exact_api.erl
@@ -0,0 +1,60 @@
+-module(exact_api).
+
+-export([new/0, exact_api_test/1, exact_api_new/1,
+ exact_adt_test/1, exact_adt_new/1]).
+
+-export_type([exact_api/0]).
+
+-record(digraph, {vtab = notable :: ets:tab(),
+ etab = notable :: ets:tab(),
+ ntab = notable :: ets:tab(),
+ cyclic = true :: boolean()}).
+
+-spec new() -> digraph().
+
+new() ->
+ A = #digraph{},
+ set_type(A), % does not have an opaque term as 1st argument
+ A.
+
+-spec set_type(digraph()) -> true.
+
+set_type(G) ->
+ digraph:delete(G).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%% The derived spec of exact_api_new() is
+%%% -spec exact_api_new(exact_api:exact_api()) -> exact_api:exact_api().
+%%% This won't happen unless dialyzer_typesig uses
+%%% t_is_exactly_equal() rather than t_is_equal().
+%%% [As of R17B the latter considers two types equal if nothing but
+%%% their ?opaque tags differ.]
+
+-record(exact_api, {}).
+
+-opaque exact_api() :: #exact_api{}.
+
+exact_api_test(X) ->
+ #exact_api{} = exact_api_set_type(X). % OK
+
+exact_api_new(A) ->
+ A = #exact_api{},
+ _ = exact_api_set_type(A), % OK (the opaque type is local)
+ A.
+
+-spec exact_api_set_type(exact_api()) -> exact_api().
+
+exact_api_set_type(#exact_api{}=E) -> E.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+-record(exact_adt, {}).
+
+exact_adt_test(X) ->
+ #exact_adt{} = exact_adt:exact_adt_set_type(X). % breaks the opaqueness
+
+exact_adt_new(A) ->
+ A = #exact_adt{},
+ _ = exact_adt:exact_adt_set_type2(A), % does not have an opaque term as 1st argument
+ A.
diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/simple/is_rec.erl b/lib/dialyzer/test/opaque_SUITE_data/src/simple/is_rec.erl
new file mode 100644
index 0000000000..2b157483bc
--- /dev/null
+++ b/lib/dialyzer/test/opaque_SUITE_data/src/simple/is_rec.erl
@@ -0,0 +1,65 @@
+-module(is_rec).
+
+-export([ri1/0, ri11/0, ri13/0, ri14/0, ri2/0, ri3/0, ri4/0, ri5/0,
+ ri6/0, ri7/0, ri8/0]).
+
+-record(r, {f1 :: integer()}).
+
+ri1() ->
+ A = simple1_adt:d1(),
+ is_record(A, r). % opaque term 1
+
+ri11() ->
+ A = simple1_adt:d1(),
+ I = '1-3'(),
+ is_record(A, r, I). % opaque term 1
+
+ri13() ->
+ A = simple1_adt:d1(),
+ if is_record(A, r) -> true end. % breaks the opaqueness
+
+ri14() ->
+ A = simple1_adt:d1(),
+ if is_record({A, 1}, r) -> true end. % breaks the opaqueness
+
+-type '1-3-t'() :: 1..3.
+
+-spec '1-3'() -> '1-3-t'().
+
+'1-3'() ->
+ random:uniform(3).
+
+
+-spec 'Atom'() -> atom().
+
+'Atom'() ->
+ a.
+
+ri2() ->
+ A = simple1_adt:d1(),
+ R = 'Atom'(),
+ is_record(A, R). % opaque term 1
+
+ri3() ->
+ A = simple1_adt:d1(),
+ is_record(A, A, 1). % opaque term 2
+
+ri4() ->
+ A = simple1_adt:d1(),
+ is_record(A, hipp:hopp(), 1). % opaque term 1
+
+ri5() ->
+ A = simple1_adt:d1(),
+ is_record(A, A, hipp:hopp()). % opaque term 2
+
+ri6() ->
+ A = simple1_adt:d1(),
+ if is_record(A, r) -> true end. % breaks opaqueness
+
+ri7() ->
+ A = simple1_adt:d1(),
+ if is_record({r, A}, r) -> true end. % A violates #r{}
+
+ri8() ->
+ A = simple1_adt:d1(),
+ is_record({A, 1}, r). % opaque term 1
diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/simple/rec_adt.erl b/lib/dialyzer/test/opaque_SUITE_data/src/simple/rec_adt.erl
new file mode 100644
index 0000000000..ff80d6e99b
--- /dev/null
+++ b/lib/dialyzer/test/opaque_SUITE_data/src/simple/rec_adt.erl
@@ -0,0 +1,28 @@
+-module(rec_adt).
+
+-export([f/0, r1/0]).
+
+-export_type([r1/0]).
+
+-export_type([f/0, op_t/0, a/0]).
+
+-opaque a() :: a | b.
+
+-record(r1,
+ {f1 :: a()}).
+
+-opaque r1() :: #r1{}.
+
+-opaque f() :: fun((_) -> _).
+
+-opaque op_t() :: integer().
+
+-spec f() -> f().
+
+f() ->
+ fun(_) -> 3 end.
+
+-spec r1() -> r1().
+
+r1() ->
+ #r1{f1 = a}.
diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/simple/rec_api.erl b/lib/dialyzer/test/opaque_SUITE_data/src/simple/rec_api.erl
new file mode 100644
index 0000000000..d9b1d59f0c
--- /dev/null
+++ b/lib/dialyzer/test/opaque_SUITE_data/src/simple/rec_api.erl
@@ -0,0 +1,77 @@
+-module(rec_api).
+
+-export([t1/0, t2/0, adt_t1/0, adt_t1/1, adt_r1/0,
+ t/1, t_adt/0, r/0, r_adt/0]).
+
+-export_type([{a,0},{r1,0}]).
+
+-export_type([f/0, op_t/0, r/0, tup/0]).
+
+-opaque a() :: a | b.
+
+-record(r1,
+ {f1 :: a()}).
+
+-opaque r1() :: #r1{}.
+
+t1() ->
+ A = #r1{f1 = a},
+ {r1, a} = A.
+
+t2() ->
+ A = {r1, 10}, % violates the type of #r1{}
+ {r1, 10} = A. % violates the type of #r1{}
+
+adt_t1() ->
+ R = rec_adt:r1(),
+ {r1, a} = R. % breaks the opaqueness
+
+-spec adt_t1(rec_adt:r1()) -> rec_adt:r1(). % invalid type spec
+
+adt_t1(R) ->
+ {r1, a} = R.
+
+-spec adt_r1() -> rec_adt:r1(). % invalid type spec
+
+adt_r1() ->
+ #r1{f1 = a}.
+
+-opaque f() :: fun((_) -> _).
+
+-opaque op_t() :: integer().
+
+-spec t(f()) -> _.
+
+t(A) ->
+ T = term(),
+ %% 3(T), % cannot test this: dialyzer_dep deliberately crashes
+ A(T).
+
+-spec term() -> op_t().
+
+term() ->
+ 3.
+
+t_adt() ->
+ A = rec_adt:f(),
+ T = term(),
+ A(T).
+
+-record(r, {f = fun(_) -> 3 end :: f(), o = 1 :: op_t()}).
+
+-opaque r() :: #r{}.
+
+-opaque tup() :: {'r', f(), op_t()}.
+
+-spec r() -> _.
+
+r() ->
+ {r, f(), 2}. % OK, f() is a local opaque type
+
+-spec f() -> f().
+
+f() ->
+ fun(_) -> 3 end.
+
+r_adt() ->
+ {r, rec_adt:f(), 2}. % breaks the opaqueness
diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/simple/simple1_adt.erl b/lib/dialyzer/test/opaque_SUITE_data/src/simple/simple1_adt.erl
new file mode 100644
index 0000000000..21a277c1e9
--- /dev/null
+++ b/lib/dialyzer/test/opaque_SUITE_data/src/simple/simple1_adt.erl
@@ -0,0 +1,138 @@
+-module(simple1_adt).
+
+-export([d1/0, d2/0, i/0, n1/0, n2/0, o1/0, o2/0,
+ c1/0, c2/0, bit1/0, a/0, i1/0, tuple/0,
+ b1/0, b2/0, ty_i1/0]).
+
+-export_type([o1/0, o2/0, d1/0, d2/0]).
+
+-export_type([i1/0, i2/0, di1/0, di2/0]).
+
+-export_type([ty_i1/0, c1/0, c2/0]).
+
+-export_type([b1/0, b2/0]).
+
+-export_type([bit1/0]).
+
+-export_type([tuple1/0, a/0, i/0]).
+
+%% Equal:
+
+-opaque o1() :: a | b | c.
+
+-opaque o2() :: a | b | c.
+
+%% Disjoint:
+
+-opaque d1() :: a | b | c.
+
+-opaque d2() :: d | e | f.
+
+%% One common element:
+
+-opaque c1() :: a | b | c.
+
+-opaque c2() :: c | e | f.
+
+%% Equal integer range:
+
+-opaque i1() :: 1 | 2.
+
+-opaque i2() :: 1 | 2.
+
+%% Disjoint integer range:
+
+-opaque di1() :: 1 | 2.
+
+-opaque di2() :: 3 | 4.
+
+
+-type ty_i1() :: 1 | 2.
+
+%% Boolean types
+
+-opaque b1() :: boolean().
+
+-opaque b2() :: boolean().
+
+%% Binary types
+
+-opaque bit1() :: binary().
+
+%% Tuple types
+
+-opaque tuple1() :: tuple().
+
+%% Atom type
+
+-opaque a() :: atom().
+
+-opaque i() :: integer().
+
+-spec d1() -> d1().
+
+d1() -> a.
+
+-spec d2() -> d2().
+
+d2() -> d.
+
+-spec i() -> i().
+
+i() ->
+ 1.
+
+-spec n1() -> o1().
+
+n1() -> a.
+
+-spec n2() -> o2().
+
+n2() -> a.
+
+-spec o1() -> o1().
+
+o1() -> a.
+
+-spec o2() -> o2().
+
+o2() -> a.
+
+-spec c1() -> c1().
+
+c1() -> a.
+
+-spec c2() -> c2().
+
+c2() -> e.
+
+-spec bit1() -> bit1().
+
+bit1() ->
+ <<"hej">>.
+
+-spec a() -> a().
+
+a() ->
+ e.
+
+-spec i1() -> i1().
+
+i1() -> 1.
+
+-spec tuple() -> tuple1().
+
+tuple() -> {1,2}.
+
+-spec b1() -> b1().
+
+b1() -> true.
+
+-spec b2() -> b2().
+
+b2() -> false.
+
+-spec ty_i1() -> ty_i1().
+
+ty_i1() ->
+ 1.
diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/simple/simple1_api.erl b/lib/dialyzer/test/opaque_SUITE_data/src/simple/simple1_api.erl
new file mode 100644
index 0000000000..5135eb8e59
--- /dev/null
+++ b/lib/dialyzer/test/opaque_SUITE_data/src/simple/simple1_api.erl
@@ -0,0 +1,571 @@
+-module(simple1_api).
+
+-export([t1/1, adt_t1/1, t2/1, adt_t2/1, tup/0, t3/0, t4/0, t5/0, t6/0, t7/0,
+ t8/0, adt_t3/0, adt_t4/0, adt_t7/0, adt_t8/0, adt_t5/0,
+ c1/2, c2/2, c2/0, c3/0, c4/0, tt1/0, tt2/0,
+ cmp1/0, cmp2/0, cmp3/0, cmp4/0,
+ ty_cmp1/0, ty_cmp2/0, ty_cmp3/0, ty_cmp4/0,
+ f1/0, f2/0, adt_f1/0, adt_f2/0, f3/0, f4/0, adt_f3/0, adt_f4/0,
+ adt_f4_a/0, adt_f4_b/0,
+ bool_t1/0, bool_t2/0, bool_t3/0, bool_t4/0, bool_t5/1, bool_t6/1,
+ bool_t7/0, bool_adt_t1/0, bool_adt_t2/0, bool_adt_t5/1,
+ bool_adt_t6/1, bool_t8/0, bool_adt_t8/2, bool_t9/0, bool_adt_t9/2,
+ bit_t1/0, bit_adt_t1/0, bit_t3/1, bit_adt_t2/0, bit_adt_t3/1,
+ bit_t5/1, bit_t4/1, bit_adt_t4/1, bit_t5/0, bit_adt_t5/0,
+ call_f/1, call_f_adt/1, call_m_adt/1, call_m/1, call_f_i/1,
+ call_m_i/1, call_m_adt_i/1, call_f_adt_i/1,
+ eq1/0, eq2/0, c5/0, c6/2, c7/2, c8/0]).
+
+%%% Equal opaque types
+
+-export_type([o1/0, o2/0]).
+
+-export_type([d1/0, d2/0]).
+
+-opaque o1() :: a | b | c.
+
+-opaque o2() :: a | b | c.
+
+-export_type([i1/0, i2/0, di1/0, di2/0]).
+
+-export_type([b1/0, b2/0]).
+
+-export_type([bit1/0]).
+
+-export_type([a/0, i/0]).
+
+%% The derived spec is
+%% -spec t1('a' | 'b') -> simple1_api:o1('a') | simple1_api:o2('a').
+%% but that is not tested...
+
+t1(a) ->
+ o1();
+t1(b) ->
+ o2().
+
+-spec o1() -> o1().
+
+o1() -> a.
+
+-spec o2() -> o2().
+
+o2() -> a.
+
+%% The derived spec is
+%% -spec adt_t1('a' | 'b') -> simple1_adt:o1('a') | simple1_adt:o2('a').
+%% but that is not tested...
+
+adt_t1(a) ->
+ simple1_adt:o1();
+adt_t1(b) ->
+ simple1_adt:o2().
+
+%%% Disjunct opaque types
+
+-opaque d1() :: a | b | c.
+
+-opaque d2() :: d | e | f.
+
+%% -spec t2('a' | 'b') -> simple1_api:d1('a') | simple1_api:d2('d').
+
+t2(a) ->
+ d1();
+t2(b) ->
+ d2().
+
+-spec d1() -> d1().
+
+d1() -> a.
+
+-spec d2() -> d2().
+
+d2() -> d.
+
+%% -spec adt_t2('a' | 'b') -> simple1_adt:d1('a') | simple1_adt:d2('d').
+
+adt_t2(a) ->
+ simple1_adt:d1();
+adt_t2(b) ->
+ simple1_adt:d2().
+
+-spec tup() -> simple1_adt:tuple1(). % invalid type spec
+
+tup() ->
+ {a, b}.
+
+%%% Matching equal opaque types with different names
+
+t3() ->
+ A = n1(),
+ B = n2(),
+ A = A, % OK, of course
+ A = B. % OK since o1() and o2() are local opaque types
+
+t4() ->
+ A = n1(),
+ B = n2(),
+ true = A =:= A, % OK, of course
+ A =:= B. % OK since o1() and o2() are local opaque types
+
+t5() ->
+ A = d1(),
+ B = d2(),
+ A =:= B. % can never evaluate to true
+
+t6() ->
+ A = d1(),
+ B = d2(),
+ A = B. % can never succeed
+
+t7() ->
+ A = d1(),
+ B = d2(),
+ A =/= B. % OK (always true?)
+
+t8() ->
+ A = d1(),
+ B = d2(),
+ A /= B. % OK (always true?)
+
+-spec n1() -> o1().
+
+n1() -> a.
+
+-spec n2() -> o2().
+
+n2() -> a.
+
+adt_t3() ->
+ A = simple1_adt:n1(),
+ B = simple1_adt:n2(),
+ true = A =:= A, % OK.
+ A =:= B. % opaque test, not OK
+
+adt_t4() ->
+ A = simple1_adt:n1(),
+ B = simple1_adt:n2(),
+ A = A, % OK
+ A = B. % opaque term
+
+adt_t7() ->
+ A = simple1_adt:n1(),
+ B = simple1_adt:n2(),
+ false = A =/= A, % OK
+ A =/= B. % opaque test, not OK
+
+adt_t8() ->
+ A = simple1_adt:n1(),
+ B = simple1_adt:n2(),
+ false = A /= A, % OK
+ A /= B. % opaque test, not OK
+
+adt_t5() ->
+ A = simple1_adt:c1(),
+ B = simple1_adt:c2(),
+ A =:= B. % opaque test, not OK
+
+%% Comparison in guard
+
+-spec c1(simple1_adt:d1(), simple1_adt:d2()) -> boolean().
+
+c1(A, B) when A =< B -> true. % succ type of A and B is any() (type spec is OK)
+
+-spec c2(simple1_adt:d1(), simple1_adt:d2()) -> boolean().
+
+c2(A, B) ->
+ if A =< B -> true end. % succ type of A and B is any() (type spec is OK)
+
+c2() ->
+ A = simple1_adt:d1(),
+ B = simple1_adt:d2(),
+ if A =< B -> ok end. % opaque term
+
+c3() ->
+ B = simple1_adt:d2(),
+ if a =< B -> ok end. % opaque term
+
+c4() ->
+ A = simple1_adt:d1(),
+ if A =< d -> ok end. % opaque term
+
+tt1() ->
+ A = o1(),
+ is_integer(A). % OK
+
+tt2() ->
+ A = simple1_adt:d1(),
+ is_integer(A). % breaks the opaqueness
+
+%% Comparison with integers
+
+-opaque i1() :: 1 | 2.
+
+-opaque i2() :: 1 | 2.
+
+-opaque di1() :: 1 | 2.
+
+-opaque di2() :: 3 | 4.
+
+-spec i1() -> i1().
+
+i1() -> 1.
+
+-type ty_i1() :: 1 | 2.
+
+-spec ty_i1() -> ty_i1().
+
+ty_i1() -> 1.
+
+cmp1() ->
+ A = i1(),
+ if A > 3 -> ok end. % can never succeed
+
+cmp2() ->
+ A = simple1_adt:i1(),
+ if A > 3 -> ok end. % opaque term
+
+cmp3() ->
+ A = i1(),
+ if A < 3 -> ok end.
+
+cmp4() ->
+ A = simple1_adt:i1(),
+ if A < 3 -> ok end. % opaque term
+
+%% -type
+
+ty_cmp1() ->
+ A = ty_i1(),
+ if A > 3 -> ok end. % can never succeed
+
+ty_cmp2() ->
+ A = simple1_adt:ty_i1(),
+ if A > 3 -> ok end. % can never succeed
+
+ty_cmp3() ->
+ A = ty_i1(),
+ if A < 3 -> ok end.
+
+ty_cmp4() ->
+ A = simple1_adt:ty_i1(),
+ if A < 3 -> ok end.
+
+%% is_function
+
+f1() ->
+ T = n1(),
+ if is_function(T) -> ok end. % can never succeed
+
+f2() ->
+ T = n1(),
+ is_function(T). % ok
+
+adt_f1() ->
+ T = simple1_adt:n1(),
+ if is_function(T) -> ok end. % breaks the opaqueness
+
+adt_f2() ->
+ T = simple1_adt:n1(),
+ is_function(T). % breaks the opaqueness
+
+f3() ->
+ A = i1(),
+ T = n1(),
+ if is_function(T, A) -> ok end. % can never succeed
+
+f4() ->
+ A = i1(),
+ T = n1(),
+ is_function(T, A). % ok
+
+adt_f3() ->
+ A = simple1_adt:i1(),
+ T = simple1_adt:n1(),
+ if is_function(T, A) -> ok end. % breaks the opaqueness
+
+adt_f4() ->
+ A = simple1_adt:i1(),
+ T = simple1_adt:n1(),
+ is_function(T, A). % breaks the opaqueness
+
+adt_f4_a() ->
+ A = simple1_adt:i1(),
+ T = n1(),
+ is_function(T, A). % opaque term
+
+
+adt_f4_b() ->
+ A = i1(),
+ T = simple1_adt:n1(),
+ is_function(T, A). % breaks the opaqueness
+
+%% A few Boolean examples
+
+bool_t1() ->
+ B = b2(),
+ if B -> ok end. % B =:= true can never succeed
+
+bool_t2() ->
+ A = b1(),
+ B = b2(),
+ if A and not B -> ok end.
+
+bool_t3() ->
+ A = b1(),
+ if not A -> ok end. % can never succeed
+
+bool_t4() ->
+ A = n1(),
+ if not ((A >= 1) and not (A < 1)) -> ok end. % can never succeed
+
+-spec bool_t5(i1()) -> integer().
+
+bool_t5(A) ->
+ if [not (A > 1)] =:=
+ [false]-> 1 end.
+
+-spec bool_t6(b1()) -> integer().
+
+bool_t6(A) ->
+ if [not A] =:=
+ [false]-> 1 end.
+
+-spec bool_t7() -> integer().
+
+bool_t7() ->
+ A = i1(),
+ if [not A] =:= % cannot succeed
+ [false]-> 1 end.
+
+bool_adt_t1() ->
+ B = simple1_adt:b2(),
+ if B -> ok end. % opaque term
+
+bool_adt_t2() ->
+ A = simple1_adt:b1(),
+ B = simple1_adt:b2(),
+ if A and not B -> ok end. % opaque term
+
+-spec bool_adt_t5(simple1_adt:i1()) -> integer().
+
+bool_adt_t5(A) ->
+ if [not (A > 1)] =:= % succ type of A is any() (type spec is OK)
+ [false]-> 1 end.
+
+-spec bool_adt_t6(simple1_adt:b1()) -> integer(). % invalid type spec
+
+bool_adt_t6(A) ->
+ if [not A] =:= % succ type of A is 'true'
+ [false]-> 1 end.
+
+-spec bool_t8() -> integer().
+
+bool_t8() ->
+ A = i1(),
+ if [A and A] =:= % cannot succeed
+ [false]-> 1 end.
+
+-spec bool_adt_t8(simple1_adt:b1(), simple1_adt:b2()) -> integer(). % invalid
+
+bool_adt_t8(A, B) ->
+ if [A and B] =:=
+ [false]-> 1 end.
+
+-spec bool_t9() -> integer().
+
+bool_t9() ->
+ A = i1(),
+ if [A or A] =:= % cannot succeed
+ [false]-> 1 end.
+
+-spec bool_adt_t9(simple1_adt:b1(), simple1_adt:b2()) -> integer(). % invalid
+
+bool_adt_t9(A, B) ->
+ if [A or B] =:=
+ [false]-> 1 end.
+
+-opaque b1() :: boolean().
+
+-opaque b2() :: boolean().
+
+-spec b1() -> b1().
+
+b1() -> true.
+
+-spec b2() -> b2().
+
+b2() -> false.
+
+%% Few (very few...) examples with bit syntax
+
+bit_t1() ->
+ A = i1(),
+ <<100:(A)>>.
+
+bit_adt_t1() ->
+ A = simple1_adt:i1(),
+ <<100:(A)>>. % breaks the opaqueness
+
+bit_t3(A) ->
+ B = i1(),
+ case none:none() of
+ <<A:B>> -> 1
+ end.
+
+bit_adt_t2() ->
+ A = simple1_adt:i1(),
+ case <<"hej">> of
+ <<_:A>> -> ok % breaks the opaqueness (but the message is strange)
+ end.
+
+
+bit_adt_t3(A) ->
+ B = simple1_adt:i1(),
+ case none:none() of
+ <<A: % breaks the opaqueness (the message is less than perfect)
+ B>> -> 1
+ end.
+
+bit_t5(A) ->
+ B = o1(),
+ case none:none() of
+ <<A:B>> -> 1 % breaks the opaqueness
+ end.
+
+-spec bit_t4(<<_:1>>) -> integer().
+
+bit_t4(A) ->
+ Sz = i1(),
+ case A of
+ <<_:Sz>> -> 1
+ end.
+
+-spec bit_adt_t4(<<_:1>>) -> integer().
+
+bit_adt_t4(A) ->
+ Sz = simple1_adt:i1(),
+ case A of
+ <<_:Sz>> -> 1 % breaks the opaqueness
+ end.
+
+bit_t5() ->
+ A = bit1(),
+ case A of
+ <<_/binary>> -> 1
+ end.
+
+bit_adt_t5() ->
+ A = simple1_adt:bit1(),
+ case A of
+ <<_/binary>> -> 1 % breaks the opaqueness
+ end.
+
+-opaque bit1() :: binary().
+
+-spec bit1() -> bit1().
+
+bit1() ->
+ <<"hej">>.
+
+%% Calls with variable module or function
+
+call_f(A) ->
+ A = a(),
+ foo:A(A).
+
+call_f_adt(A) ->
+ A = simple1_adt:a(),
+ foo:A(A). % breaks the opaqueness
+
+call_m(A) ->
+ A = a(),
+ A:foo(A).
+
+call_m_adt(A) ->
+ A = simple1_adt:a(),
+ A:foo(A). % breaks the opaqueness
+
+-opaque a() :: atom().
+
+-opaque i() :: integer().
+
+-spec a() -> a().
+
+a() ->
+ e.
+
+call_f_i(A) ->
+ A = i(),
+ foo:A(A). % A is not atom() but i()
+
+call_f_adt_i(A) ->
+ A = simple1_adt:i(),
+ foo:A(A). % A is not atom() but simple1_adt:i()
+
+call_m_i(A) ->
+ A = i(),
+ A:foo(A). % A is not atom() but i()
+
+call_m_adt_i(A) ->
+ A = simple1_adt:i(),
+ A:foo(A). % A is not atom() but simple1_adt:i()
+
+-spec eq1() -> integer().
+
+eq1() ->
+ A = simple1_adt:d2(),
+ B = simple1_adt:d1(),
+ if
+ A == B -> % opaque term
+ 0;
+ A == A ->
+ 1;
+ A =:= A -> % compiler finds this one cannot match
+ 2;
+ true -> % compiler finds this one cannot match
+ 3
+ end.
+
+eq2() ->
+ A = simple1_adt:d1(),
+ if
+ {A} >= {A} ->
+ 1;
+ A >= 3 -> % opaque term
+ 2;
+ A == 3 -> % opaque term
+ 3;
+ A =:= 3 -> % opaque term
+ 4;
+ A == A ->
+ 5;
+ A =:= A -> % compiler finds this one cannot match
+ 6
+ end.
+
+c5() ->
+ A = simple1_adt:d1(),
+ A < 3. % opaque term
+
+c6(A, B) ->
+ A = simple1_adt:d1(),
+ B = simple1_adt:d1(),
+ A =< B. % same type - no warning
+
+c7(A, B) ->
+ A = simple1_adt:d1(),
+ B = simple1_adt:d2(),
+ A =< B. % opaque term
+
+c8() ->
+ D = digraph:new(),
+ E = ets:new(foo, []),
+ if {D, a} > {D, E} -> true; % OK
+ {1.0, 2} > {{D}, {E}} -> true; % OK
+ {D, 3} > {D, E} -> true % opaque term 2
+ end.
+
+-spec i() -> i().
+
+i() ->
+ 1.
diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/simple/simple2_api.erl b/lib/dialyzer/test/opaque_SUITE_data/src/simple/simple2_api.erl
new file mode 100644
index 0000000000..c86f6fd0b5
--- /dev/null
+++ b/lib/dialyzer/test/opaque_SUITE_data/src/simple/simple2_api.erl
@@ -0,0 +1,125 @@
+-module(simple2_api).
+
+-export([c1/2, c2/0, c3/0, c4/1, c5/1, c6/0, c6_b/0, c7/0, c7_b/0,
+ c7_c/0, c8/0, c9/0, c10/0, c11/0, c12/0, c13/0, c14/0, c15/0,
+ c16/0, c17/0, c18/0, c19/0, c20/0, c21/0, c22/0, c23/0,
+ c24/0, c25/0, c26/0]).
+
+-spec c1(simple1_adt:d1(), simple1_adt:d2()) -> boolean().
+
+c1(A, B) ->
+ {A} =< {B}. % succ type of A and B is any()
+
+c2() ->
+ A = simple1_adt:d1(),
+ erlang:make_tuple(1, A). % ok
+
+c3() ->
+ A = simple1_adt:d1(),
+ setelement(1, {A}, A). % ok
+
+c4(_) ->
+ A = simple1_adt:d1(),
+ halt(A). % ok (BIF fails...)
+
+c5(_) ->
+ A = simple1_adt:d1(),
+ [A] -- [A]. % ok
+
+c6() ->
+ A = simple1_adt:d1(),
+ A ! foo. % opaque term
+
+c6_b() ->
+ A = simple1_adt:d1(),
+ erlang:send(A, foo). % opaque term
+
+c7() ->
+ A = simple1_adt:d1(),
+ foo ! A. % ok
+
+c7_b() ->
+ A = simple1_adt:d1(),
+ erlang:send(foo, A). % ok
+
+c7_c() ->
+ A = simple1_adt:d1(),
+ erlang:send(foo, A, []). % ok
+
+c8() ->
+ A = simple1_adt:d1(),
+ A < 3. % opaque term
+
+c9() ->
+ A = simple1_adt:d1(),
+ lists:keysearch(A, 1, []). % ok
+
+c10() ->
+ A = simple1_adt:d1(),
+ lists:keysearch(1, A, []). % opaque term 2
+
+c11() ->
+ A = simple1_adt:tuple(),
+ lists:keysearch(key, 1, [A]). % ok
+
+c12() ->
+ A = simple1_adt:tuple(),
+ lists:keysearch(key, 1, A). % opaque term 3
+
+c13() ->
+ A = simple1_adt:tuple(),
+ lists:keysearch(key, 1, [{A,2}]). % ok
+
+c14() ->
+ A = simple1_adt:tuple(),
+ lists:keysearch(key, 1, [{2,A}]). % ok
+
+c15() ->
+ A = simple1_adt:d1(),
+ lists:keysearch(key, 1, [A]). % ok
+
+c16() ->
+ A = simple1_adt:tuple(),
+ erlang:send(foo, A). % ok
+
+c17() ->
+ A = simple1_adt:tuple(),
+ lists:reverse([A]). % ok
+
+c18() ->
+ A = simple1_adt:tuple(),
+ lists:keyreplace(a, 1, [A], {1,2}). % ok
+
+c19() ->
+ A = simple1_adt:tuple(),
+ %% Problem. The spec says argument 4 is a tuple(). Fix that!
+ lists:keyreplace(a, 1, [{1,2}], A). % opaque term 4
+
+c20() ->
+ A = simple1_adt:tuple(),
+ lists:flatten(A). % opaque term 1
+
+c21() ->
+ A = simple1_adt:tuple(),
+ lists:flatten([[{A}]]). % ok
+
+c22() ->
+ A = simple1_adt:tuple(),
+ lists:flatten([[A]]). % ok
+
+c23() ->
+ A = simple1_adt:tuple(),
+ lists:flatten([A]). % ok
+
+c24() ->
+ A = simple1_adt:tuple(),
+ lists:flatten({A}). % will never return
+
+c25() ->
+ A = simple1_adt:d1(),
+ B = simple1_adt:tuple(),
+ if {A,3} > {A,B} -> true end. % opaque 2nd argument
+
+c26() ->
+ B = simple1_adt:tuple(),
+ tuple_to_list(B). % opaque term 1
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
index 5ca3202bba..d88f238190 100644
--- a/lib/dialyzer/test/opaque_SUITE_data/src/union/union_adt.erl
+++ b/lib/dialyzer/test/opaque_SUITE_data/src/union/union_adt.erl
@@ -1,10 +1,15 @@
-module(union_adt).
-export([new/1, new_a/1, new_rec/1]).
+%% Now (R17) that opaque types are no longer recognized by their shape
+%% this test case is rather meaningless.
+
-record(rec, {x = 42 :: integer()}).
-opaque u() :: 'aaa' | 'bbb' | #rec{}.
+-spec new(_) -> u().
+
new(a) -> aaa;
new(b) -> bbb;
new(X) when is_integer(X) ->
@@ -13,7 +18,11 @@ new(X) when is_integer(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
+-spec new_a(_) -> u().
+
new_a(a) -> aaa.
+-spec new_rec(_) -> u().
+
new_rec(X) when is_integer(X) ->
#rec{x = X}.
diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/zoltan_adt.erl b/lib/dialyzer/test/opaque_SUITE_data/src/zoltan_adt.erl
new file mode 100644
index 0000000000..c742990c6a
--- /dev/null
+++ b/lib/dialyzer/test/opaque_SUITE_data/src/zoltan_adt.erl
@@ -0,0 +1,5 @@
+-module(zoltan_adt).
+
+-export_type([id/0]).
+
+-opaque id() :: string().
diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/zoltan_kis3.erl b/lib/dialyzer/test/opaque_SUITE_data/src/zoltan_kis3.erl
index b62b9de576..07c9f0a270 100644
--- a/lib/dialyzer/test/opaque_SUITE_data/src/zoltan_kis3.erl
+++ b/lib/dialyzer/test/opaque_SUITE_data/src/zoltan_kis3.erl
@@ -2,13 +2,13 @@
-export([f/0, gen/0]).
--opaque id() :: string().
+%-opaque id() :: string().
-spec f() -> char().
%% List pattern matching issue
f() -> [H|_T] = gen(), H.
--spec gen() -> id().
+-spec gen() -> zoltan_adt:id().
gen() -> "Dummy".
diff --git a/lib/dialyzer/vsn.mk b/lib/dialyzer/vsn.mk
index af32c5b901..95d2464e1d 100644
--- a/lib/dialyzer/vsn.mk
+++ b/lib/dialyzer/vsn.mk
@@ -1 +1 @@
-DIALYZER_VSN = 2.6.1
+DIALYZER_VSN = 2.7