diff options
Diffstat (limited to 'lib/dialyzer')
39 files changed, 4195 insertions, 777 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_dep.erl b/lib/dialyzer/src/dialyzer_dep.erl index 1a477f4388..05f81399fb 100644 --- a/lib/dialyzer/src/dialyzer_dep.erl +++ b/lib/dialyzer/src/dialyzer_dep.erl @@ -58,7 +58,8 @@ %% separatedly. %% --spec analyze(cerl:c_module()) -> {dict(), ordset('external' | label()), dict()}. +-spec analyze(cerl:c_module()) -> + {dict(), ordset('external' | label()), dict(), dict()}. analyze(Tree) -> %% io:format("Handling ~w\n", [cerl:atom_val(cerl:module_name(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 |