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