diff options
28 files changed, 1685 insertions, 689 deletions
diff --git a/lib/dialyzer/README b/lib/dialyzer/README index e9b03883d2..82d0f5ec48 100644 --- a/lib/dialyzer/README +++ b/lib/dialyzer/README @@ -3,9 +3,7 @@ ## Author(s): Tobias Lindahl <[email protected]> ## Kostis Sagonas <[email protected]> ## -## Copyright: Held by the authors; all rights reserved (2004 - 2009). -## -## $Id$ +## Copyright: Held by the authors; all rights reserved (2004 - 2010). ##---------------------------------------------------------------------------- The DIALYZER, a DIscrepany AnaLYZer for ERlang programs. diff --git a/lib/dialyzer/RELEASE_NOTES b/lib/dialyzer/RELEASE_NOTES index 8205acf192..b668142327 100644 --- a/lib/dialyzer/RELEASE_NOTES +++ b/lib/dialyzer/RELEASE_NOTES @@ -3,11 +3,25 @@ (in reversed chronological order) ============================================================================== +Version 2.2.0 (in Erlang/OTP R13B04) +------------------------------------ + - Much better support for opaque types (thanks to Manouk Manoukian). + - Added support for recursive types (experimental). + - Added support for parameterized modules. + - Dialyzer now warns when -specs state that a function returns some type + when in fact it does not. + - Added --no_native (-nn) option so that the user can bypass the native code + compilation that dialyzer heuristically performs when dialyzing many files. + - Fixed minor bug in the dialyzer script allowing the --wx option to bring + up the wx-based GUI regardless of its placement in the options list. + - Options --apps and -Wrace_conditions, which were added in the previous + version, are now properly documented in the manual. + Version 2.1.0 (in Erlang/OTP R13B03) ------------------------------------ - Dialyzer can statically detect some kinds of data races in Erlang programs. Use the new option -Wrace_conditions to enable the race analysis. - The technique is described in a paper which is available at: + The static analysis technique is described in a paper available at: http://www.it.uu.se/research/group/hipe/dialyzer/publications/races.pdf - Added support for packages (thanks to Maria Christakis). - There has been a major change in the default mode of Dialyzer. @@ -27,7 +41,7 @@ Version 2.1.0 (in Erlang/OTP R13B03) The new option can also take absolute file names as well as applications. Note that the application versions that will be included in the PLT are those that correspond to the Erlang/OTP system which is used. - - Dialyzer has a new wxWidgets based GUI (thanks to Elli Frangaki) + - Dialyzer has a new wxWidgets based GUI (thanks to Elli Fragkaki) for platforms where the wx application is available. Version 2.0.0 (in Erlang/OTP R13B02) diff --git a/lib/dialyzer/doc/manual.txt b/lib/dialyzer/doc/manual.txt index f1faed3c79..dac61b74b1 100644 --- a/lib/dialyzer/doc/manual.txt +++ b/lib/dialyzer/doc/manual.txt @@ -2,8 +2,6 @@ ## File: doc/manual.txt ## Author(s): Tobias Lindahl <[email protected]> ## Kostis Sagonas <[email protected]> -## -## $Id$ ##---------------------------------------------------------------------------- The DIALYZER, a DIscrepany AnaLYZer for ERlang programs. @@ -126,22 +124,29 @@ The exit status of the command line version is: Usage: dialyzer [--help] [--version] [--shell] [--quiet] [--verbose] [-pa dir]* [--plt plt] [-Ddefine]* [-I include_dir]* - [--output_plt file] [-Wwarn]* [--src] - [-c applications] [-r applications] [-o outfile] - [--build_plt] [--add_to_plt] [--remove_from_plt] [--check_plt] - [--plt_info] [--get_warnings] + [--output_plt file] [-Wwarn]* [--src] [--gui | --wx] + [files_or_dirs] [-r dirs] [--apps applications] [-o outfile] + [--build_plt] [--add_to_plt] [--remove_from_plt] + [--check_plt] [--no_check_plt] [--plt_info] [--get_warnings] + [--no_native] Options: - -c applications (or --command-line applications) - Use Dialyzer from the command line (no GUI) to detect defects in the - specified applications (directories or .erl or .beam files) - -r applications - Same as -c only that directories are searched recursively for - subdirectories containing .erl or .beam files (depending on the - type of analysis) - -o outfile (or --output outfile) - When using Dialyzer from the command line, send the analysis - results in the specified \"outfile\" rather than in stdout + files_or_dirs (for backwards compatibility also as: -c files_or_dirs) + Use Dialyzer from the command line to detect defects in the + specified files or directories containing .erl or .beam files, + depending on the type of the analysis + -r dirs + Same as the previous but the specified directories are searched + recursively for subdirectories containing .erl or .beam files in + them, depending on the type of analysis + --apps applications + Option typically used when building or modifying PLT as in: + dialyzer --build_plt --apps erts kernel stdlib mnesia ... + to conveniently refer to library applications corresponding to the + Erlang/OTP installation. However, the option is general and can also + be used during analysis in order to refer to Erlang/OTP applications. + In addition, file or directory names can also be included, as in: + dialyzer --apps inets ssl ./ebin ../other_lib/ebin/my_module.beam --raw When using Dialyzer from the command line, output the raw analysis results (Erlang terms) instead of the formatted result. @@ -154,14 +159,14 @@ Options: When analyzing from source, pass the define to Dialyzer (**) -I include_dir When analyzing from source, pass the include_dir to Dialyzer (**) + -pa dir + Include dir in the path for Erlang (useful when analyzing files + that have '-include_lib()' directives) --output_plt file Store the plt at the specified file after building it --plt plt Use the specified plt as the initial plt (if the plt was built during setup the files will be checked for consistency) - -pa dir - Include dir in the path for Erlang (useful when analyzing files - that have '-include_lib()' directives) -Wwarn A family of options which selectively turn on/off warnings (for help on the names of warnings use dialyzer -Whelp) @@ -200,6 +205,19 @@ Options: --get_warnings Makes Dialyzer emit warnings even when manipulating the plt. Only emits warnings for files that are actually analyzed. + --dump_callgraph file + Dump the call graph into the specified file whose format is determined + by the file name extension. Supported extensions are: raw, dot, and ps. + If something else is used as file name extension, default format '.raw' + will be used. + --no_native (or -nn) + Bypass the native code compilation of some key files that dialyzer + heuristically performs when dialyzing many files; this avoids the + compilation time but it may result in (much) longer analysis time. + --gui + Use the gs-based GUI. + --wx + Use the wx-based GUI. Note: * denotes that multiple occurrences of these options are possible. @@ -221,14 +239,22 @@ Warning options: Include warnings for function calls which ignore the return value(s). -Werror_handling *** Include warnings for functions that only return by means of an exception. + -Wrace_conditions *** + Include warnings for possible race conditions. + -Wbehaviours *** + Include warnings about behaviour callbacks which drift from the published + recommended interfaces. -Wunderspecs *** Warn about underspecified functions - (the -spec is strictly more allowing than the success typing) + (those whose -spec is strictly more allowing than the success typing). + +The following options are also available but their use is not recommended: +(they are mostly for Dialyzer developers and internal debugging) -Woverspecs *** Warn about overspecified functions - (the -spec is strictly less allowing than the success typing) + (those whose -spec is strictly less allowing than the success typing). -Wspecdiffs *** - Warn when the -spec is different than the success typing + Warn when the -spec is different than the success typing. Note: *** These are options that turn on warnings rather than turning them off. @@ -307,9 +333,7 @@ are using frequently. The PLT is built using the --build_plt option to dialyzer. The following command builds the recommended minimal PLT for OTP. -dialyzer --build_plt -r $ERL_TOP/lib/stdlib/ebin\ - $ERL_TOP/lib/kernel/ebin\ - $ERL_TOP/lib/mnesia/ebin + dialyzer --build_plt --apps erts kernel stdlib mnesia Dialyzer will look if there is an environment variable called $DIALYZER_PLT and place the PLT at this location. If no such variable @@ -321,22 +345,22 @@ You can also add information to an existing plt using the --add_to_plt option. Suppose you want to also include the compiler in the PLT and place it in a new PLT, then give the command -dialyzer --add_to_plt -r $ERL_TOP/lib/compiler/ebin --output_plt my.plt + dialyzer --add_to_plt --apps compiler --output_plt my.plt Then you would like to add your favorite application my_app to the new plt. -dialyzer --add_to_plt --plt my.plt -r <path>/my_app/ebin + dialyzer --add_to_plt --plt my.plt -r <path>/my_app/ebin But you realize that it is unnecessary to have compiler in this one. -dialyzer --remove_from_plt --plt my.plt -r $ERL_TOP/lib/compiler/ebin + dialyzer --remove_from_plt --plt my.plt ---apps compiler Later, when you have fixed a bug in your application my_app, you want to update the plt so that it will be fresh the next time you run Dialyzer, run the command -dialyzer --check_plt --plt my.plt + dialyzer --check_plt --plt my.plt Dialyzer will then reanalyze the files that have been changed, and the files that depend on these files. Note that this consistency check diff --git a/lib/dialyzer/doc/src/Makefile b/lib/dialyzer/doc/src/Makefile index 37bcb49de0..45b0ffa5ff 100755 --- a/lib/dialyzer/doc/src/Makefile +++ b/lib/dialyzer/doc/src/Makefile @@ -13,8 +13,7 @@ # Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings # AB. All Rights Reserved.'' # -# $Id$ -# + include $(ERL_TOP)/make/target.mk include $(ERL_TOP)/make/$(TARGET)/otp.mk diff --git a/lib/dialyzer/doc/warnings.txt b/lib/dialyzer/doc/warnings.txt index fd8cc0dc60..5c93f15a47 100644 --- a/lib/dialyzer/doc/warnings.txt +++ b/lib/dialyzer/doc/warnings.txt @@ -2,8 +2,6 @@ ## File: doc/warnings.txt ## Author(s): Tobias Lindahl <[email protected]> ## Kostis Sagonas <[email protected]> -## -## $Id$ ##---------------------------------------------------------------------------- diff --git a/lib/dialyzer/src/Makefile b/lib/dialyzer/src/Makefile index ffdc0c6dcd..2521a866f3 100644 --- a/lib/dialyzer/src/Makefile +++ b/lib/dialyzer/src/Makefile @@ -48,6 +48,7 @@ DIALYZER_DIR = $(ERL_TOP)/lib/dialyzer MODULES = \ dialyzer \ dialyzer_analysis_callgraph \ + dialyzer_behaviours \ dialyzer_callgraph \ dialyzer_cl \ dialyzer_cl_parse \ @@ -128,6 +129,7 @@ $(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk $(EBIN)/dialyzer.beam: dialyzer.hrl $(EBIN)/dialyzer_analysis_callgraph.beam: dialyzer.hrl $(EBIN)/dialyzer_callgraph.beam: dialyzer.hrl +$(EBIN)/dialyzer_behaviours.beam: dialyzer.hrl $(EBIN)/dialyzer_cl.beam: dialyzer.hrl ../../kernel/include/file.hrl $(EBIN)/dialyzer_cl_parse.beam: dialyzer.hrl $(EBIN)/dialyzer_codeserver.beam: dialyzer.hrl diff --git a/lib/dialyzer/src/dialyzer.app.src b/lib/dialyzer/src/dialyzer.app.src index c1d109812c..bd8b79bf21 100644 --- a/lib/dialyzer/src/dialyzer.app.src +++ b/lib/dialyzer/src/dialyzer.app.src @@ -23,6 +23,7 @@ {vsn, "%VSN%"}, {modules, [dialyzer, dialyzer_analysis_callgraph, + dialyzer_behaviours, dialyzer_callgraph, dialyzer_cl, dialyzer_cl_parse, @@ -30,7 +31,9 @@ dialyzer_contracts, dialyzer_dataflow, dialyzer_dep, + dialyzer_explanation, dialyzer_gui, + dialyzer_gui_wx, dialyzer_options, dialyzer_plt, dialyzer_races, @@ -38,5 +41,5 @@ dialyzer_typesig, dialyzer_utils]}, {registered, []}, - {applications, [compiler, gs, hipe, kernel, stdlib]}, + {applications, [compiler, gs, hipe, kernel, stdlib, wx]}, {env, []}]}. diff --git a/lib/dialyzer/src/dialyzer.erl b/lib/dialyzer/src/dialyzer.erl index c1897ed892..95955db7e9 100644 --- a/lib/dialyzer/src/dialyzer.erl +++ b/lib/dialyzer/src/dialyzer.erl @@ -379,7 +379,7 @@ message_to_string({spec_missing_fun, [M, F, A]}) -> [M, F, A]); %%----- Warnings for opaque type violations ------------------- message_to_string({call_with_opaque, [M, F, Args, ArgNs, ExpArgs]}) -> - io_lib:format("The call ~w:~w~s contains ~s when ~s\n", + io_lib:format("The call ~w:~w~s contains ~s argument when ~s\n", [M, F, Args, form_positions(ArgNs), form_expected(ExpArgs)]); message_to_string({call_without_opaque, [M, F, Args, ExpectedTriples]}) -> io_lib:format("The call ~w:~w~s does not have ~s\n", @@ -403,8 +403,25 @@ 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]); %%----- 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]). - + io_lib:format("The call ~w:~w~s ~s\n", [M, F, Args, Reason]); +%%----- Warnings for behaviour errors -------------------- +message_to_string({callback_type_mismatch, [B, F, A, O]}) -> + io_lib:format("The inferred return type of the ~w/~w callback includes the" + " type ~s which is not a valid return for the ~w behaviour\n", + [F, A, erl_types:t_to_string(O), B]); +message_to_string({callback_arg_type_mismatch, [B, F, A, N, O]}) -> + io_lib:format("The inferred type of the ~s argument of ~w/~w callback" + " includes the type ~s which is not valid for the ~w behaviour" + "\n", [ordinal(N), F, A, erl_types:t_to_string(O), B]); +message_to_string({callback_missing, [B, F, A]}) -> + io_lib:format("Undefined callback function ~w/~w (behaviour '~w')\n", + [F, A, B]); +message_to_string({invalid_spec, [B, F, A, R]}) -> + io_lib:format("The spec for the ~w:~w/~w callback is not correct: ~s\n", + [B, F, A, R]); +message_to_string({spec_missing, [B, F, A]}) -> + io_lib:format("Type info about ~w:~w/~w callback is not available\n", + [B, F, A]). %%----------------------------------------------------------------------------- %% Auxiliary functions below @@ -421,8 +438,8 @@ call_or_apply_to_string(ArgNs, FailReason, SigArgs, SigRet, io_lib:format("will never return since the success typing arguments" " are ~s\n", [SigArgs]); false -> - io_lib:format("will never return since it differs in argument" - " ~s from the success typing arguments: ~s\n", + io_lib:format("will never return since it differs in the ~s argument" + " from the success typing arguments: ~s\n", [PositionString, SigArgs]) end; only_contract -> @@ -431,7 +448,7 @@ call_or_apply_to_string(ArgNs, FailReason, SigArgs, SigRet, %% We do not know which arguments caused the failure io_lib:format("breaks the contract ~s\n", [Contract]); false -> - io_lib:format("breaks the contract ~s in argument ~s\n", + io_lib:format("breaks the contract ~s in the ~s argument\n", [Contract, PositionString]) end; both -> @@ -441,22 +458,26 @@ call_or_apply_to_string(ArgNs, FailReason, SigArgs, SigRet, form_positions(ArgNs) -> case ArgNs of - [_] -> "an opaque term in "; - [_,_|_] -> "opaque terms in " - end ++ form_position_string(ArgNs). + [_] -> "an opaque term as "; + [_,_|_] -> "opaque terms as " + end ++ form_position_string(ArgNs) ++ + case ArgNs of + [_] -> " argument"; + [_,_|_] -> " arguments" + end. %% We know which positions N are to blame; %% the list of triples will never be empty. form_expected_without_opaque([{N, T, TStr}]) -> case erl_types:t_is_opaque(T) of true -> - io_lib:format("an opaque term of type ~s in ", [TStr]); + io_lib:format("an opaque term of type ~s as ", [TStr]); false -> - io_lib:format("a term of type ~s (with opaque subterms) in ", [TStr]) - end ++ form_position_string([N]); + io_lib:format("a term of type ~s (with opaque subterms) as ", [TStr]) + end ++ form_position_string([N]) ++ " argument"; form_expected_without_opaque(ExpectedTriples) -> %% TODO: can do much better here {ArgNs, _Ts, _TStrs} = lists:unzip3(ExpectedTriples), - "opaque terms in " ++ form_position_string(ArgNs). + "opaque terms as " ++ form_position_string(ArgNs) ++ " arguments". form_expected(ExpectedArgs) -> case ExpectedArgs of @@ -472,9 +493,15 @@ form_expected(ExpectedArgs) -> form_position_string(ArgNs) -> case ArgNs of [] -> ""; - [N1] -> io_lib:format("position ~w", [N1]); + [N1] -> ordinal(N1); [_,_|_] -> - " and"++ArgString = lists:flatten([io_lib:format(" and ~w", [N]) - || N <- ArgNs]), - "positions" ++ ArgString + [Last|Prevs] = lists:reverse(ArgNs), + ", " ++ Head = lists:flatten([io_lib:format(", ~s",[ordinal(N)]) || + N <- lists:reverse(Prevs)]), + Head ++ " and " ++ ordinal(Last) end. + +ordinal(1) -> "1st"; +ordinal(2) -> "2nd"; +ordinal(3) -> "3rd"; +ordinal(N) when is_integer(N) -> io_lib:format("~wth",[N]). diff --git a/lib/dialyzer/src/dialyzer.hrl b/lib/dialyzer/src/dialyzer.hrl index f0f9bd25d7..d50b8720f8 100644 --- a/lib/dialyzer/src/dialyzer.hrl +++ b/lib/dialyzer/src/dialyzer.hrl @@ -55,6 +55,7 @@ -define(WARN_CALLGRAPH, warn_callgraph). -define(WARN_UNMATCHED_RETURN, warn_umatched_return). -define(WARN_RACE_CONDITION, warn_race_condition). +-define(WARN_BEHAVIOUR,warn_behaviour). %% %% The following type has double role: @@ -68,7 +69,8 @@ | ?WARN_CONTRACT_TYPES | ?WARN_CONTRACT_SYNTAX | ?WARN_CONTRACT_NOT_EQUAL | ?WARN_CONTRACT_SUBTYPE | ?WARN_CONTRACT_SUPERTYPE | ?WARN_CALLGRAPH - | ?WARN_UNMATCHED_RETURN | ?WARN_RACE_CONDITION. + | ?WARN_UNMATCHED_RETURN | ?WARN_RACE_CONDITION + | ?WARN_BEHAVIOUR. %% %% This is the representation of each warning as they will be returned @@ -118,6 +120,7 @@ plt :: dialyzer_plt:plt(), use_contracts = true :: boolean(), race_detection = false :: boolean(), + behaviours_chk = false :: boolean(), callgraph_file = "" :: file:filename()}). -record(options, {files = [] :: [file:filename()], diff --git a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl index 97d63a1f14..db62dcebac 100644 --- a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl +++ b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl @@ -43,7 +43,8 @@ parent :: pid(), plt :: dialyzer_plt:plt(), start_from = byte_code :: start_from(), - use_contracts = true :: boolean() + use_contracts = true :: boolean(), + behaviours = {false,[]} :: {boolean(),[atom()]} }). -record(server_state, {parent :: pid(), legal_warnings :: [dial_warn_tag()]}). @@ -56,7 +57,9 @@ start(Parent, LegalWarnings, Analysis) -> RacesOn = ordsets:is_element(?WARN_RACE_CONDITION, LegalWarnings), - Analysis0 = Analysis#analysis{race_detection = RacesOn}, + BehavOn = ordsets:is_element(?WARN_BEHAVIOUR, LegalWarnings), + Analysis0 = Analysis#analysis{race_detection = RacesOn, + behaviours_chk = BehavOn}, Analysis1 = expand_files(Analysis0), Analysis2 = run_analysis(Analysis1), State = #server_state{parent = Parent, legal_warnings = LegalWarnings}, @@ -93,6 +96,9 @@ loop(#server_state{parent = Parent, legal_warnings = LegalWarnings} = State, end; {AnalPid, ext_calls, NewExtCalls} -> loop(State, Analysis, NewExtCalls); + {AnalPid, unknown_behaviours, UnknownBehaviour} -> + send_unknown_behaviours(Parent, UnknownBehaviour), + loop(State, Analysis, ExtCalls); {AnalPid, mod_deps, ModDeps} -> send_mod_deps(Parent, ModDeps), loop(State, Analysis, ExtCalls); @@ -116,7 +122,9 @@ analysis_start(Parent, Analysis) -> plt = Plt, parent = Parent, start_from = Analysis#analysis.start_from, - use_contracts = Analysis#analysis.use_contracts + use_contracts = Analysis#analysis.use_contracts, + behaviours = {Analysis#analysis.behaviours_chk, + []} }, Files = ordsets:from_list(Analysis#analysis.files), {Callgraph, NoWarn, TmpCServer0} = compile_and_store(Files, State), @@ -167,11 +175,13 @@ analyze_callgraph(Callgraph, State) -> State#analysis_state{plt = NewPlt}; succ_typings -> NoWarn = State#analysis_state.no_warn_unused, + {BehavioursChk, _Known} = State#analysis_state.behaviours, DocPlt = State#analysis_state.doc_plt, Callgraph1 = dialyzer_callgraph:finalize(Callgraph), {Warnings, NewPlt, NewDocPlt} = dialyzer_succ_typings:get_warnings(Callgraph1, Plt, DocPlt, - Codeserver, NoWarn, Parent), + Codeserver, NoWarn, Parent, + BehavioursChk), dialyzer_callgraph:delete(Callgraph1), send_warnings(State#analysis_state.parent, Warnings), State#analysis_state{plt = NewPlt, doc_plt = NewDocPlt} @@ -186,7 +196,9 @@ compile_and_store(Files, #analysis_state{codeserver = CServer, include_dirs = Dirs, parent = Parent, use_contracts = UseContracts, - start_from = StartFrom} = State) -> + start_from = StartFrom, + behaviours = {BehChk, _} + } = State) -> send_log(Parent, "Reading files and computing callgraph... "), {T1, _} = statistics(runtime), Includes = [{i, D} || D <- Dirs], @@ -234,18 +246,37 @@ compile_and_store(Files, #analysis_state{codeserver = CServer, {T2, _} = statistics(runtime), Msg1 = io_lib:format("done in ~.2f secs\nRemoving edges... ", [(T2-T1)/1000]), send_log(Parent, Msg1), - NewCallgraph2 = cleanup_callgraph(State, NewCServer, NewCallgraph1, Modules), + {KnownBehaviours, UnknownBehaviours} = + dialyzer_behaviours:get_behaviours(Modules, NewCServer), + if UnknownBehaviours =:= [] -> ok; + true -> send_unknown_behaviours(Parent, UnknownBehaviours) + end, + State1 = State#analysis_state{behaviours = {BehChk,KnownBehaviours}}, + NewCallgraph2 = cleanup_callgraph(State1, NewCServer, NewCallgraph1, Modules), {T3, _} = statistics(runtime), Msg2 = io_lib:format("done in ~.2f secs\n", [(T3-T2)/1000]), send_log(Parent, Msg2), {NewCallgraph2, sets:from_list(NoWarn), NewCServer}. cleanup_callgraph(#analysis_state{plt = InitPlt, parent = Parent, - codeserver = CodeServer}, + codeserver = CodeServer, + behaviours = {BehChk, KnownBehaviours} + }, CServer, Callgraph, Modules) -> ModuleDeps = dialyzer_callgraph:module_deps(Callgraph), send_mod_deps(Parent, ModuleDeps), {Callgraph1, ExtCalls} = dialyzer_callgraph:remove_external(Callgraph), + if BehChk -> + RelevantAPICalls = + dialyzer_behaviours:get_behaviour_apis(KnownBehaviours), + BehaviourAPICalls = [Call || {_From, To} = Call <- ExtCalls, + lists:member(To, RelevantAPICalls)], + Callgraph2 = + dialyzer_callgraph:put_behaviour_api_calls(BehaviourAPICalls, + Callgraph1); + true -> + Callgraph2 = Callgraph1 + end, ExtCalls1 = [Call || Call = {_From, To} <- ExtCalls, not dialyzer_plt:contains_mfa(InitPlt, To)], {BadCalls1, RealExtCalls} = @@ -268,7 +299,7 @@ cleanup_callgraph(#analysis_state{plt = InitPlt, parent = Parent, true -> send_ext_calls(Parent, lists:usort([To || {_From, To} <- RealExtCalls])) end, - Callgraph1. + Callgraph2. compile_src(File, Includes, Defines, Callgraph, CServer, UseContracts) -> DefaultIncludes = default_includes(filename:dirname(File)), @@ -445,6 +476,10 @@ send_ext_calls(Parent, ExtCalls) -> Parent ! {self(), ext_calls, ExtCalls}, ok. +send_unknown_behaviours(Parent, UnknownBehaviours) -> + Parent ! {self(), unknown_behaviours, UnknownBehaviours}, + ok. + send_codeserver_plt(Parent, CServer, Plt ) -> Parent ! {self(), cserver, CServer, Plt}, ok. diff --git a/lib/dialyzer/src/dialyzer_behaviours.erl b/lib/dialyzer/src/dialyzer_behaviours.erl new file mode 100644 index 0000000000..61cdcf27c0 --- /dev/null +++ b/lib/dialyzer/src/dialyzer_behaviours.erl @@ -0,0 +1,324 @@ +%% -*- erlang-indent-level: 2 -*- +%%----------------------------------------------------------------------- +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2006-2009. 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% +%% + +%%%------------------------------------------------------------------- +%%% File : dialyzer_behaviours.erl +%%% Authors : Stavros Aronis <[email protected]> +%%% Description : Tools for analyzing proper behaviour usage. +%%% +%%% Created : 28 Oct 2009 by Stavros Aronis <[email protected]> +%%%------------------------------------------------------------------- +%%% NOTE: This module is currently experimental -- do NOT rely on it! +%%%------------------------------------------------------------------- + +-module(dialyzer_behaviours). + +-export([check_callbacks/4, get_behaviours/2, get_behaviour_apis/1, + translate_behaviour_api_call/5, translatable_behaviours/1, + translate_callgraph/3]). + +%%-------------------------------------------------------------------- + +-include("dialyzer.hrl"). + +%%-------------------------------------------------------------------- + +-record(state, {plt :: dialyzer_plt:plt(), + codeserver :: dialyzer_codeserver:codeserver(), + filename :: string(), + behlines :: [{atom(), number()}]}). + +-spec get_behaviours([module()], dialyzer_codeserver:codeserver()) -> + {[atom()], [atom()]}. + +get_behaviours(Modules, Codeserver) -> + get_behaviours(Modules, Codeserver, [], []). + +-spec check_callbacks(module(), [{cerl:cerl(), cerl:cerl()}], + dialyzer_plt:plt(), + dialyzer_codeserver:codeserver()) -> [dial_warning()]. + +check_callbacks(Module, Attrs, Plt, Codeserver) -> + {Behaviours, BehLines} = get_behaviours(Attrs), + case Behaviours of + [] -> []; + _ -> {_Var,Code} = + dialyzer_codeserver:lookup_mfa_code({Module,module_info,0}, + Codeserver), + File = get_file(cerl:get_ann(Code)), + State = #state{plt = Plt, codeserver = Codeserver, filename = File, + behlines = BehLines}, + Warnings = get_warnings(Module, Behaviours, State), + [add_tag_file_line(Module, W, State) || W <- Warnings] + end. + +-spec translatable_behaviours(cerl:c_module()) -> [{atom(),[_]}]. + +translatable_behaviours(Tree) -> + Attrs = cerl:module_attrs(Tree), + {Behaviours, _BehLines} = get_behaviours(Attrs), + [{B, Calls} || B <- Behaviours, (Calls = behaviour_api_calls(B)) =/= []]. + +-spec get_behaviour_apis([atom()]) -> [mfa()]. + +get_behaviour_apis(Behaviours) -> + get_behaviour_apis(Behaviours, []). + +-spec translate_behaviour_api_call(_, _, _, _, _) -> _. + +translate_behaviour_api_call(_Fun, _ArgTypes, _Args, _Module, []) -> + plain_call; +translate_behaviour_api_call({Module, Fun, Arity}, ArgTypes, Args, + CallbackModule, BehApiInfo) -> + case lists:keyfind(Module, 1, BehApiInfo) of + false -> plain_call; + {Module, Calls} -> + case lists:keyfind({Fun, Arity}, 1, Calls) of + false -> plain_call; + {{Fun, Arity}, {CFun, CArity, COrder}} -> + {{CallbackModule, CFun, CArity}, + [nth_or_0(N, ArgTypes, erl_types:t_any()) || N <-COrder], + [nth_or_0(N, Args, bypassed) || N <-COrder]} + end + end; +translate_behaviour_api_call(_Fun, _ArgTypes, _Args, _Module, _BehApiInfo) -> + plain_call. + +-spec translate_callgraph([{atom(), _}], atom(), dialyzer_callgraph:callgraph()) + -> dialyzer_callgraph:callgraph(). + +translate_callgraph([{Behaviour,_}|Behaviours], Module, Callgraph) -> + UsedCalls = [Call || {_From, {M, _F, _A}} = Call <- + dialyzer_callgraph:get_behaviour_api_calls(Callgraph), + M =:= Behaviour], + Calls = [{{Behaviour, API, Arity}, Callback} || + {{API, Arity}, Callback} <- behaviour_api_calls(Behaviour)], + DirectCalls = [{From, {Module, Fun, Arity}} || + {From, To} <- UsedCalls,{API, {Fun, Arity, _Ord}} <- Calls, + To =:= API], + NewCallgraph = dialyzer_callgraph:add_edges(DirectCalls, Callgraph), + translate_callgraph(Behaviours, Module, NewCallgraph); +translate_callgraph([], _Module, Callgraph) -> + Callgraph. + +%%-------------------------------------------------------------------- + +get_behaviours(Attrs) -> + BehaviourListsAndLine = [{cerl:concrete(L2), hd(cerl:get_ann(L2))} || + {L1, L2} <- Attrs, cerl:is_literal(L1), + cerl:is_literal(L2), cerl:concrete(L1) =:= 'behaviour'], + Behaviours = lists:append([Behs || {Behs,_} <- BehaviourListsAndLine]), + BehLines = [{B,L} || {L1,L} <- BehaviourListsAndLine, B <- L1], + {Behaviours, BehLines}. + +get_warnings(Module, Behaviours, State) -> + get_warnings(Module, Behaviours, State, []). + +get_warnings(_, [], _, Acc) -> + Acc; +get_warnings(Module, [Behaviour|Rest], State, Acc) -> + Warnings = check_behaviour(Module, Behaviour, State), + get_warnings(Module, Rest, State, Warnings ++ Acc). + +check_behaviour(Module, Behaviour, State) -> + try + Callbacks = Behaviour:behaviour_info(callbacks), + Fun = fun({_,_,_}) -> true; + (_) -> false + end, + case lists:any(Fun, Callbacks) of + true -> check_all_callbacks(Module, Behaviour, Callbacks, State); + false -> [] + end + catch + _:_ -> [] + end. + +check_all_callbacks(Module, Behaviour, Callbacks, State) -> + check_all_callbacks(Module, Behaviour, Callbacks, State, []). + +check_all_callbacks(_Module, _Behaviour, [], _State, Acc) -> + Acc; +check_all_callbacks(Module, Behaviour, [{Fun, Arity, Spec}|Rest], State, Acc) -> + Records = dialyzer_codeserver:get_records(State#state.codeserver), + case parse_spec(Spec, Records) of + {ok, Fun, Type} -> + RetType = erl_types:t_fun_range(Type), + ArgTypes = erl_types:t_fun_args(Type), + Warns = check_callback(Module, Behaviour, Fun, Arity, RetType, + ArgTypes, State#state.plt); + Else -> + Warns = [{invalid_spec, [Behaviour, Fun, Arity, reason_spec_error(Else)]}] + end, + check_all_callbacks(Module, Behaviour, Rest, State, Warns ++ Acc); +check_all_callbacks(Module, Behaviour, [{Fun, Arity}|Rest], State, Acc) -> + Warns = {spec_missing, [Behaviour, Fun, Arity]}, + check_all_callbacks(Module, Behaviour, Rest, State, [Warns|Acc]). + +parse_spec(String, Records) -> + case erl_scan:string(String) of + {ok, Tokens, _} -> + case erl_parse:parse(Tokens) of + {ok, Form} -> + case Form of + {attribute, _, 'spec', {{Fun, _}, [TypeForm|_Constraint]}} -> + MaybeRemoteType = erl_types:t_from_form(TypeForm), + try + Type = erl_types:t_solve_remote(MaybeRemoteType, Records), + {ok, Fun, Type} + catch + throw:{error,Msg} -> {spec_remote_error, Msg} + end; + _Other -> not_a_spec + end; + {error, {Line, _, Msg}} -> {spec_parser_error, Line, Msg} + end; + _Other -> + lexer_error + end. + +reason_spec_error({spec_remote_error, Msg}) -> + io_lib:format("Remote type solver error: ~s. Make sure the behaviour source is included in the analysis or the plt",[Msg]); +reason_spec_error(not_a_spec) -> + "This is not a spec"; +reason_spec_error({spec_parser_error, Line, Msg}) -> + io_lib:format("~s line of the spec: ~s", [ordinal(Line),Msg]); +reason_spec_error(lexer_error) -> + "Lexical error". + +ordinal(1) -> "1st"; +ordinal(2) -> "2nd"; +ordinal(3) -> "3rd"; +ordinal(N) when is_integer(N) -> io_lib:format("~wth",[N]). + +check_callback(Module, Behaviour, Fun, Arity, XRetType, XArgTypes, Plt) -> + LookupType = dialyzer_plt:lookup(Plt, {Module, Fun, Arity}), + case LookupType of + {value, {Type,Args}} -> + Warn1 = case unifiable(Type, XRetType) of + [] -> []; + Offenders -> + [{callback_type_mismatch, + [Behaviour, Fun, Arity, erl_types:t_sup(Offenders)]}] + end, + ZipArgs = lists:zip3(lists:seq(1, Arity), Args, XArgTypes), + Warn2 = [{callback_arg_type_mismatch, + [Behaviour, Fun, Arity, N, + erl_types:t_sup(Offenders)]} || + {Offenders, N} <- [check_callback_1(V) || V <- ZipArgs], + Offenders =/= []], + Warn1 ++ Warn2; + _ -> [{callback_missing, [Behaviour, Fun, Arity]}] + end. + +check_callback_1({N, T1, T2}) -> + {unifiable(T1, T2), N}. + +unifiable(Type1, Type2) -> + List1 = erl_types:t_elements(Type1), + List2 = erl_types:t_elements(Type2), + [T || T <- List1, + lists:all(fun(T1) -> + erl_types:t_is_none(erl_types:t_inf(T, T1, opaque)) + end, List2)]. + +add_tag_file_line(_Module, {Tag, [B|_R]} = Warn, State) + when Tag =:= spec_missing; + Tag =:= invalid_spec; + Tag =:= callback_missing -> + {B, Line} = lists:keyfind(B, 1, State#state.behlines), + {?WARN_BEHAVIOUR, {State#state.filename, Line}, Warn}; +add_tag_file_line(Module, {_Tag, [_B, Fun, Arity|_R]} = Warn, State) -> + {_A, FunCode} = + dialyzer_codeserver:lookup_mfa_code({Module, Fun, Arity}, + State#state.codeserver), + Anns = cerl:get_ann(FunCode), + FileLine = {get_file(Anns), get_line(Anns)}, + {?WARN_BEHAVIOUR, FileLine, Warn}. + +get_line([Line|_]) when is_integer(Line) -> Line; +get_line([_|Tail]) -> get_line(Tail); +get_line([]) -> -1. + +get_file([{file, File}|_]) -> File; +get_file([_|Tail]) -> get_file(Tail). + +%%------------------------------------------------------------------------------ + +get_behaviours([], _Codeserver, KnownAcc, UnknownAcc) -> + {KnownAcc, UnknownAcc}; +get_behaviours([M|Rest], Codeserver, KnownAcc, UnknownAcc) -> + Tree = dialyzer_codeserver:lookup_mod_code(M, Codeserver), + Attrs = cerl:module_attrs(Tree), + {Behaviours, _BehLines} = get_behaviours(Attrs), + {Known, Unknown} = call_behaviours(Behaviours), + get_behaviours(Rest, Codeserver, Known ++ KnownAcc, Unknown ++ UnknownAcc). + +call_behaviours(Behaviours) -> + call_behaviours(Behaviours, [], []). +call_behaviours([], KnownAcc, UnknownAcc) -> + {lists:reverse(KnownAcc), lists:reverse(UnknownAcc)}; +call_behaviours([Behaviour|Rest], KnownAcc, UnknownAcc) -> + try + Callbacks = Behaviour:behaviour_info(callbacks), + Fun = fun({_,_,_}) -> true; + (_) -> false + end, + case lists:any(Fun, Callbacks) of + false -> call_behaviours(Rest, KnownAcc, [Behaviour | UnknownAcc]); + true -> call_behaviours(Rest, [Behaviour | KnownAcc], UnknownAcc) + end + catch + _:_ -> call_behaviours(Rest, KnownAcc, [Behaviour | UnknownAcc]) + end. + +%------------------------------------------------------------------------------- + +get_behaviour_apis([], Acc) -> + Acc; +get_behaviour_apis([Behaviour | Rest], Acc) -> + MFAs = [{Behaviour, Fun, Arity} || + {{Fun, Arity}, _} <- behaviour_api_calls(Behaviour)], + get_behaviour_apis(Rest, MFAs ++ Acc). + +%------------------------------------------------------------------------------- + +nth_or_0(0, _List, Zero) -> + Zero; +nth_or_0(N, List, _Zero) -> + lists:nth(N, List). + +%------------------------------------------------------------------------------- + +behaviour_api_calls(gen_server) -> + [{{start_link, 3}, {init, 1, [2]}}, + {{start_link, 4}, {init, 1, [3]}}, + {{start, 3}, {init, 1, [2]}}, + {{start, 4}, {init, 1, [3]}}, + {{call, 2}, {handle_call, 3, [2, 0, 0]}}, + {{call, 3}, {handle_call, 3, [2, 0, 0]}}, + {{multi_call, 2}, {handle_call, 3, [2, 0, 0]}}, + {{multi_call, 3}, {handle_call, 3, [3, 0, 0]}}, + {{multi_call, 4}, {handle_call, 3, [3, 0, 0]}}, + {{cast, 2}, {handle_cast, 2, [2, 0]}}, + {{abcast, 2}, {handle_cast, 2, [2, 0]}}, + {{abcast, 3}, {handle_cast, 2, [3, 0]}}]; +behaviour_api_calls(_Other) -> + []. diff --git a/lib/dialyzer/src/dialyzer_callgraph.erl b/lib/dialyzer/src/dialyzer_callgraph.erl index 21d31df71c..1f79e16449 100644 --- a/lib/dialyzer/src/dialyzer_callgraph.erl +++ b/lib/dialyzer/src/dialyzer_callgraph.erl @@ -27,7 +27,8 @@ %%%------------------------------------------------------------------- -module(dialyzer_callgraph). --export([all_nodes/1, +-export([add_edges/2, + all_nodes/1, delete/1, finalize/1, is_escaping/2, @@ -55,7 +56,8 @@ -export([cleanup/1, get_digraph/1, get_named_tables/1, get_public_tables/1, get_race_code/1, get_race_detection/1, race_code_new/1, put_race_code/2, put_race_detection/2, put_named_tables/2, - put_public_tables/2]). + put_public_tables/2, put_behaviour_api_calls/2, + get_behaviour_api_calls/1]). -include("dialyzer.hrl"). @@ -97,7 +99,8 @@ race_code = dict:new() :: dict(), public_tables = [] :: [label()], named_tables = [] :: [string()], - race_detection = false :: boolean()}). + race_detection = false :: boolean(), + beh_api_calls = [] :: [{mfa(), mfa()}]}). %% Exported Types @@ -695,3 +698,15 @@ to_ps(#callgraph{} = CG, File, Args) -> Command = io_lib:format("dot -Tps ~s -o ~s ~s", [Args, File, Dot_File]), _ = os:cmd(Command), ok. + +%------------------------------------------------------------------------------- + +-spec put_behaviour_api_calls([{mfa(), mfa()}], callgraph()) -> callgraph(). + +put_behaviour_api_calls(Calls, Callgraph) -> + Callgraph#callgraph{beh_api_calls = Calls}. + +-spec get_behaviour_api_calls(callgraph()) -> [{mfa(), mfa()}]. + +get_behaviour_api_calls(Callgraph) -> + Callgraph#callgraph.beh_api_calls. diff --git a/lib/dialyzer/src/dialyzer_cl.erl b/lib/dialyzer/src/dialyzer_cl.erl index ab56a4e6d3..724383d06a 100644 --- a/lib/dialyzer/src/dialyzer_cl.erl +++ b/lib/dialyzer/src/dialyzer_cl.erl @@ -46,7 +46,8 @@ plt_info = none :: 'none' | dialyzer_plt:plt_info(), report_mode = normal :: rep_mode(), return_status= ?RET_NOTHING_SUSPICIOUS :: dial_ret(), - stored_warnings = [] :: [dial_warning()] + stored_warnings = [] :: [dial_warning()], + unknown_behaviours = [] :: [atom()] }). %%-------------------------------------------------------------------- @@ -440,7 +441,9 @@ expand_dependent_modules_1([], Included, _ModDeps) -> -spec hipe_compile([file:filename()], #options{}) -> 'ok'. hipe_compile(Files, #options{erlang_mode = ErlangMode} = Options) -> - case (length(Files) < ?MIN_FILES_FOR_NATIVE_COMPILE) orelse ErlangMode of + NoNative = (get(dialyzer_options_native) =:= false), + FewFiles = (length(Files) < ?MIN_FILES_FOR_NATIVE_COMPILE), + case NoNative orelse FewFiles orelse ErlangMode of true -> ok; false -> case erlang:system_info(hipe_architecture) of @@ -528,6 +531,9 @@ cl_loop(State, LogCache) -> {BackendPid, warnings, Warnings} -> NewState = store_warnings(State, Warnings), cl_loop(NewState, LogCache); + {BackendPid, unknown_behaviours, Behaviours} -> + NewState = store_unknown_behaviours(State, Behaviours), + cl_loop(NewState, LogCache); {BackendPid, done, NewPlt, _NewDocPlt} -> return_value(State, NewPlt); {BackendPid, ext_calls, ExtCalls} -> @@ -568,6 +574,11 @@ format_log_cache(LogCache) -> store_warnings(#cl_state{stored_warnings = StoredWarnings} = St, Warnings) -> St#cl_state{stored_warnings = StoredWarnings ++ Warnings}. +-spec store_unknown_behaviours(#cl_state{}, [_]) -> #cl_state{}. + +store_unknown_behaviours(#cl_state{unknown_behaviours = Behs} = St, Beh) -> + St#cl_state{unknown_behaviours = Beh ++ Behs}. + -spec error(string()) -> no_return(). error(Msg) -> @@ -602,6 +613,7 @@ return_value(State = #cl_state{erlang_mode = ErlangMode, false -> print_warnings(State), print_ext_calls(State), + print_unknown_behaviours(State), maybe_close_output_file(State), {RetValue, []}; true -> @@ -637,6 +649,40 @@ do_print_ext_calls(Output, [{M,F,A}|T], Before) -> do_print_ext_calls(_, [], _) -> ok. +%%print_unknown_behaviours(#cl_state{report_mode = quiet}) -> +%% ok; +print_unknown_behaviours(#cl_state{output = Output, + external_calls = Calls, + stored_warnings = Warnings, + unknown_behaviours = DupBehaviours, + legal_warnings = LegalWarnings, + output_format = Format}) -> + case ordsets:is_element(?WARN_BEHAVIOUR, LegalWarnings) + andalso DupBehaviours =/= [] of + false -> ok; + true -> + Behaviours = lists:usort(DupBehaviours), + case Warnings =:= [] andalso Calls =:= [] of + true -> io:nl(Output); %% Need to do a newline first + false -> ok + end, + case Format of + formatted -> + io:put_chars(Output, "Unknown behaviours (behaviour_info(callbacks)" + " does not return any specs):\n"), + do_print_unknown_behaviours(Output, Behaviours, " "); + raw -> + io:put_chars(Output, "%% Unknown behaviours:\n"), + do_print_unknown_behaviours(Output, Behaviours, "%% ") + end + end. + +do_print_unknown_behaviours(Output, [B|T], Before) -> + io:format(Output, "~s~p\n", [Before,B]), + do_print_unknown_behaviours(Output, T, Before); +do_print_unknown_behaviours(_, [], _) -> + ok. + print_warnings(#cl_state{stored_warnings = []}) -> ok; print_warnings(#cl_state{output = Output, diff --git a/lib/dialyzer/src/dialyzer_cl_parse.erl b/lib/dialyzer/src/dialyzer_cl_parse.erl index ae466e5c01..1f0da012d6 100644 --- a/lib/dialyzer/src/dialyzer_cl_parse.erl +++ b/lib/dialyzer/src/dialyzer_cl_parse.erl @@ -68,6 +68,11 @@ cl(["-n"|T]) -> cl(["--no_check_plt"|T]) -> put(dialyzer_options_check_plt, false), cl(T); +cl(["-nn"|T]) -> + cl(["--no_native"|T]); +cl(["--no_native"|T]) -> + put(dialyzer_options_native, false), + cl(T); cl(["--plt_info"|T]) -> put(dialyzer_options_analysis_type, plt_info), cl(T); @@ -181,7 +186,7 @@ cl([H|_] = L) -> NewTail = command_line(L), cl(NewTail); false -> - error("Unknown option: "++H) + error("Unknown option: " ++ H) end; cl([]) -> {RetTag, Opts} = @@ -191,7 +196,7 @@ cl([]) -> {plt_info, cl_options()}; false -> case get(dialyzer_options_mode) of - {gui,_} = GUI -> {GUI, common_options()}; + {gui, _} = GUI -> {GUI, common_options()}; cl -> case get(dialyzer_options_analysis_type) =:= plt_check of true -> {check_init, cl_options()}; @@ -311,17 +316,27 @@ help_message() -> S = "Usage: dialyzer [--help] [--version] [--shell] [--quiet] [--verbose] [-pa dir]* [--plt plt] [-Ddefine]* [-I include_dir]* [--output_plt file] [-Wwarn]* [--src] [--gui | --wx] - [-c applications] [-r applications] [-o outfile] + [files_or_dirs] [-r dirs] [--apps applications] [-o outfile] [--build_plt] [--add_to_plt] [--remove_from_plt] - [--check_plt] [--no_check_plt] [--plt_info] [--get_warnings] -Options: - -c applications (or --command-line applications) - Use Dialyzer from the command line (no GUI) to detect defects in the - specified applications (directories or .erl or .beam files) - -r applications - Same as -c only that directories are searched recursively for - subdirectories containing .erl or .beam files (depending on the - type of analysis) + [--check_plt] [--no_check_plt] [--plt_info] [--get_warnings] + [--no_native] +Options: + files_or_dirs (for backwards compatibility also as: -c files_or_dirs) + Use Dialyzer from the command line to detect defects in the + specified files or directories containing .erl or .beam files, + depending on the type of the analysis + -r dirs + Same as the previous but the specified directories are searched + recursively for subdirectories containing .erl or .beam files in + them, depending on the type of analysis + --apps applications + Option typically used when building or modifying a PLT as in: + dialyzer --build_plt --apps erts kernel stdlib mnesia ... + to conveniently refer to library applications corresponding to the + Erlang/OTP installation. However, the option is general and can also + be used during analysis in order to refer to Erlang/OTP applications. + In addition, file or directory names can also be included, as in: + dialyzer --apps inets ssl ./ebin ../other_lib/ebin/my_module.beam -o outfile (or --output outfile) When using Dialyzer from the command line, send the analysis results to the specified \"outfile\" rather than to stdout @@ -389,6 +404,10 @@ Options: by the file name extension. Supported extensions are: raw, dot, and ps. If something else is used as file name extension, default format '.raw' will be used. + --no_native (or -nn) + Bypass the native code compilation of some key files that dialyzer + heuristically performs when dialyzing many files; this avoids the + compilation time but it may result in (much) longer analysis time. --gui Use the gs-based GUI. --wx @@ -432,6 +451,9 @@ warning_options_msg() -> Include warnings for functions that only return by means of an exception. -Wrace_conditions *** Include warnings for possible race conditions. + -Wbehaviours *** + Include warnings about behaviour callbacks which drift from the published + recommended interfaces. -Wunderspecs *** Warn about underspecified functions (those whose -spec is strictly more allowing than the success typing). diff --git a/lib/dialyzer/src/dialyzer_codeserver.erl b/lib/dialyzer/src/dialyzer_codeserver.erl index 624501fc49..3b4b66cb68 100644 --- a/lib/dialyzer/src/dialyzer_codeserver.erl +++ b/lib/dialyzer/src/dialyzer_codeserver.erl @@ -56,83 +56,83 @@ %%-------------------------------------------------------------------- --record(dialyzer_codeserver, {table_pid :: pid(), - exports = sets:new() :: set(), % set(mfa()) - next_core_label = 0 :: label(), - records = dict:new() :: dict(), - temp_records = dict:new() :: dict(), - contracts = dict:new() :: dict(), - temp_contracts = dict:new() :: dict()}). +-record(codeserver, {table_pid :: pid(), + exports = sets:new() :: set(), % set(mfa()) + next_core_label = 0 :: label(), + records = dict:new() :: dict(), + temp_records = dict:new() :: dict(), + contracts = dict:new() :: dict(), + temp_contracts = dict:new() :: dict()}). --opaque codeserver() :: #dialyzer_codeserver{}. +-opaque codeserver() :: #codeserver{}. %%-------------------------------------------------------------------- -spec new() -> codeserver(). new() -> - #dialyzer_codeserver{table_pid = table__new()}. + #codeserver{table_pid = table__new()}. -spec delete(codeserver()) -> 'ok'. -delete(#dialyzer_codeserver{table_pid = TablePid}) -> +delete(#codeserver{table_pid = TablePid}) -> table__delete(TablePid). -spec insert(module(), cerl:c_module(), codeserver()) -> codeserver(). insert(Mod, ModCode, CS) -> - NewTablePid = table__insert(CS#dialyzer_codeserver.table_pid, Mod, ModCode), - CS#dialyzer_codeserver{table_pid = NewTablePid}. + NewTablePid = table__insert(CS#codeserver.table_pid, Mod, ModCode), + CS#codeserver{table_pid = NewTablePid}. -spec insert_exports([mfa()], codeserver()) -> codeserver(). -insert_exports(List, #dialyzer_codeserver{exports = Exports} = CS) -> +insert_exports(List, #codeserver{exports = Exports} = CS) -> Set = sets:from_list(List), NewExports = sets:union(Exports, Set), - CS#dialyzer_codeserver{exports = NewExports}. + CS#codeserver{exports = NewExports}. -spec is_exported(mfa(), codeserver()) -> boolean(). -is_exported(MFA, #dialyzer_codeserver{exports = Exports}) -> +is_exported(MFA, #codeserver{exports = Exports}) -> sets:is_element(MFA, Exports). -spec get_exports(codeserver()) -> set(). % set(mfa()) -get_exports(#dialyzer_codeserver{exports = Exports}) -> +get_exports(#codeserver{exports = Exports}) -> Exports. -spec lookup_mod_code(module(), codeserver()) -> cerl:c_module(). lookup_mod_code(Mod, CS) when is_atom(Mod) -> - table__lookup(CS#dialyzer_codeserver.table_pid, Mod). + table__lookup(CS#codeserver.table_pid, Mod). -spec lookup_mfa_code(mfa(), codeserver()) -> {cerl:c_var(), cerl:c_fun()}. lookup_mfa_code({_M, _F, _A} = MFA, CS) -> - table__lookup(CS#dialyzer_codeserver.table_pid, MFA). + table__lookup(CS#codeserver.table_pid, MFA). -spec get_next_core_label(codeserver()) -> label(). -get_next_core_label(#dialyzer_codeserver{next_core_label = NCL}) -> +get_next_core_label(#codeserver{next_core_label = NCL}) -> NCL. -spec set_next_core_label(label(), codeserver()) -> codeserver(). set_next_core_label(NCL, CS) -> - CS#dialyzer_codeserver{next_core_label = NCL}. + CS#codeserver{next_core_label = NCL}. -spec store_records(module(), dict(), codeserver()) -> codeserver(). -store_records(Mod, Dict, #dialyzer_codeserver{records = RecDict} = CS) +store_records(Mod, Dict, #codeserver{records = RecDict} = CS) when is_atom(Mod) -> case dict:size(Dict) =:= 0 of true -> CS; - false -> CS#dialyzer_codeserver{records = dict:store(Mod, Dict, RecDict)} + false -> CS#codeserver{records = dict:store(Mod, Dict, RecDict)} end. -spec lookup_mod_records(module(), codeserver()) -> dict(). -lookup_mod_records(Mod, #dialyzer_codeserver{records = RecDict}) +lookup_mod_records(Mod, #codeserver{records = RecDict}) when is_atom(Mod) -> case dict:find(Mod, RecDict) of error -> dict:new(); @@ -141,45 +141,44 @@ lookup_mod_records(Mod, #dialyzer_codeserver{records = RecDict}) -spec get_records(codeserver()) -> dict(). -get_records(#dialyzer_codeserver{records = RecDict}) -> +get_records(#codeserver{records = RecDict}) -> RecDict. -spec store_temp_records(module(), dict(), codeserver()) -> codeserver(). -store_temp_records(Mod, Dict, #dialyzer_codeserver{temp_records = TempRecDict} = CS) +store_temp_records(Mod, Dict, #codeserver{temp_records = TempRecDict} = CS) when is_atom(Mod) -> case dict:size(Dict) =:= 0 of true -> CS; - false -> CS#dialyzer_codeserver{temp_records = dict:store(Mod, Dict, TempRecDict)} + false -> CS#codeserver{temp_records = dict:store(Mod, Dict, TempRecDict)} end. -spec get_temp_records(codeserver()) -> dict(). -get_temp_records(#dialyzer_codeserver{temp_records = TempRecDict}) -> +get_temp_records(#codeserver{temp_records = TempRecDict}) -> TempRecDict. -spec set_temp_records(dict(), codeserver()) -> codeserver(). set_temp_records(Dict, CS) -> - CS#dialyzer_codeserver{temp_records = Dict}. + CS#codeserver{temp_records = Dict}. -spec finalize_records(dict(), codeserver()) -> codeserver(). finalize_records(Dict, CS) -> - CS#dialyzer_codeserver{records = Dict, temp_records = dict:new()}. + CS#codeserver{records = Dict, temp_records = dict:new()}. -spec store_contracts(module(), dict(), codeserver()) -> codeserver(). -store_contracts(Mod, Dict, #dialyzer_codeserver{contracts = C} = CS) - when is_atom(Mod) -> +store_contracts(Mod, Dict, #codeserver{contracts = C} = CS) when is_atom(Mod) -> case dict:size(Dict) =:= 0 of true -> CS; - false -> CS#dialyzer_codeserver{contracts = dict:store(Mod, Dict, C)} + false -> CS#codeserver{contracts = dict:store(Mod, Dict, C)} end. -spec lookup_mod_contracts(module(), codeserver()) -> dict(). -lookup_mod_contracts(Mod, #dialyzer_codeserver{contracts = ContDict}) +lookup_mod_contracts(Mod, #codeserver{contracts = ContDict}) when is_atom(Mod) -> case dict:find(Mod, ContDict) of error -> dict:new(); @@ -189,7 +188,7 @@ lookup_mod_contracts(Mod, #dialyzer_codeserver{contracts = ContDict}) -spec lookup_mfa_contract(mfa(), codeserver()) -> 'error' | {'ok', dialyzer_contracts:file_contract()}. -lookup_mfa_contract({M,_F,_A} = MFA, #dialyzer_codeserver{contracts = ContDict}) -> +lookup_mfa_contract({M,_F,_A} = MFA, #codeserver{contracts = ContDict}) -> case dict:find(M, ContDict) of error -> error; {ok, Dict} -> dict:find(MFA, Dict) @@ -197,27 +196,27 @@ lookup_mfa_contract({M,_F,_A} = MFA, #dialyzer_codeserver{contracts = ContDict}) -spec get_contracts(codeserver()) -> dict(). -get_contracts(#dialyzer_codeserver{contracts = ContDict}) -> +get_contracts(#codeserver{contracts = ContDict}) -> ContDict. -spec store_temp_contracts(module(), dict(), codeserver()) -> codeserver(). -store_temp_contracts(Mod, Dict, #dialyzer_codeserver{temp_contracts = C} = CS) +store_temp_contracts(Mod, Dict, #codeserver{temp_contracts = C} = CS) when is_atom(Mod) -> case dict:size(Dict) =:= 0 of true -> CS; - false -> CS#dialyzer_codeserver{temp_contracts = dict:store(Mod, Dict, C)} + false -> CS#codeserver{temp_contracts = dict:store(Mod, Dict, C)} end. -spec get_temp_contracts(codeserver()) -> dict(). -get_temp_contracts(#dialyzer_codeserver{temp_contracts = TempContDict}) -> +get_temp_contracts(#codeserver{temp_contracts = TempContDict}) -> TempContDict. -spec finalize_contracts(dict(), codeserver()) -> codeserver(). finalize_contracts(Dict, CS) -> - CS#dialyzer_codeserver{contracts = Dict, temp_contracts = dict:new()}. + CS#codeserver{contracts = Dict, temp_contracts = dict:new()}. table__new() -> spawn_link(fun() -> table__loop(none, dict:new()) end). diff --git a/lib/dialyzer/src/dialyzer_contracts.erl b/lib/dialyzer/src/dialyzer_contracts.erl index e2680bb03d..bad0a8d8cd 100644 --- a/lib/dialyzer/src/dialyzer_contracts.erl +++ b/lib/dialyzer/src/dialyzer_contracts.erl @@ -196,9 +196,13 @@ check_contract(#contract{contracts = Contracts}, SuccType) -> ok -> InfList = [erl_types:t_inf(Contract, SuccType, opaque) || Contract <- Contracts2], - check_contract_inf_list(InfList, SuccType) + case check_contract_inf_list(InfList, SuccType) of + {error, _} = Invalid -> Invalid; + ok -> check_extraneous(Contracts2, SuccType) + end end - catch throw:{error, _} = Error -> Error + catch + throw:{error, _} = Error -> Error end. check_domains([_]) -> ok; @@ -233,6 +237,22 @@ check_contract_inf_list([FunType|Left], SuccType) -> check_contract_inf_list([], _SuccType) -> {error, invalid_contract}. +check_extraneous([], _SuccType) -> ok; +check_extraneous([C|Cs], SuccType) -> + case check_extraneous_1(C, SuccType) of + ok -> check_extraneous(Cs, SuccType); + Error -> Error + end. + +check_extraneous_1(Contract, SuccType) -> + CRngs = erl_types:t_elements(erl_types:t_fun_range(Contract)), + STRng = erl_types:t_fun_range(SuccType), + %% io:format("CR = ~p\nSR = ~p\n", [CRngs, STRng]), + case [CR || CR <- CRngs, erl_types:t_is_none(erl_types:t_inf(CR, STRng, opaque))] of + [] -> ok; + CRs -> {error, {extra_range, erl_types:t_sup(CRs), STRng}} + end. + %% This is the heart of the "range function" -spec process_contracts([contract_pair()], [erl_types:erl_type()]) -> erl_types:erl_type(). @@ -411,6 +431,8 @@ get_invalid_contract_warnings_funs([{MFA, {FileLine, Contract}}|Left], case check_contract(Contract, Sig) of {error, invalid_contract} -> [invalid_contract_warning(MFA, FileLine, Sig, RecDict)|Acc]; + {error, {extra_range, ExtraRanges, STRange}} -> + [extra_range_warning(MFA, FileLine, ExtraRanges, STRange)|Acc]; {error, Msg} -> [{?WARN_CONTRACT_SYNTAX, FileLine, Msg}|Acc]; ok -> @@ -442,9 +464,15 @@ get_invalid_contract_warnings_funs([{MFA, {FileLine, Contract}}|Left], get_invalid_contract_warnings_funs([], _Plt, _RecDict, Acc) -> Acc. -invalid_contract_warning({M, F, A}, FileLine, Type, RecDict) -> +invalid_contract_warning({M, F, A}, FileLine, SuccType, RecDict) -> + SuccTypeStr = dialyzer_utils:format_sig(SuccType, RecDict), + {?WARN_CONTRACT_TYPES, FileLine, {invalid_contract, [M, F, A, SuccTypeStr]}}. + +extra_range_warning({M, F, A}, FileLine, ExtraRanges, STRange) -> + ERangesStr = erl_types:t_to_string(ExtraRanges), + STRangeStr = erl_types:t_to_string(STRange), {?WARN_CONTRACT_TYPES, FileLine, - {invalid_contract, [M, F, A, dialyzer_utils:format_sig(Type, RecDict)]}}. + {extra_range, [M, F, A, ERangesStr, STRangeStr]}}. picky_contract_check(CSig0, Sig0, MFA, FileLine, Contract, RecDict, Acc) -> CSig = erl_types:t_abstract_records(CSig0, RecDict), diff --git a/lib/dialyzer/src/dialyzer_dataflow.erl b/lib/dialyzer/src/dialyzer_dataflow.erl index 178321ea18..7fb309497a 100644 --- a/lib/dialyzer/src/dialyzer_dataflow.erl +++ b/lib/dialyzer/src/dialyzer_dataflow.erl @@ -47,7 +47,7 @@ t_cons/0, t_cons/2, t_cons_hd/1, t_cons_tl/1, t_contains_opaque/1, 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/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, @@ -93,11 +93,13 @@ tree_map :: dict(), warning_mode = false :: boolean(), warnings = [] :: [dial_warning()], - work :: {[_], [_], set()}}). + work :: {[_], [_], set()}, + module :: module(), + behaviour_api_info = [] :: [{atom(),[_]}]}). %% Exported Types --type state() :: #state{}. +-opaque state() :: #state{}. %%-------------------------------------------------------------------- @@ -263,10 +265,15 @@ analyze_module(Tree, Plt, Callgraph) -> analyze_module(Tree, Plt, Callgraph, Records, GetWarnings) -> debug_pp(Tree, false), Module = cerl:atom_val(cerl:module_name(Tree)), + RaceDetection = dialyzer_callgraph:get_race_detection(Callgraph), + BehaviourTranslations = + case RaceDetection of + true -> dialyzer_behaviours:translatable_behaviours(Tree); + false -> [] + end, TopFun = cerl:ann_c_fun([{label, top}], [], Tree), - State = - state__new(dialyzer_callgraph:race_code_new(Callgraph), - TopFun, Plt, Module, Records), + State = state__new(dialyzer_callgraph:race_code_new(Callgraph), + TopFun, Plt, Module, Records, BehaviourTranslations), State1 = state__race_analysis(not GetWarnings, State), State2 = analyze_loop(State1), RaceCode = dialyzer_callgraph:get_race_code(Callgraph), @@ -277,7 +284,18 @@ analyze_module(Tree, Plt, Callgraph, Records, GetWarnings) -> State3 = state__set_warning_mode(State2), State4 = analyze_loop(State3), State5 = state__restore_race_code(RaceCode, State4), - dialyzer_races:race(State5); + + %% EXPERIMENTAL: Turn all behaviour API calls into calls to the + %% respective callback module's functions. + + case BehaviourTranslations of + [] -> dialyzer_races:race(State5); + Behaviours -> + TranslatedCallgraph = + dialyzer_behaviours:translate_callgraph(Behaviours, Module, + State5#state.callgraph), + dialyzer_races:race(State5#state{callgraph = TranslatedCallgraph}) + end; false -> state__restore_race_code( dict:merge(fun (_K, V1, _V2) -> V1 end, @@ -567,6 +585,7 @@ 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) -> @@ -585,9 +604,9 @@ handle_apply_or_call([{TypeOfApply, {Fun, Sig, Contr, LocalRet}}|Left], erl_bif_types:type(M, F, A, NewFunArgs) end, {BArgs, BRange}; - false -> GenSig + false -> IsBIF = false, GenSig end; - local -> GenSig + local -> IsBIF = false, GenSig end, {SigArgs, SigRange} = %% if there is hard-coded or contract information with opaque types, @@ -601,18 +620,33 @@ handle_apply_or_call([{TypeOfApply, {Fun, Sig, Contr, LocalRet}}|Left], none -> {AnyArgs, t_any()} end end, - NewArgsSig = t_inf_lists(SigArgs, ArgTypes), - NewArgsContract = t_inf_lists(CArgs, ArgTypes), - NewArgsBif = t_inf_lists(BifArgs, ArgTypes), - NewArgTypes0 = t_inf_lists(NewArgsSig, NewArgsContract), - NewArgTypes = t_inf_lists(NewArgTypes0, NewArgsBif), + 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), - ContrRet = CRange(NewArgTypes), - Mode = case t_contains_opaque(ContrRet) orelse t_contains_opaque(BifRet) of + {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 end, - RetWithoutLocal = t_inf(t_inf(ContrRet, BifRet, Mode), SigRange, Mode), + RetWithoutLocal = t_inf(t_inf(ContrRet, BifRet, RetMode), SigRange, RetMode), ?debug("--------------------------------------------------------\n", []), ?debug("Fun: ~p\n", [Fun]), ?debug("Args: ~s\n", [erl_types:t_to_string(t_product(ArgTypes))]), @@ -623,7 +657,7 @@ handle_apply_or_call([{TypeOfApply, {Fun, Sig, Contr, LocalRet}}|Left], ?debug("NewArgTypes: ~s\n", [erl_types:t_to_string(t_product(NewArgTypes))]), ?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(NewArgTypes))]), + ?debug("ContrRet: ~s\n", [erl_types:t_to_string(CRange(TmpArgTypes))]), ?debug("SigRet: ~s\n", [erl_types:t_to_string(SigRange)]), State1 = case dialyzer_callgraph:get_race_detection(Callgraph) andalso @@ -632,8 +666,21 @@ handle_apply_or_call([{TypeOfApply, {Fun, Sig, Contr, LocalRet}}|Left], Ann = cerl:get_ann(Tree), File = get_file(Ann), Line = abs(get_line(Ann)), - dialyzer_races:store_race_call(Fun, ArgTypes, Args, {File, Line}, - State); + + %% EXPERIMENTAL: Turn a behaviour's API call into a call to the + %% respective callback module's function. + + Module = State#state.module, + BehApiInfo = State#state.behaviour_api_info, + {RealFun, RealArgTypes, RealArgs} = + case dialyzer_behaviours:translate_behaviour_api_call(Fun, ArgTypes, + Args, Module, + BehApiInfo) of + plain_call -> {Fun, ArgTypes, Args}; + BehaviourAPI -> BehaviourAPI + end, + dialyzer_races:store_race_call(RealFun, RealArgTypes, RealArgs, + {File, Line}, State); false -> State end, FailedConj = any_none([RetWithoutLocal|NewArgTypes]), @@ -643,7 +690,7 @@ handle_apply_or_call([{TypeOfApply, {Fun, Sig, Contr, LocalRet}}|Left], case FailedConj andalso not (IsFailBif orelse IsFailSig) of true -> FailedSig = any_none(NewArgsSig), - FailedContract = any_none([CRange(NewArgsContract)|NewArgsContract]), + FailedContract = any_none([CRange(TmpArgsContract)|NewArgsContract]), FailedBif = any_none([BifRange(NewArgsBif)|NewArgsBif]), InfSig = t_inf(t_fun(SigArgs, SigRange), t_fun(BifArgs, BifRange(BifArgs))), @@ -786,8 +833,11 @@ 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), - case t_is_none(Inf) andalso (not any_none(Ts)) + 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 true -> Args = case erl_types:t_is_opaque(T1) of @@ -905,9 +955,9 @@ 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 *atoms* even if - %% they happen to be identical to an atom which is also involved in - %% the definition of an opaque data type + %% 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)), Map2 = enter_type_lists([M, F], [MType, FType], Map1), @@ -936,13 +986,18 @@ handle_call(Tree, Map, State) -> end, {State2, Map2, t_none()}; false -> - %% XXX: Consider doing this for all combinations of MF - case {t_atom_vals(MType), t_atom_vals(FType)} of - {[MAtom], [FAtom]} -> - FunInfo = [{remote, state__fun_info({MAtom, FAtom, length(Args)}, - State1)}], - handle_apply_or_call(FunInfo, Args, As, Map2, Tree, State1); - {_MAtoms, _FAtoms} -> + case t_is_atom(MType) of + true -> + %% XXX: Consider doing this for all combinations of MF + case {t_atom_vals(MType), t_atom_vals(FType)} of + {[MAtom], [FAtom]} -> + FunInfo = [{remote, state__fun_info({MAtom, FAtom, length(Args)}, + State1)}], + handle_apply_or_call(FunInfo, Args, As, Map2, Tree, State1); + {_MAtoms, _FAtoms} -> + {State1, Map2, t_any()} + end; + false -> {State1, Map2, t_any()} end end. @@ -1481,10 +1536,7 @@ bind_pat_vars([Pat|PatLeft], [Type|TypeLeft], Acc, Map, State, Rev) -> Cons = t_inf(Type, t_cons()), case t_is_none(Cons) of true -> - case t_find_opaque_mismatch(t_cons(), Type) of - {ok, T1, T2} -> bind_error([Pat], T1, T2, opaque); - error -> bind_error([Pat], Type, t_none(), bind) - end; + 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)], @@ -1501,18 +1553,7 @@ bind_pat_vars([Pat|PatLeft], [Type|TypeLeft], Acc, Map, State, Rev) -> end, case t_is_none(t_inf(LiteralOrOpaque, Type)) of true -> - case t_find_opaque_mismatch(Literal, Type) of - {ok, T1, T2} -> - case lists:member(T2, State#state.opaques) of - true -> - NewType = erl_types:t_struct_from_opaque(Type, T2), - {Map1, _} = - bind_pat_vars([Pat], [NewType], [], Map, State, Rev), - {Map1, T2}; - false -> bind_error([Pat], T1, T2, opaque) - end; - error -> bind_error([Pat], Type, t_none(), bind) - end; + bind_opaque_pats(Literal, Type, Pat, Map, State, Rev); false -> {Map, LiteralOrOpaque} end; tuple -> @@ -1534,18 +1575,7 @@ bind_pat_vars([Pat|PatLeft], [Type|TypeLeft], Acc, Map, State, Rev) -> Tuple = t_inf(Prototype, Type), case t_is_none(Tuple) of true -> - case t_find_opaque_mismatch(Prototype, Type) of - {ok, T1, T2} -> - case lists:member(T2, State#state.opaques) of - true -> - NewType = erl_types:t_struct_from_opaque(Type, T2), - {Map1, _} = - bind_pat_vars([Pat], [NewType], [], Map, State, Rev), - {Map1, T2}; - false -> bind_error([Pat], T1, T2, opaque) - end; - error -> bind_error([Pat], Type, t_none(), bind) - end; + bind_opaque_pats(Prototype, Type, Pat, Map, State, Rev); false -> SubTuples = t_tuple_subtypes(Tuple), %% Need to call the top function to get the try-catch wrapper @@ -1689,6 +1719,20 @@ bind_bin_segs([], _BinType, Acc, Map, _State) -> bind_error(Pats, Type, OpaqueType, Error) -> throw({error, Error, Pats, Type, OpaqueType}). +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 + true -> + NewType = erl_types:t_struct_from_opaque(Type, [T2]), + {Map1, _} = + bind_pat_vars([Pat], [NewType], [], Map, State, Rev), + {Map1, T2}; + false -> bind_error([Pat], T1, T2, opaque) + end; + error -> bind_error([Pat], Type, t_none(), bind) + end. + %%---------------------------------------- %% Guards %% @@ -2296,7 +2340,7 @@ bind_guard_list([G|Gs], Map, Env, Eval, State, Acc) -> bind_guard_list([], Map, _Env, _Eval, _State, Acc) -> {Map, lists:reverse(Acc)}. --spec signal_guard_fail(cerl:c_call(), [erl_types:erl_type()], #state{}) -> +-spec signal_guard_fail(cerl:c_call(), [erl_types:erl_type()], state()) -> no_return(). signal_guard_fail(Guard, ArgTypes, State) -> @@ -2327,7 +2371,7 @@ 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(cerl:c_call(), [erl_types:erl_type()], #state{}) -> +-spec signal_guard_fatal_fail(cerl:c_call(), [erl_types:erl_type()], state()) -> no_return(). signal_guard_fatal_fail(Guard, ArgTypes, State) -> @@ -2680,7 +2724,7 @@ determine_mode(Type, Opaques) -> %%% %%% =========================================================================== -state__new(Callgraph, Tree, Plt, Module, Records) -> +state__new(Callgraph, Tree, Plt, Module, Records, BehaviourTranslations) -> TreeMap = build_tree_map(Tree), Funs = dict:fetch_keys(TreeMap), FunTab = init_fun_tab(Funs, dict:new(), TreeMap, Callgraph, Plt), @@ -2690,7 +2734,8 @@ state__new(Callgraph, Tree, Plt, Module, Records) -> erl_types:t_opaque_from_records(Records), #state{callgraph = Callgraph, envs = Env, fun_tab = FunTab, opaques = Opaques, plt = Plt, races = dialyzer_races:new(), records = Records, - warning_mode = false, warnings = [], work = Work, tree_map = TreeMap}. + warning_mode = false, warnings = [], work = Work, tree_map = TreeMap, + module = Module, behaviour_api_info = BehaviourTranslations}. state__mark_fun_as_handled(#state{fun_tab = FunTab} = State, Fun0) -> Fun = get_label(Fun0), @@ -3197,7 +3242,7 @@ get_file([_|Tail]) -> get_file(Tail). is_compiler_generated(Ann) -> lists:member(compiler_generated, Ann) orelse (get_line(Ann) < 1). --spec format_args([term()], [erl_types:erl_type()], #state{}) -> +-spec format_args([term()], [erl_types:erl_type()], state()) -> nonempty_string(). format_args([], [], _State) -> @@ -3205,7 +3250,7 @@ format_args([], [], _State) -> format_args(ArgList, TypeList, State) -> "(" ++ format_args_1(ArgList, TypeList, State) ++ ")". --spec format_args_1([term(),...], [erl_types:erl_type(),...], #state{}) -> +-spec format_args_1([term(),...], [erl_types:erl_type(),...], state()) -> string(). format_args_1([Arg], [Type], State) -> @@ -3235,12 +3280,12 @@ format_arg(Arg) -> Default end. --spec format_type(erl_types:erl_type(), #state{}) -> string(). +-spec format_type(erl_types:erl_type(), state()) -> string(). format_type(Type, #state{records = R}) -> t_to_string(Type, R). --spec format_sig_args(erl_types:erl_type(), #state{}) -> string(). +-spec format_sig_args(erl_types:erl_type(), state()) -> string(). format_sig_args(Type, #state{records = R}) -> SigArgs = t_fun_args(Type), diff --git a/lib/dialyzer/src/dialyzer_dep.erl b/lib/dialyzer/src/dialyzer_dep.erl index 670433f003..7d56376730 100644 --- a/lib/dialyzer/src/dialyzer_dep.erl +++ b/lib/dialyzer/src/dialyzer_dep.erl @@ -326,7 +326,7 @@ set__filter(#set{set = Set}, Fun) -> %% -record(output, {type :: 'single' | 'list', - content :: 'none' | #set{} | [{output,_,_}]}). + content :: 'none' | #set{} | [#output{}]}). output(none) -> #output{type = single, content = none}; output(S = #set{}) -> #output{type = single, content = S}; diff --git a/lib/dialyzer/src/dialyzer_gui_wx.erl b/lib/dialyzer/src/dialyzer_gui_wx.erl index 2d97f88680..5b807804e2 100644 --- a/lib/dialyzer/src/dialyzer_gui_wx.erl +++ b/lib/dialyzer/src/dialyzer_gui_wx.erl @@ -102,9 +102,9 @@ create_window(Wx, DialyzerOptions) -> MenuBar = wxMenuBar:new(), wxMenuBar:append(MenuBar, FileMenu, "File"), - wxMenuBar:append(MenuBar, WarningsMenu, "Warnings"), - wxMenuBar:append(MenuBar, PltMenu, "Plt"), - wxMenuBar:append(MenuBar, OptionsMenu, "Options"), + wxMenuBar:append(MenuBar, WarningsMenu, "Warnings"), + wxMenuBar:append(MenuBar, PltMenu, "Plt"), + wxMenuBar:append(MenuBar, OptionsMenu, "Options"), wxMenuBar:append(MenuBar, HelpMenu, "Help"), wxFrame:setMenuBar(Frame, MenuBar), ok = wxFrame:connect(Frame, command_menu_selected), @@ -152,8 +152,8 @@ create_window(Wx, DialyzerOptions) -> AddButton = wxButton:new(Frame, ?Add_Button, [{label, "Add"}]), AddDirButton = wxButton:new(Frame, ?AddDir_Button, [{label, "Add Dir"}]), AddRecButton = wxButton:new(Frame, ?AddRec_Button, [{label, "Add Recursively"}]), - ExplainWarnButton = wxButton:new(Frame, ?ExplWarn_Button, [{label, "Explain Warning"}]), - ClearWarningsButton = wxButton:new(Frame, ?ClearWarn_Button, [{label, "Clear Warnings"}]), + ExplainWarnButton = wxButton:new(Frame, ?ExplWarn_Button, [{label, "Explain Warning"}]), + ClearWarningsButton = wxButton:new(Frame, ?ClearWarn_Button, [{label, "Clear Warnings"}]), RunButton = wxButton:new(Frame, ?Run_Button, [{label, "Run"}]), StopButton = wxButton:new(Frame, ?Stop_Button, [{label, "Stop"}]), wxWindow:disable(StopButton), @@ -170,8 +170,8 @@ create_window(Wx, DialyzerOptions) -> wxButton:connect(StopButton, command_button_clicked), %%------------Set Layout ------------ - All = wxBoxSizer:new(?wxVERTICAL), - Top = wxBoxSizer:new(?wxHORIZONTAL), + All = wxBoxSizer:new(?wxVERTICAL), + Top = wxBoxSizer:new(?wxHORIZONTAL), Left = wxBoxSizer:new(?wxVERTICAL), Right = wxBoxSizer:new(?wxVERTICAL), RightUp = wxBoxSizer:new(?wxHORIZONTAL), @@ -390,7 +390,7 @@ gui_loop(#gui_state{backend_pid = BackendPid, doc_plt = DocPlt, warnings_box = WarningsBox} = State) -> receive #wx{event = #wxClose{}} -> - io:format("~p Closing window ~n", [self()]), + %% io:format("~p Closing window ~n", [self()]), ok = wxFrame:setStatusText(Frame, "Closing...",[]), wxWindow:destroy(Frame), ?RET_NOTHING_SUSPICIOUS; @@ -539,7 +539,7 @@ maybe_quit(#gui_state{frame = Frame} = State) -> %% ------------ Yes/No Question ------------ dialog(#gui_state{frame = Frame}, Message, Title) -> - MessageWin = wxMessageDialog:new(Frame,Message,[{caption, Title},{style, ?wxYES_NO bor ?wxICON_QUESTION bor ?wxNO_DEFAULT}]), + MessageWin = wxMessageDialog:new(Frame, Message, [{caption, Title},{style, ?wxYES_NO bor ?wxICON_QUESTION bor ?wxNO_DEFAULT}]), case wxDialog:showModal(MessageWin) of ?wxID_YES -> true; @@ -563,12 +563,12 @@ search_doc_plt(#gui_state{gui = Wx} = State) -> Cancel = wxButton:new(Dialog, ?Search_Cancel, [{label, "Cancel"}]), wxButton:connect(Cancel, command_button_clicked), - Layout = wxBoxSizer:new(?wxVERTICAL), - Top = wxBoxSizer:new(?wxHORIZONTAL), - ModLayout = wxBoxSizer:new(?wxVERTICAL), - FunLayout = wxBoxSizer:new(?wxVERTICAL), - ArLayout = wxBoxSizer:new(?wxVERTICAL), - Buttons = wxBoxSizer:new(?wxHORIZONTAL), + Layout = wxBoxSizer:new(?wxVERTICAL), + Top = wxBoxSizer:new(?wxHORIZONTAL), + ModLayout = wxBoxSizer:new(?wxVERTICAL), + FunLayout = wxBoxSizer:new(?wxVERTICAL), + ArLayout = wxBoxSizer:new(?wxVERTICAL), + Buttons = wxBoxSizer:new(?wxHORIZONTAL), wxSizer:add(ModLayout, ModLabel, ?BorderOpt), wxSizer:add(ModLayout,ModText, ?BorderOpt), @@ -606,7 +606,7 @@ search_plt_loop(State= #gui_state{doc_plt = DocPlt, frame = Frame}, Win, ModText A = format_search(wxTextCtrl:getValue(ArText)), if - (M == '_') or (F == '_') or (A == '_') -> + (M =:= '_') orelse (F =:= '_') orelse (A =:= '_') -> error_sms(State, "Please give:\n Module (atom)\n Function (atom)\n Arity (integer)\n"), search_plt_loop(State, Win, ModText, FunText, ArText, Search, Cancel); true -> @@ -670,7 +670,7 @@ free_editor(#gui_state{gui = Wx, frame = Frame}, Title, Contents0) -> wxFrame:connect(Win, close_window), Ok = wxButton:new(Win, ?Message_Ok, [{label, "OK"}]), wxButton:connect(Ok, command_button_clicked), - Layout = wxBoxSizer:new(?wxVERTICAL), + Layout = wxBoxSizer:new(?wxVERTICAL), wxSizer:add(Layout, Editor, ?BorderOpt), wxSizer:add(Layout, Ok, [{flag, ?wxALIGN_CENTER bor ?wxBOTTOM bor ?wxALL}, ?Border]), @@ -757,7 +757,7 @@ add_files(File, FileList, ChosenBox, Ext) -> Files. filter_mods(Mods, Extension) -> - Fun = fun(X) -> + Fun = fun(X) -> filename:extension(X) =:= Extension orelse (filelib:is_dir(X) andalso @@ -944,9 +944,9 @@ include_dialog(#gui_state{gui = Wx, frame = Frame, options = Options}) -> Dirs = [io_lib:format("~s", [X]) || X <- Options#options.include_dirs], wxListBox:set(Box, Dirs), - Layout = wxBoxSizer:new(?wxVERTICAL), - Buttons = wxBoxSizer:new(?wxHORIZONTAL), - Buttons1 = wxBoxSizer:new(?wxHORIZONTAL), + Layout = wxBoxSizer:new(?wxVERTICAL), + Buttons = wxBoxSizer:new(?wxHORIZONTAL), + Buttons1 = wxBoxSizer:new(?wxHORIZONTAL), wxSizer:add(Layout, DirLabel, [{flag, ?wxALIGN_CENTER_HORIZONTAL}]), wxSizer:add(Layout, DirPicker, [{flag, ?wxALIGN_CENTER_HORIZONTAL}]), @@ -1038,12 +1038,12 @@ macro_dialog(#gui_state{gui = Wx, frame = Frame, options = Options}) -> || {X,Y} <- Options#options.defines], wxListBox:set(Box, Macros), - Layout = wxBoxSizer:new(?wxVERTICAL), - Item = wxBoxSizer:new(?wxHORIZONTAL), - MacroItem = wxBoxSizer:new(?wxVERTICAL), - TermItem = wxBoxSizer:new(?wxVERTICAL), - Buttons = wxBoxSizer:new(?wxHORIZONTAL), - Buttons1 = wxBoxSizer:new(?wxHORIZONTAL), + Layout = wxBoxSizer:new(?wxVERTICAL), + Item = wxBoxSizer:new(?wxHORIZONTAL), + MacroItem = wxBoxSizer:new(?wxVERTICAL), + TermItem = wxBoxSizer:new(?wxVERTICAL), + Buttons = wxBoxSizer:new(?wxHORIZONTAL), + Buttons1 = wxBoxSizer:new(?wxHORIZONTAL), wxSizer:add(MacroItem, MacroLabel, ?BorderOpt), wxSizer:add(MacroItem, MacroText, ?BorderOpt), @@ -1159,7 +1159,8 @@ handle_explanation(#gui_state{rawWarnings = RawWarns, warnings_box = WarnBox, expl_pid = ExplPid} = State) -> case wxListBox:isEmpty(WarnBox) of - true -> error_sms(State, "\nThere are no warnings.\nRun the dialyzer first."); + true -> + error_sms(State, "\nThere are no warnings.\nRun the dialyzer first."); false -> case wxListBox:getSelections(WarnBox)of {0, []} -> @@ -1200,8 +1201,8 @@ show_explanation(#gui_state{gui = Wx} = State, Explanation) -> wxButton:connect(ExplButton, command_button_clicked), Ok = wxButton:new(Win, ?ExplOk, [{label, "OK"}]), wxButton:connect(Ok, command_button_clicked), - Layout = wxBoxSizer:new(?wxVERTICAL), - Buttons = wxBoxSizer:new(?wxHORIZONTAL), + Layout = wxBoxSizer:new(?wxVERTICAL), + Buttons = wxBoxSizer:new(?wxHORIZONTAL), wxSizer:add(Buttons, ExplButton, ?BorderOpt), wxSizer:add(Buttons, Ok, ?BorderOpt), wxSizer:add(Layout, Editor,[{flag, ?wxALIGN_CENTER_HORIZONTAL bor ?wxALL}, ?Border]), diff --git a/lib/dialyzer/src/dialyzer_options.erl b/lib/dialyzer/src/dialyzer_options.erl index 6531073072..1f587d6df0 100644 --- a/lib/dialyzer/src/dialyzer_options.erl +++ b/lib/dialyzer/src/dialyzer_options.erl @@ -252,6 +252,8 @@ build_warnings([Opt|Opts], Warnings) -> ordsets:add_element(?WARN_RETURN_ONLY_EXIT, Warnings); race_conditions -> ordsets:add_element(?WARN_RACE_CONDITION, Warnings); + behaviours -> + ordsets:add_element(?WARN_BEHAVIOUR, Warnings); specdiffs -> S = ordsets:from_list([?WARN_CONTRACT_SUBTYPE, ?WARN_CONTRACT_SUPERTYPE, diff --git a/lib/dialyzer/src/dialyzer_plt.erl b/lib/dialyzer/src/dialyzer_plt.erl index f2e0fe1e97..fed1e74b33 100644 --- a/lib/dialyzer/src/dialyzer_plt.erl +++ b/lib/dialyzer/src/dialyzer_plt.erl @@ -70,109 +70,106 @@ %%---------------------------------------------------------------------- --record(dialyzer_plt, {info = table_new() :: dict(), - types = table_new() :: dict(), - contracts = table_new() :: dict()}). --opaque plt() :: #dialyzer_plt{}. +-record(plt, {info = table_new() :: dict(), + types = table_new() :: dict(), + contracts = table_new() :: dict()}). +-opaque plt() :: #plt{}. -include("dialyzer.hrl"). -type file_md5() :: {file:filename(), binary()}. -type plt_info() :: {[file_md5()], dict()}. --record(dialyzer_file_plt, {version = "" :: string(), - file_md5_list = [] :: [file_md5()], - info = dict:new() :: dict(), - contracts = dict:new() :: dict(), - types = dict:new() :: dict(), - mod_deps :: mod_deps(), - implementation_md5 = [] :: [file_md5()] - }). +-record(file_plt, {version = "" :: string(), + file_md5_list = [] :: [file_md5()], + info = dict:new() :: dict(), + contracts = dict:new() :: dict(), + types = dict:new() :: dict(), + mod_deps :: mod_deps(), + implementation_md5 = [] :: [file_md5()]}). %%---------------------------------------------------------------------- -spec new() -> plt(). new() -> - #dialyzer_plt{}. + #plt{}. -spec delete_module(plt(), module()) -> plt(). -delete_module(#dialyzer_plt{info = Info, types = Types, contracts = Contracts}, - Mod) -> - #dialyzer_plt{info = table_delete_module(Info, Mod), - types = table_delete_module2(Types, Mod), - contracts = table_delete_module(Contracts, Mod)}. +delete_module(#plt{info = Info, types = Types, contracts = Contracts}, Mod) -> + #plt{info = table_delete_module(Info, Mod), + types = table_delete_module2(Types, Mod), + contracts = table_delete_module(Contracts, Mod)}. -spec delete_list(plt(), [mfa() | integer()]) -> plt(). -delete_list(#dialyzer_plt{info = Info, types = Types, contracts = Contracts}, - List) -> - #dialyzer_plt{info = table_delete_list(Info, List), - types = Types, - contracts = table_delete_list(Contracts, List)}. +delete_list(#plt{info = Info, types = Types, contracts = Contracts}, List) -> + #plt{info = table_delete_list(Info, List), + types = Types, + contracts = table_delete_list(Contracts, List)}. -spec insert_contract_list(plt(), dialyzer_contracts:plt_contracts()) -> plt(). -insert_contract_list(#dialyzer_plt{contracts = Contracts} = PLT, List) -> - PLT#dialyzer_plt{contracts = table_insert_list(Contracts, List)}. +insert_contract_list(#plt{contracts = Contracts} = PLT, List) -> + PLT#plt{contracts = table_insert_list(Contracts, List)}. -spec lookup_contract(plt(), mfa_patt()) -> 'none' | {'value', #contract{}}. -lookup_contract(#dialyzer_plt{contracts = Contracts}, +lookup_contract(#plt{contracts = Contracts}, {M, F, _} = MFA) when is_atom(M), is_atom(F) -> table_lookup(Contracts, MFA). -spec delete_contract_list(plt(), [mfa()]) -> plt(). -delete_contract_list(#dialyzer_plt{contracts = Contracts} = PLT, List) -> - PLT#dialyzer_plt{contracts = table_delete_list(Contracts, List)}. +delete_contract_list(#plt{contracts = Contracts} = PLT, List) -> + PLT#plt{contracts = table_delete_list(Contracts, List)}. %% -spec insert(plt(), mfa() | integer(), {_, _}) -> plt(). %% -%% insert(#dialyzer_plt{info = Info} = PLT, Id, Types) -> -%% PLT#dialyzer_plt{info = table_insert(Info, Id, Types)}. +%% insert(#plt{info = Info} = PLT, Id, Types) -> +%% PLT#plt{info = table_insert(Info, Id, Types)}. -type ret_args_types() :: {erl_types:erl_type(), [erl_types:erl_type()]}. -spec insert_list(plt(), [{mfa() | integer(), ret_args_types()}]) -> plt(). -insert_list(#dialyzer_plt{info = Info} = PLT, List) -> - PLT#dialyzer_plt{info = table_insert_list(Info, List)}. +insert_list(#plt{info = Info} = PLT, List) -> + PLT#plt{info = table_insert_list(Info, List)}. -spec lookup(plt(), integer() | mfa_patt()) -> 'none' | {'value', ret_args_types()}. -lookup(#dialyzer_plt{info = Info}, {M, F, _} = MFA) when is_atom(M), is_atom(F) -> +lookup(#plt{info = Info}, {M, F, _} = MFA) when is_atom(M), is_atom(F) -> table_lookup(Info, MFA); -lookup(#dialyzer_plt{info = Info}, Label) when is_integer(Label) -> +lookup(#plt{info = Info}, Label) when is_integer(Label) -> table_lookup(Info, Label). -spec insert_types(plt(), dict()) -> plt(). insert_types(PLT, Rec) -> - PLT#dialyzer_plt{types = Rec}. + PLT#plt{types = Rec}. -spec get_types(plt()) -> dict(). -get_types(#dialyzer_plt{types = Types}) -> +get_types(#plt{types = Types}) -> Types. -type mfa_types() :: {mfa(), erl_types:erl_type(), [erl_types:erl_type()]}. -spec lookup_module(plt(), module()) -> 'none' | {'value', [mfa_types()]}. -lookup_module(#dialyzer_plt{info = Info}, M) when is_atom(M) -> +lookup_module(#plt{info = Info}, M) when is_atom(M) -> table_lookup_module(Info, M). -spec contains_module(plt(), module()) -> boolean(). -contains_module(#dialyzer_plt{info = Info, contracts = Cs}, M) when is_atom(M) -> +contains_module(#plt{info = Info, contracts = Cs}, M) when is_atom(M) -> table_contains_module(Info, M) orelse table_contains_module(Cs, M). -spec contains_mfa(plt(), mfa()) -> boolean(). -contains_mfa(#dialyzer_plt{info = Info, contracts = Contracts}, MFA) -> +contains_mfa(#plt{info = Info, contracts = Contracts}, MFA) -> (table_lookup(Info, MFA) =/= none) orelse (table_lookup(Contracts, MFA) =/= none). @@ -208,14 +205,14 @@ from_file(FileName, ReturnInfo) -> Msg = io_lib:format("Old PLT file ~s\n", [FileName]), error(Msg); ok -> - Plt = #dialyzer_plt{info = Rec#dialyzer_file_plt.info, - types = Rec#dialyzer_file_plt.types, - contracts = Rec#dialyzer_file_plt.contracts}, + Plt = #plt{info = Rec#file_plt.info, + types = Rec#file_plt.types, + contracts = Rec#file_plt.contracts}, case ReturnInfo of false -> Plt; true -> - PltInfo = {Rec#dialyzer_file_plt.file_md5_list, - Rec#dialyzer_file_plt.mod_deps}, + PltInfo = {Rec#file_plt.file_md5_list, + Rec#file_plt.mod_deps}, {Plt, PltInfo} end end; @@ -230,25 +227,25 @@ from_file(FileName, ReturnInfo) -> included_files(FileName) -> case get_record_from_file(FileName) of - {ok, #dialyzer_file_plt{file_md5_list = Md5}} -> + {ok, #file_plt{file_md5_list = Md5}} -> {ok, [File || {File, _} <- Md5]}; {error, _What} = Error -> Error end. -check_version(#dialyzer_file_plt{version=?VSN, implementation_md5=ImplMd5}) -> +check_version(#file_plt{version = ?VSN, implementation_md5 = ImplMd5}) -> case compute_new_md5(ImplMd5, [], []) of ok -> ok; {differ, _, _} -> error; {error, _} -> error end; -check_version(#dialyzer_file_plt{}) -> error. +check_version(#file_plt{}) -> error. get_record_from_file(FileName) -> case file:read_file(FileName) of {ok, Bin} -> try binary_to_term(Bin) of - #dialyzer_file_plt{} = FilePLT -> {ok, FilePLT}; + #file_plt{} = FilePLT -> {ok, FilePLT}; _ -> {error, not_valid} catch _:_ -> {error, not_valid} @@ -262,30 +259,30 @@ get_record_from_file(FileName) -> -spec merge_plts([plt()]) -> plt(). merge_plts(List) -> - InfoList = [Info || #dialyzer_plt{info = Info} <- List], - TypesList = [Types || #dialyzer_plt{types = Types} <- List], - ContractsList = [Contracts || #dialyzer_plt{contracts = Contracts} <- List], - #dialyzer_plt{info = table_merge(InfoList), - types = table_merge(TypesList), - contracts = table_merge(ContractsList)}. + InfoList = [Info || #plt{info = Info} <- List], + TypesList = [Types || #plt{types = Types} <- List], + ContractsList = [Contracts || #plt{contracts = Contracts} <- List], + #plt{info = table_merge(InfoList), + types = table_merge(TypesList), + contracts = table_merge(ContractsList)}. -spec to_file(file:filename(), plt(), mod_deps(), {[file_md5()], mod_deps()}) -> 'ok'. to_file(FileName, - #dialyzer_plt{info = Info, types = Types, contracts = Contracts}, + #plt{info = Info, types = Types, contracts = Contracts}, ModDeps, {MD5, OldModDeps}) -> NewModDeps = dict:merge(fun(_Key, OldVal, NewVal) -> ordsets:union(OldVal, NewVal) end, OldModDeps, ModDeps), ImplMd5 = compute_implementation_md5(), - Record = #dialyzer_file_plt{version = ?VSN, - file_md5_list = MD5, - info = Info, - contracts = Contracts, - types = Types, - mod_deps = NewModDeps, - implementation_md5 = ImplMd5}, + Record = #file_plt{version = ?VSN, + file_md5_list = MD5, + info = Info, + contracts = Contracts, + types = Types, + mod_deps = NewModDeps, + implementation_md5 = ImplMd5}, Bin = term_to_binary(Record, [compressed]), case file:write_file(FileName, Bin) of ok -> ok; @@ -307,7 +304,7 @@ to_file(FileName, check_plt(FileName, RemoveFiles, AddFiles) -> case get_record_from_file(FileName) of - {ok, #dialyzer_file_plt{file_md5_list = Md5, mod_deps = ModDeps} = Rec} -> + {ok, #file_plt{file_md5_list = Md5, mod_deps = ModDeps} = Rec} -> case check_version(Rec) of ok -> case compute_new_md5(Md5, RemoveFiles, AddFiles) of @@ -420,18 +417,17 @@ init_md5_list_1(Md5List, [], Acc) -> -spec get_specs(plt()) -> string(). -get_specs(#dialyzer_plt{info = Info}) -> +get_specs(#plt{info = Info}) -> %% TODO: Should print contracts as well. - List = - lists:sort([{MFA, Val} || {MFA = {_,_,_}, Val} <- table_to_list(Info)]), - lists:flatten(create_specs(List, [])). + L = lists:sort([{MFA, Val} || {{_,_,_} = MFA, Val} <- table_to_list(Info)]), + lists:flatten(create_specs(L, [])). beam_file_to_module(Filename) -> list_to_atom(filename:basename(Filename, ".beam")). -spec get_specs(plt(), module(), atom(), arity_patt()) -> 'none' | string(). -get_specs(#dialyzer_plt{info = Info}, M, F, A) when is_atom(M), is_atom(F) -> +get_specs(#plt{info = Info}, M, F, A) when is_atom(M), is_atom(F) -> MFA = {M, F, A}, case table_lookup(Info, MFA) of none -> none; @@ -526,9 +522,9 @@ table_merge([H|T]) -> table_merge([], Acc) -> Acc; -table_merge([Plt|Left], Acc) -> +table_merge([Plt|Plts], Acc) -> NewAcc = dict:merge(fun(_Key, Val, Val) -> Val end, Plt, Acc), - table_merge(Left, NewAcc). + table_merge(Plts, NewAcc). %%--------------------------------------------------------------------------- %% Debug utilities. @@ -538,7 +534,7 @@ table_merge([Plt|Left], Acc) -> pp_non_returning() -> PltFile = get_default_plt(), Plt = from_file(PltFile), - List = table_to_list(Plt#dialyzer_plt.info), + List = table_to_list(Plt#plt.info), Unit = [{MFA, erl_types:t_fun(Args, Ret)} || {MFA, {Ret, Args}} <- List, erl_types:t_is_unit(Ret)], None = [{MFA, erl_types:t_fun(Args, Ret)} || {MFA, {Ret, Args}} <- List, diff --git a/lib/dialyzer/src/dialyzer_races.erl b/lib/dialyzer/src/dialyzer_races.erl index 5857f7a03d..303e64e68e 100644 --- a/lib/dialyzer/src/dialyzer_races.erl +++ b/lib/dialyzer/src/dialyzer_races.erl @@ -50,8 +50,10 @@ -define(local, 5). -define(no_arg, no_arg). -define(no_label, no_label). +-define(bypassed, bypassed). -define(WARN_WHEREIS_REGISTER, warn_whereis_register). +-define(WARN_WHEREIS_UNREGISTER, warn_whereis_unregister). -define(WARN_ETS_LOOKUP_INSERT, warn_ets_lookup_insert). -define(WARN_MNESIA_DIRTY_READ_WRITE, warn_mnesia_dirty_read_write). -define(WARN_NO_WARN, warn_no_warn). @@ -64,27 +66,29 @@ -type mfa_or_funlbl() :: label() | mfa(). --type label_type() :: label() | [label()] | {label()} | ?no_label. --type args() :: [label_type() | [string()]]. --type core_vars() :: cerl:cerl() | ?no_arg. --type var_to_map() :: core_vars() | [cerl:cerl()]. --type core_args() :: [core_vars()] | 'empty'. --type op() :: 'bind' | 'unbind'. +-type label_type() :: label() | [label()] | {label()} | ?no_label. +-type args() :: [label_type() | [string()]]. +-type core_vars() :: cerl:cerl() | ?no_arg | ?bypassed. +-type var_to_map1() :: core_vars() | [cerl:cerl()]. +-type var_to_map2() :: cerl:cerl() | [cerl:cerl()] | ?bypassed. +-type core_args() :: [core_vars()] | 'empty'. +-type op() :: 'bind' | 'unbind'. -type dep_calls() :: 'whereis' | 'ets_lookup' | 'mnesia_dirty_read'. --type warn_calls() :: 'register' | 'ets_insert' | 'mnesia_dirty_write'. --type call() :: 'whereis' | 'register' | 'ets_new' | 'ets_lookup' - | 'ets_insert' | 'mnesia_dirty_read1' +-type warn_calls() :: 'register' | 'unregister' | 'ets_insert' + | 'mnesia_dirty_write'. +-type call() :: 'whereis' | 'register' | 'unregister' | 'ets_new' + | 'ets_lookup' | 'ets_insert' | 'mnesia_dirty_read1' | 'mnesia_dirty_read2' | 'mnesia_dirty_write1' | 'mnesia_dirty_write2' | 'function_call'. --type race_tag() :: 'whereis_register' | 'ets_lookup_insert' - | 'mnesia_dirty_read_write'. +-type race_tag() :: 'whereis_register' | 'whereis_unregister' + | 'ets_lookup_insert' | 'mnesia_dirty_read_write'. --record(beg_clause, {arg :: var_to_map(), - pats :: var_to_map(), +-record(beg_clause, {arg :: var_to_map1(), + pats :: var_to_map1(), guard :: cerl:cerl()}). --record(end_clause, {arg :: var_to_map(), - pats :: var_to_map(), +-record(end_clause, {arg :: var_to_map1(), + pats :: var_to_map1(), guard :: cerl:cerl()}). -record(end_case, {clauses :: [#end_clause{}]}). -record(curr_fun, {status :: 'in' | 'out', @@ -98,15 +102,15 @@ args :: args(), arg_types :: [erl_types:erl_type()], vars :: [core_vars()], - state :: _, + state :: _, %% XXX: recursive file_line :: file_line(), var_map :: dict()}). -record(fun_call, {caller :: mfa_or_funlbl(), callee :: mfa_or_funlbl(), arg_types :: [erl_types:erl_type()], vars :: [core_vars()]}). --record(let_tag, {var :: var_to_map(), - arg :: var_to_map()}). +-record(let_tag, {var :: var_to_map1(), + arg :: var_to_map1()}). -record(warn_call, {call_name :: warn_calls(), args :: args(), var_map :: dict()}). @@ -180,6 +184,14 @@ store_race_call(Fun, ArgTypes, Args, FileLine, State) -> fun_mfa = CurrFun, fun_label = CurrFunLabel}, {[#warn_call{call_name = register, args = VarArgs}| RaceList], RaceListSize + 1, [RaceFun|RaceTags], no_t}; + {erlang, unregister, 1} -> + VarArgs = format_args(Args, ArgTypes, CleanState, unregister), + RaceFun = #race_fun{mfa = Fun, args = VarArgs, + arg_types = ArgTypes, vars = Args, + file_line = FileLine, index = RaceListSize, + fun_mfa = CurrFun, fun_label = CurrFunLabel}, + {[#warn_call{call_name = unregister, args = VarArgs}| + RaceList], RaceListSize + 1, [RaceFun|RaceTags], no_t}; {erlang, whereis, 1} -> VarArgs = format_args(Args, ArgTypes, CleanState, whereis), {[#dep_call{call_name = whereis, args = VarArgs, @@ -280,6 +292,7 @@ race(State) -> RaceWarnTag = case Fun of {erlang, register, 2} -> ?WARN_WHEREIS_REGISTER; + {erlang, unregister, 1} -> ?WARN_WHEREIS_UNREGISTER; {ets, insert, 2} -> ?WARN_ETS_LOOKUP_INSERT; {mnesia, dirty_write, _A} -> ?WARN_MNESIA_DIRTY_READ_WRITE end, @@ -287,7 +300,7 @@ race(State) -> state__renew_curr_fun(CurrFun, state__renew_curr_fun_label(CurrFunLabel, state__renew_race_list(lists:nthtail(length(RaceList) - Index, - RaceList), State))), + RaceList), State))), DepList = fixup_race_list(RaceWarnTag, VarArgs, State1), {State2, RaceWarn} = get_race_warn(Fun, Args, ArgTypes, DepList, State), @@ -309,6 +322,7 @@ fixup_race_list(RaceWarnTag, WarnVarArgs, State) -> RaceTag = case RaceWarnTag of ?WARN_WHEREIS_REGISTER -> whereis_register; + ?WARN_WHEREIS_UNREGISTER -> whereis_unregister; ?WARN_ETS_LOOKUP_INSERT -> ets_lookup_insert; ?WARN_MNESIA_DIRTY_READ_WRITE -> mnesia_dirty_read_write end, @@ -320,11 +334,9 @@ fixup_race_list(RaceWarnTag, WarnVarArgs, State) -> lists:reverse(NewRaceList), [], CurrFun, WarnVarArgs, RaceWarnTag, dict:new(), [], [], [], 2 * ?local, NewState), - Parents = - fixup_race_backward(CurrFun, Calls, Calls, [], ?local), + Parents = fixup_race_backward(CurrFun, Calls, Calls, [], ?local), UParents = lists:usort(Parents), - Filtered = - filter_parents(UParents, UParents, Digraph), + Filtered = filter_parents(UParents, UParents, Digraph), NewParents = case lists:member(CurrFun, Filtered) of true -> Filtered; @@ -401,8 +413,7 @@ fixup_race_forward_pullout(CurrFun, CurrFunLabel, Calls, Code, RaceList, false -> {ok, Fun} = Name, {ok, Int} = Label, - case dict:find(Fun, - dialyzer_callgraph:get_race_code(Callgraph)) of + case dict:find(Fun, dialyzer_callgraph:get_race_code(Callgraph)) of error -> {NewCurrFun, NewCurrFunLabel, NewCalls, Tail, NewRaceList, NewRaceVarMap, NewFunDefVars, NewFunCallVars, NewFunArgTypes, @@ -459,7 +470,8 @@ fixup_race_forward(CurrFun, CurrFunLabel, Calls, Code, RaceList, case Head of #dep_call{call_name = whereis} -> case RaceWarnTag of - ?WARN_WHEREIS_REGISTER -> + WarnWhereis when WarnWhereis =:= ?WARN_WHEREIS_REGISTER orelse + WarnWhereis =:= ?WARN_WHEREIS_UNREGISTER -> {[Head#dep_call{var_map = RaceVarMap}|RaceList], [], NestingLevel, false}; _Other -> @@ -493,9 +505,11 @@ fixup_race_forward(CurrFun, CurrFunLabel, Calls, Code, RaceList, _Other -> {RaceList, [], NestingLevel, false} end; - #warn_call{call_name = register} -> + #warn_call{call_name = RegCall} when RegCall =:= register orelse + RegCall =:= unregister -> case RaceWarnTag of - ?WARN_WHEREIS_REGISTER -> + WarnWhereis when WarnWhereis =:= ?WARN_WHEREIS_REGISTER orelse + WarnWhereis =:= ?WARN_WHEREIS_UNREGISTER -> {[Head#warn_call{var_map = RaceVarMap}|RaceList], [], NestingLevel, false}; _Other -> @@ -575,6 +589,10 @@ fixup_race_forward(CurrFun, CurrFunLabel, Calls, Code, RaceList, {[#warn_call{call_name = register, args = WarnVarArgs, var_map = RaceVarMap}], NewDepList}; + whereis_unregister -> + {[#warn_call{call_name = unregister, args = WarnVarArgs, + var_map = RaceVarMap}], + NewDepList}; ets_lookup_insert -> NewWarnCall = [#warn_call{call_name = ets_insert, args = WarnVarArgs, @@ -760,6 +778,19 @@ get_deplist_paths(RaceList, WarnVarArgs, RaceWarnTag, RaceVarMap, CurrLevel, _ -> {[Vars, WVA2, WVA3, WVA4], false} end; + ?WARN_WHEREIS_UNREGISTER -> + [WVA1, WVA2] = WarnVarArgs1, + Vars = + lists:flatten( + [find_all_bound_vars(V, RaceVarMap1) || V <- WVA1]), + case {Vars, CurrLevel} of + {[], 0} -> + {WarnVarArgs, true}; + {[], _} -> + {WarnVarArgs, false}; + _ -> + {[Vars, WVA2], false} + end; ?WARN_ETS_LOOKUP_INSERT -> [WVA1, WVA2, WVA3, WVA4] = WarnVarArgs1, Vars1 = @@ -805,8 +836,9 @@ get_deplist_paths(RaceList, WarnVarArgs, RaceWarnTag, RaceVarMap, CurrLevel, get_deplist_paths(Tail, WarnVarArgs2, RaceWarnTag, RaceVarMap1, CurrLevel1, PublicTables, NamedTables) end; - #warn_call{call_name = register, args = WarnVarArgs1, - var_map = RaceVarMap1} -> + #warn_call{call_name = RegCall, args = WarnVarArgs1, + var_map = RaceVarMap1} when RegCall =:= register orelse + RegCall =:= unregister -> case compare_first_arg(WarnVarArgs, WarnVarArgs1, RaceVarMap1) of true -> {[], false, false}; NewWarnVarArgs -> @@ -1416,7 +1448,8 @@ lists_get(N, List) -> lists:nth(N, List). refine_race(RaceCall, WarnVarArgs, RaceWarnTag, DependencyList, RaceVarMap) -> case RaceWarnTag of - ?WARN_WHEREIS_REGISTER -> + WarnWhereis when WarnWhereis =:= ?WARN_WHEREIS_REGISTER orelse + WarnWhereis =:= ?WARN_WHEREIS_UNREGISTER -> case RaceCall of #dep_call{call_name = ets_lookup} -> DependencyList; @@ -1660,6 +1693,20 @@ compare_types(VarArgs, WarnVarArgs, RaceWarnTag, RaceVarMap) -> end end; + ?WARN_WHEREIS_UNREGISTER -> + [VA1, VA2] = VarArgs, + [WVA1, WVA2] = WarnVarArgs, + case any_args(VA2) of + true -> compare_var_list(VA1, WVA1, RaceVarMap); + false -> + case any_args(WVA2) of + true -> compare_var_list(VA1, WVA1, RaceVarMap); + false -> + compare_var_list(VA1, WVA1, RaceVarMap) orelse + compare_argtypes(VA2, WVA2) + + end + end; ?WARN_ETS_LOOKUP_INSERT -> [VA1, VA2, VA3, VA4] = VarArgs, [WVA1, WVA2, WVA3, WVA4] = WarnVarArgs, @@ -1683,8 +1730,8 @@ compare_types(VarArgs, WarnVarArgs, RaceWarnTag, RaceVarMap) -> true -> compare_var_list(VA3, WVA3, RaceVarMap); false -> - compare_var_list(VA3, WVA3, RaceVarMap) - orelse compare_argtypes(VA4, WVA4) + compare_var_list(VA3, WVA3, RaceVarMap) orelse + compare_argtypes(VA4, WVA4) end end); ?WARN_MNESIA_DIRTY_READ_WRITE -> @@ -1818,6 +1865,7 @@ ets_tuple_argtypes1(Str, Tuple, TupleList, NestingLevel) -> end end. +format_arg(?bypassed) -> ?no_label; format_arg(Arg) -> case cerl:type(Arg) of var -> cerl_trees:get_label(Arg); @@ -1845,9 +1893,13 @@ format_args_1([Arg], [Type], CleanState) -> [format_arg(Arg), format_type(Type, CleanState)]; format_args_1([Arg|Args], [Type|Types], CleanState) -> List = - case cerl:is_literal(Arg) of - true -> [?no_label, format_cerl(Arg)]; - false -> [format_arg(Arg), format_type(Type, CleanState)] + case Arg =:= ?bypassed of + true -> [?no_label, format_type(Type, CleanState)]; + false -> + case cerl:is_literal(Arg) of + true -> [?no_label, format_cerl(Arg)]; + false -> [format_arg(Arg), format_type(Type, CleanState)] + end end, List ++ format_args_1(Args, Types, CleanState). @@ -1859,6 +1911,9 @@ format_args_2(StrArgList, Call) -> register -> lists_key_replace(2, StrArgList, string:tokens(lists:nth(2, StrArgList), " |")); + unregister -> + lists_key_replace(2, StrArgList, + string:tokens(lists:nth(2, StrArgList), " |")); ets_new -> StrArgList1 = lists_key_replace(2, StrArgList, string:tokens(lists:nth(2, StrArgList), " |")), @@ -1919,10 +1974,11 @@ mnesia_tuple_argtypes(TupleStr) -> [TupleStr2|_T] = string:tokens(TupleStr1, " ,"), lists:flatten(string:tokens(TupleStr2, " |")). --spec race_var_map(var_to_map(), cerl:cerl() | [cerl:cerl()], dict(), op()) -> dict(). +-spec race_var_map(var_to_map1(), var_to_map2(), dict(), op()) -> dict(). race_var_map(Vars1, Vars2, RaceVarMap, Op) -> - case Vars1 =:= ?no_arg of + case Vars1 =:= ?no_arg orelse Vars1 =:= ?bypassed + orelse Vars2 =:= ?bypassed of true -> RaceVarMap; false -> case is_list(Vars1) andalso is_list(Vars2) of @@ -2076,7 +2132,7 @@ race_var_map_guard(Arg, Pats, Guard, RaceVarMap, Op) -> {RaceVarMap1, RemoveClause orelse RemoveClause1}. race_var_map_guard_helper1(Arg, Pats, RaceVarMap, Op) -> - case Arg =:= ?no_arg of + case Arg =:= ?no_arg orelse Arg =:= ?bypassed of true -> {RaceVarMap, false}; false -> case cerl:type(Arg) of @@ -2139,7 +2195,7 @@ unbind_dict_vars(Var1, Var2, RaceVarMap) -> true -> unbind_dict_vars(Var1, Var2, bind_dict_vars_list(Var1, Labels -- [Var2], - dict:erase(Var1, RaceVarMap))); + dict:erase(Var1, RaceVarMap))); false -> unbind_dict_vars_helper(Labels, Var1, Var2, RaceVarMap) end @@ -2171,6 +2227,10 @@ var_analysis(FunDefArgs, FunCallArgs, WarnVarArgs, RaceWarnTag) -> [WVA1, WVA2, WVA3, WVA4] = WarnVarArgs, ArgNos = lists_key_members_lists(WVA1, FunDefArgs), [[lists_get(N, FunCallArgs) || N <- ArgNos], WVA2, WVA3, WVA4]; + ?WARN_WHEREIS_UNREGISTER -> + [WVA1, WVA2] = WarnVarArgs, + ArgNos = lists_key_members_lists(WVA1, FunDefArgs), + [[lists_get(N, FunCallArgs) || N <- ArgNos], WVA2]; ?WARN_ETS_LOOKUP_INSERT -> [WVA1, WVA2, WVA3, WVA4] = WarnVarArgs, ArgNos1 = lists_key_members_lists(WVA1, FunDefArgs), @@ -2185,8 +2245,7 @@ var_analysis(FunDefArgs, FunCallArgs, WarnVarArgs, RaceWarnTag) -> var_type_analysis(FunDefArgs, FunCallTypes, WarnVarArgs, RaceWarnTag, RaceVarMap, CleanState) -> - FunVarArgs = format_args(FunDefArgs, FunCallTypes, CleanState, - function_call), + FunVarArgs = format_args(FunDefArgs, FunCallTypes, CleanState, function_call), case RaceWarnTag of ?WARN_WHEREIS_REGISTER -> [WVA1, WVA2, WVA3, WVA4] = WarnVarArgs, @@ -2197,6 +2256,15 @@ var_type_analysis(FunDefArgs, FunCallTypes, WarnVarArgs, RaceWarnTag, NewWVA2 = string:tokens(lists:nth(N + 1, FunVarArgs), " |"), [Vars, NewWVA2, WVA3, WVA4] end; + ?WARN_WHEREIS_UNREGISTER -> + [WVA1, WVA2] = WarnVarArgs, + Vars = find_all_bound_vars(WVA1, RaceVarMap), + case lists_key_member_lists(Vars, FunVarArgs) of + 0 -> [Vars, WVA2]; + N when is_integer(N) -> + NewWVA2 = string:tokens(lists:nth(N + 1, FunVarArgs), " |"), + [Vars, NewWVA2] + end; ?WARN_ETS_LOOKUP_INSERT -> [WVA1, WVA2, WVA3, WVA4] = WarnVarArgs, Vars1 = find_all_bound_vars(WVA1, RaceVarMap), @@ -2278,6 +2346,10 @@ get_race_warnings_helper(Warnings, State) -> get_reason(lists:keysort(7, DepList), "might fail due to a possible race condition " "caused by its combination with "); + ?WARN_WHEREIS_UNREGISTER -> + get_reason(lists:keysort(7, DepList), + "might fail due to a possible race condition " + "caused by its combination with "); ?WARN_ETS_LOOKUP_INSERT -> get_reason(lists:keysort(7, DepList), "might have an unintended effect due to " ++ @@ -2335,7 +2407,7 @@ state__add_race_warning(State, RaceWarn, RaceWarnTag, FileLine) -> %%% %%% =========================================================================== --spec beg_clause_new(var_to_map(), var_to_map(), cerl:cerl()) -> +-spec beg_clause_new(var_to_map1(), var_to_map1(), cerl:cerl()) -> #beg_clause{}. beg_clause_new(Arg, Pats, Guard) -> @@ -2351,7 +2423,7 @@ cleanup(#races{race_list = RaceList}) -> end_case_new(Clauses) -> #end_case{clauses = Clauses}. --spec end_clause_new(var_to_map(), var_to_map(), cerl:cerl()) -> +-spec end_clause_new(var_to_map1(), var_to_map1(), cerl:cerl()) -> #end_clause{}. end_clause_new(Arg, Pats, Guard) -> @@ -2387,7 +2459,7 @@ get_race_list(#races{race_list = RaceList}) -> get_race_list_size(#races{race_list_size = RaceListSize}) -> RaceListSize. --spec let_tag_new(var_to_map(), var_to_map()) -> #let_tag{}. +-spec let_tag_new(var_to_map1(), var_to_map1()) -> #let_tag{}. let_tag_new(Var, Arg) -> #let_tag{var = Var, arg = Arg}. @@ -2422,5 +2494,4 @@ put_race_analysis(Analysis, Races) -> races(). put_race_list(RaceList, RaceListSize, Races) -> - Races#races{race_list = RaceList, - race_list_size = RaceListSize}. + Races#races{race_list = RaceList, race_list_size = RaceListSize}. diff --git a/lib/dialyzer/src/dialyzer_succ_typings.erl b/lib/dialyzer/src/dialyzer_succ_typings.erl index dd8480f1f2..1670a6cf89 100644 --- a/lib/dialyzer/src/dialyzer_succ_typings.erl +++ b/lib/dialyzer/src/dialyzer_succ_typings.erl @@ -29,7 +29,7 @@ -export([analyze_callgraph/3, analyze_callgraph/4, - get_warnings/6]). + get_warnings/7]). %% These are only intended as debug functions. -export([doit/1, @@ -106,19 +106,21 @@ get_refined_success_typings(State) -> -type doc_plt() :: 'undefined' | dialyzer_plt:plt(). -spec get_warnings(dialyzer_callgraph:callgraph(), dialyzer_plt:plt(), doc_plt(), dialyzer_codeserver:codeserver(), set(), - pid()) -> + pid(), boolean()) -> {[dial_warning()], dialyzer_plt:plt(), doc_plt()}. -get_warnings(Callgraph, Plt, DocPlt, Codeserver, NoWarnUnused, Parent) -> +get_warnings(Callgraph, Plt, DocPlt, Codeserver, + NoWarnUnused, Parent, BehavioursChk) -> InitState = #st{callgraph = Callgraph, codeserver = Codeserver, no_warn_unused = NoWarnUnused, parent = Parent, plt = Plt}, NewState = get_refined_success_typings(InitState), Mods = dialyzer_callgraph:modules(NewState#st.callgraph), CWarns = dialyzer_contracts:get_invalid_contract_warnings(Mods, Codeserver, NewState#st.plt), - get_warnings_from_modules(Mods, NewState, DocPlt, CWarns). + get_warnings_from_modules(Mods, NewState, DocPlt, BehavioursChk, CWarns). -get_warnings_from_modules([M|Ms], State, DocPlt, Acc) when is_atom(M) -> +get_warnings_from_modules([M|Ms], State, DocPlt, + BehavioursChk, Acc) when is_atom(M) -> send_log(State#st.parent, io_lib:format("Getting warnings for ~w\n", [M])), #st{callgraph = Callgraph, codeserver = Codeserver, no_warn_unused = NoWarnUnused, plt = Plt} = State, @@ -131,13 +133,20 @@ get_warnings_from_modules([M|Ms], State, DocPlt, Acc) when is_atom(M) -> dialyzer_contracts:contracts_without_fun(Contracts, AllFuns, Callgraph), {Warnings2, FunTypes, RaceCode, PublicTables, NamedTables} = dialyzer_dataflow:get_warnings(ModCode, Plt, Callgraph, Records, NoWarnUnused), + Attrs = cerl:module_attrs(ModCode), + Warnings3 = if BehavioursChk -> + dialyzer_behaviours:check_callbacks(M, Attrs, + Plt, Codeserver); + true -> [] + end, NewDocPlt = insert_into_doc_plt(FunTypes, Callgraph, DocPlt), NewCallgraph = dialyzer_callgraph:renew_race_info(Callgraph, RaceCode, PublicTables, NamedTables), State1 = st__renew_state_calls(NewCallgraph, State), - get_warnings_from_modules(Ms, State1, NewDocPlt, [Warnings1,Warnings2|Acc]); -get_warnings_from_modules([], #st{plt = Plt}, DocPlt, Acc) -> + get_warnings_from_modules(Ms, State1, NewDocPlt, BehavioursChk, + [Warnings1, Warnings2, Warnings3|Acc]); +get_warnings_from_modules([], #st{plt = Plt}, DocPlt, _, Acc) -> {lists:flatten(Acc), Plt, DocPlt}. refine_succ_typings(ModulePostorder, State) -> diff --git a/lib/dialyzer/src/dialyzer_typesig.erl b/lib/dialyzer/src/dialyzer_typesig.erl index aeb20d4fae..57d869b88a 100644 --- a/lib/dialyzer/src/dialyzer_typesig.erl +++ b/lib/dialyzer/src/dialyzer_typesig.erl @@ -43,6 +43,7 @@ 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_list_elements/1, t_nonempty_list/1, t_maybe_improper_list/0, t_module/0, t_number/0, t_number_vals/1, @@ -51,7 +52,7 @@ 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_timeout/0, t_tuple/0, t_tuple/1, - t_unify/2, t_var/1, t_var_name/1, + t_unify/3, t_var/1, t_var_name/1, t_none/0, t_unit/0]). -include("dialyzer.hrl"). @@ -71,14 +72,20 @@ rhs :: fvar_or_type(), deps :: [dep()]}). +-type constraint() :: #constraint{}. + -record(constraint_list, {type :: 'conj' | 'disj', - list :: [_], % [constr()] but it needs recursion :-( + list :: [constr()], deps :: [dep()], id :: {'list', dep()}}). +-type constraint_list() :: #constraint_list{}. + -record(constraint_ref, {id :: type_var(), deps :: [dep()]}). --type constr() :: #constraint{} | #constraint_list{} | #constraint_ref{}. +-type constraint_ref() :: #constraint_ref{}. + +-type constr() :: constraint() | constraint_list() | constraint_ref(). -type typesig_scc() :: [{mfa(), {cerl:c_var(), cerl:c_fun()}, dict()}]. -type typesig_funmap() :: [{type_var(), type_var()}]. %% Orddict @@ -90,6 +97,7 @@ fun_arities = dict:new() :: dict(), in_match = false :: boolean(), in_guard = false :: boolean(), + module :: module(), name_map = dict:new() :: dict(), next_label :: label(), non_self_recs = [] :: [label()], @@ -98,7 +106,7 @@ records = dict:new() :: dict(), opaques = [] :: [erl_types:erl_type()], scc = [] :: [type_var()]}). - + %%----------------------------------------------------------------------------- -define(TYPE_LIMIT, 4). @@ -631,6 +639,9 @@ 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, + {FunModule, _, _} = MFA, case dialyzer_plt:lookup_contract(Plt, MFA) of none -> case PltRes of @@ -651,7 +662,14 @@ get_plt_constr(MFA, Dst, ArgVars, State) -> %% Need to combine the contract with the success typing. {mk_fun_var( fun(Map) -> - ArgTypes = lookup_type_list(ArgVars, 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) end, ArgVars), @@ -681,8 +699,8 @@ filter_match_fail([]) -> %% If there is a significant number of clauses, we cannot apply the %% list subtraction scheme since it causes the analysis to be too %% slow. Typically, this only affects automatically generated files. -%% Anyway, and the dataflow analysis doesn't suffer from this, so we -%% will get some information anyway. +%% The dataflow analysis doesn't suffer from this, so we will get some +%% information anyway. -define(MAX_NOF_CLAUSES, 15). handle_clauses(Clauses, TopVar, Arg, DefinedVars, State) -> @@ -843,7 +861,7 @@ get_underapprox_from_guard(Tree, Map) -> (cerl:is_c_var(Arg2) orelse cerl:is_literal(Arg2))) of true -> {Arg1Type, _} = get_underapprox_from_guard(Arg1, Map), - {Arg2Type, _} = get_underapprox_from_guard(Arg1, Map), + {Arg2Type, _} = get_underapprox_from_guard(Arg2, Map), case (t_is_equal(True, Arg1Type) andalso t_is_equal(True, Arg2Type)) of true -> {True, Map}; @@ -1511,13 +1529,21 @@ get_bif_constr({erlang, element, 2} = _BIF, Dst, Args, State) -> Cs = mk_constraints(Args, sub, ArgTypes), mk_conj_constraint_list([mk_constraint(Dst, sub, ReturnType)|Cs]) 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) -> - TmpArgTypes = lookup_type_list(Args, Map), + TmpArgTypes0 = lookup_type_list(Args, Map), + TmpArgTypes = [UnopaqueFun(T) || T<- TmpArgTypes0], erl_bif_types:type(M, F, A, TmpArgTypes) end, Args), case erl_bif_types:is_known(M, F, A) of @@ -1815,7 +1841,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) of + case solve_one_c(C, Map, State#state.opaques) of error -> ?debug("+++++++++++\nFailed: ~s :: ~s ~w ~s :: ~s\n+++++++++++\n", [format_type(C#constraint.lhs), @@ -1830,7 +1856,7 @@ 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) -> +solve_one_c(#constraint{lhs = Lhs, rhs = Rhs, op = Op}, Map, Opaques) -> LhsType = lookup_type(Lhs, Map), RhsType = lookup_type(Rhs, Map), Inf = t_inf(LhsType, RhsType, opaque), @@ -1841,16 +1867,16 @@ solve_one_c(#constraint{lhs = Lhs, rhs = Rhs, op = Op}, Map) -> true -> error; false -> case Op of - sub -> solve_subtype(Lhs, Inf, Map); + sub -> solve_subtype(Lhs, Inf, Map, Opaques); eq -> - case solve_subtype(Lhs, Inf, Map) of + case solve_subtype(Lhs, Inf, Map, Opaques) of error -> error; - {ok, Map1} -> solve_subtype(Rhs, Inf, Map1) + {ok, Map1} -> solve_subtype(Rhs, Inf, Map1, Opaques) end end end. -solve_subtype(Type, Inf, Map) -> +solve_subtype(Type, Inf, Map, Opaques) -> %% case cerl:is_literal(Type) of %% true -> %% case t_is_subtype(t_from_term(cerl:concrete(Type)), Inf) of @@ -1858,7 +1884,7 @@ solve_subtype(Type, Inf, Map) -> %% false -> error %% end; %% false -> - try t_unify(Type, Inf) of + try t_unify(Type, Inf, Opaques) of {_, List} -> {ok, enter_type_list(List, Map)} catch throw:{mismatch, _T1, _T2} -> @@ -2046,7 +2072,7 @@ state__set_rec_dict(State, 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}. + State#state{opaques = Opaques, module = M}. state__lookup_record(#state{records = Records}, Tag, Arity) -> case erl_types:lookup_record(Tag, Arity, Records) of @@ -2258,7 +2284,7 @@ mk_constraint(Lhs, Op, Rhs) -> case Deps =:= [] of true -> %% This constraint is constant. Solve it immediately. - case solve_one_c(C, dict:new()) of + case solve_one_c(C, dict:new(), []) of error -> throw(error); _ -> %% This is always true, keep it anyway for logistic reasons diff --git a/lib/dialyzer/src/dialyzer_utils.erl b/lib/dialyzer/src/dialyzer_utils.erl index fa9ad2eae2..d6ddf76956 100644 --- a/lib/dialyzer/src/dialyzer_utils.erl +++ b/lib/dialyzer/src/dialyzer_utils.erl @@ -47,6 +47,32 @@ -include("dialyzer.hrl"). +%%-define(DEBUG, true). + +-ifdef(DEBUG). +print_types(RecDict) -> + Keys = dict:fetch_keys(RecDict), + print_types1(Keys, RecDict). + +print_types1([], _) -> + ok; +print_types1([{type, _Name} = Key|T], RecDict) -> + {ok, {_Mod, Form, _Args}} = dict:find(Key, RecDict), + io:format("\n~w: ~w\n", [Key, erl_types:t_from_form(Form, RecDict)]), + print_types1(T, RecDict); +print_types1([{opaque, _Name} = Key|T], RecDict) -> + {ok, {_Mod, Form, _Args}} = dict:find(Key, RecDict), + io:format("\n~w: ~w\n", [Key, erl_types:t_from_form(Form, RecDict)]), + print_types1(T, RecDict); +print_types1([{record, _Name} = Key|T], RecDict) -> + {ok, [{Arity, Fields} = AF]} = dict:find(Key, RecDict), + io:format("~w: ~w\n\n", [Key, AF]), + print_types1(T, RecDict). +-define(debug(D_), print_types(D_)). +-else. +-define(debug(D_), ok). +-endif. + %% %% Types that need to be imported from somewhere else %% @@ -61,13 +87,13 @@ %% ============================================================================ -spec get_abstract_code_from_src(atom() | file:filename()) -> - {'ok', abstract_code()} | {'error', [string()]}. + {'ok', abstract_code()} | {'error', [string()]}. get_abstract_code_from_src(File) -> get_abstract_code_from_src(File, src_compiler_opts()). -spec get_abstract_code_from_src(atom() | file:filename(), comp_options()) -> - {'ok', abstract_code()} | {'error', [string()]}. + {'ok', abstract_code()} | {'error', [string()]}. get_abstract_code_from_src(File, Opts) -> case compile:file(File, [to_pp, binary|Opts]) of @@ -137,60 +163,60 @@ get_core_from_abstract_code(AbstrCode, Opts) -> %% ============================================================================ -spec get_record_and_type_info(abstract_code()) -> - {'ok', dict()} | {'error', string()}. + {'ok', dict()} | {'error', string()}. get_record_and_type_info(AbstractCode) -> Module = get_module(AbstractCode), get_record_and_type_info(AbstractCode, Module, dict:new()). -spec get_record_and_type_info(abstract_code(), atom(), dict()) -> - {'ok', dict()} | {'error', string()}. + {'ok', dict()} | {'error', string()}. + +get_record_and_type_info(AbstractCode, Module, RecDict) -> + get_record_and_type_info(AbstractCode, Module, [], RecDict). get_record_and_type_info([{attribute, _, record, {Name, Fields0}}|Left], - Module, RecDict) -> - case get_record_fields(Fields0, RecDict) of - {ok, Fields} -> - Arity = length(Fields), - Fun = fun(OldOrdDict) -> orddict:store(Arity, Fields, OldOrdDict) end, - NewRecDict = dict:update({record, Name}, Fun, [{Arity, Fields}], RecDict), - get_record_and_type_info(Left, Module, NewRecDict); - {error, Error} -> - {error, lists:flatten(io_lib:format(" Error while parsing #~w{}: ~s\n", - [Name, Error]))} - end; + Module, Records, RecDict) -> + {ok, Fields} = get_record_fields(Fields0, RecDict), + Arity = length(Fields), + NewRecDict = dict:store({record, Name}, [{Arity, Fields}], RecDict), + get_record_and_type_info(Left, Module, [{record, Name}|Records], NewRecDict); get_record_and_type_info([{attribute, _, type, {{record, Name}, Fields0, []}} - |Left], Module, RecDict) -> + |Left], Module, Records, RecDict) -> %% This overrides the original record declaration. - case get_record_fields(Fields0, RecDict) of - {ok, Fields} -> - Arity = length(Fields), - Fun = fun(OldOrdDict) -> orddict:store(Arity, Fields, OldOrdDict) end, - NewRecDict = dict:update({record, Name}, Fun, [{Arity, Fields}], RecDict), - get_record_and_type_info(Left, Module, NewRecDict); - {error, Error} -> - {error, lists:flatten(io_lib:format(" Error while parsing #~w{}: ~s\n", - [Name, Error]))} - end; + {ok, Fields} = get_record_fields(Fields0, RecDict), + Arity = length(Fields), + NewRecDict = dict:store({record, Name}, [{Arity, Fields}], RecDict), + get_record_and_type_info(Left, Module, Records, NewRecDict); get_record_and_type_info([{attribute, _, Attr, {Name, TypeForm}}|Left], - Module, RecDict) when Attr =:= 'type'; Attr =:= 'opaque' -> + Module, Records, RecDict) when Attr =:= 'type'; + Attr =:= 'opaque' -> try NewRecDict = add_new_type(Attr, Name, TypeForm, [], Module, RecDict), - get_record_and_type_info(Left, Module, NewRecDict) + get_record_and_type_info(Left, Module, Records, NewRecDict) catch throw:{error, _} = Error -> Error end; get_record_and_type_info([{attribute, _, Attr, {Name, TypeForm, Args}}|Left], - Module, RecDict) when Attr =:= 'type'; Attr =:= 'opaque' -> + Module, Records, RecDict) when Attr =:= 'type'; + Attr =:= 'opaque' -> try NewRecDict = add_new_type(Attr, Name, TypeForm, Args, Module, RecDict), - get_record_and_type_info(Left, Module, NewRecDict) + get_record_and_type_info(Left, Module, Records, NewRecDict) catch throw:{error, _} = Error -> Error end; -get_record_and_type_info([_Other|Left], Module, RecDict) -> - get_record_and_type_info(Left, Module, RecDict); -get_record_and_type_info([], _Module, RecDict) -> - {ok, RecDict}. +get_record_and_type_info([_Other|Left], Module, Records, RecDict) -> + get_record_and_type_info(Left, Module, Records, RecDict); +get_record_and_type_info([], _Module, Records, RecDict) -> + case type_record_fields(lists:reverse(Records), RecDict) of + {ok, _NewRecDict} = Ok -> + ?debug(NewRecDict), + Ok; + {Name, {error, Error}} -> + {error, lists:flatten(io_lib:format(" Error while parsing #~w{}: ~s\n", + [Name, Error]))} + end. add_new_type(TypeOrOpaque, Name, TypeForm, ArgForms, Module, RecDict) -> case erl_types:type_is_defined(TypeOrOpaque, Name, RecDict) of @@ -198,7 +224,6 @@ add_new_type(TypeOrOpaque, Name, TypeForm, ArgForms, Module, RecDict) -> throw({error, io_lib:format("Type already defined: ~w\n", [Name])}); false -> ArgTypes = [erl_types:t_from_form(X) || X <- ArgForms], - _Type = erl_types:t_from_form(TypeForm, RecDict), case lists:all(fun erl_types:t_is_var/1, ArgTypes) of true -> ArgNames = [erl_types:t_var_name(X) || X <- ArgTypes], @@ -219,21 +244,36 @@ get_record_fields([{typed_record_field, OrdRecField, TypeForm}|Left], {record_field, _Line, Name0} -> erl_parse:normalise(Name0); {record_field, _Line, Name0, _Init} -> erl_parse:normalise(Name0) end, - try - Type = erl_types:t_from_form(TypeForm, RecDict), - get_record_fields(Left, RecDict, [{Name, Type}|Acc]) - catch - throw:{error, _} = Error -> Error - end; + get_record_fields(Left, RecDict, [{Name, TypeForm}|Acc]); get_record_fields([{record_field, _Line, Name}|Left], RecDict, Acc) -> - NewAcc = [{erl_parse:normalise(Name), erl_types:t_any()}|Acc], + NewAcc = [{erl_parse:normalise(Name), {var, -1, '_'}}|Acc], get_record_fields(Left, RecDict, NewAcc); get_record_fields([{record_field, _Line, Name, _Init}|Left], RecDict, Acc) -> - NewAcc = [{erl_parse:normalise(Name), erl_types:t_any()}|Acc], + NewAcc = [{erl_parse:normalise(Name), {var, -1, '_'}}|Acc], get_record_fields(Left, RecDict, NewAcc); get_record_fields([], _RecDict, Acc) -> {ok, lists:reverse(Acc)}. +type_record_fields([], RecDict) -> + {ok, RecDict}; +type_record_fields([RecKey|Recs], RecDict) -> + {ok, [{Arity, Fields}]} = dict:find(RecKey, RecDict), + try + TypedFields = + [{FieldName, erl_types:t_from_form(FieldTypeForm, RecDict)} + || {FieldName, FieldTypeForm} <- Fields], + RecDict1 = dict:store(RecKey, [{Arity, TypedFields}], RecDict), + Fun = fun(OldOrdDict) -> + orddict:store(Arity, TypedFields, OldOrdDict) + end, + RecDict2 = dict:update(RecKey, Fun, RecDict1), + type_record_fields(Recs, RecDict2) + catch + throw:{error, _} = Error -> + {record, Name} = RecKey, + {Name, Error} + end. + -spec process_record_remote_types(dialyzer_codeserver:codeserver()) -> dialyzer_codeserver:codeserver(). process_record_remote_types(CServer) -> @@ -269,7 +309,7 @@ merge_records(NewRecords, OldRecords) -> %% ============================================================================ -spec get_spec_info(module(), abstract_code(), dict()) -> - {'ok', dict()} | {'error', string()}. + {'ok', dict()} | {'error', string()}. get_spec_info(ModName, AbstractCode, RecordsDict) -> get_spec_info(AbstractCode, dict:new(), RecordsDict, ModName, "nofile"). diff --git a/lib/dialyzer/vsn.mk b/lib/dialyzer/vsn.mk index a946959256..e3e3f6d668 100644 --- a/lib/dialyzer/vsn.mk +++ b/lib/dialyzer/vsn.mk @@ -1 +1 @@ -DIALYZER_VSN = 2.1.0 +DIALYZER_VSN = 2.2.0 diff --git a/lib/hipe/cerl/erl_bif_types.erl b/lib/hipe/cerl/erl_bif_types.erl index 8aa2cc76c7..ee0ddd6915 100644 --- a/lib/hipe/cerl/erl_bif_types.erl +++ b/lib/hipe/cerl/erl_bif_types.erl @@ -102,6 +102,7 @@ t_list_elements/1, t_list_termination/1, t_mfa/0, + t_module/0, t_nil/0, t_node/0, t_none/0, @@ -694,6 +695,8 @@ type(erlang, binary_to_list, 3, Xs) -> fun (_) -> t_list(t_byte()) end); type(erlang, binary_to_term, 1, Xs) -> strict(arg_types(erlang, binary_to_term, 1), Xs, fun (_) -> t_any() end); +type(erlang, binary_to_term, 2, Xs) -> + strict(arg_types(erlang, binary_to_term, 2), Xs, fun (_) -> t_any() end); type(erlang, bitsize, 1, Xs) -> % XXX: TAKE OUT type(erlang, bit_size, 1, Xs); type(erlang, bit_size, 1, Xs) -> @@ -3127,20 +3130,20 @@ arith(Op, X1, X2) -> end, %% io:format("done arith ~p = ~p~n", [Op, {NewMin, NewMax}]), {ok, t_from_range(NewMin, NewMax)}; - false -> + false -> %% Some of these arithmetic operations might throw a system_limit %% exception; for example, when trying to evaluate 1 bsl 100000000. try case Op of - '+' -> [X + Y || X <- L1, Y <- L2]; - '-' -> [X - Y || X <- L1, Y <- L2]; - '*' -> [X * Y || X <- L1, Y <- L2]; - 'div' -> [X div Y || X <- L1, Y <- L2,Y =/= 0]; - 'rem' -> [X rem Y || X <- L1, Y <- L2,Y =/= 0]; - 'bsl' -> [X bsl Y || X <- L1, Y <- L2]; - 'bsr' -> [X bsr Y || X <- L1, Y <- L2]; - 'band' -> [X band Y || X <- L1, Y <- L2]; - 'bor' -> [X bor Y || X <- L1, Y <- L2]; - 'bxor' -> [X bxor Y || X <- L1, Y <- L2] + '+' -> [X + Y || X <- L1, Y <- L2]; + '-' -> [X - Y || X <- L1, Y <- L2]; + '*' -> [X * Y || X <- L1, Y <- L2]; + 'div' -> [X div Y || X <- L1, Y <- L2, Y =/= 0]; + 'rem' -> [X rem Y || X <- L1, Y <- L2, Y =/= 0]; + 'bsl' -> [X bsl Y || X <- L1, Y <- L2]; + 'bsr' -> [X bsr Y || X <- L1, Y <- L2]; + 'band' -> [X band Y || X <- L1, Y <- L2]; + 'bor' -> [X bor Y || X <- L1, Y <- L2]; + 'bxor' -> [X bxor Y || X <- L1, Y <- L2] end of AllVals -> {ok, t_integers(ordsets:from_list(AllVals))} @@ -3338,8 +3341,7 @@ arg_types(erlang, abs, 1) -> arg_types(erlang, append_element, 2) -> [t_tuple(), t_any()]; arg_types(erlang, apply, 2) -> - [t_sup(t_tuple([t_sup(t_atom(), % module name - t_tuple()), % parameterized module + [t_sup(t_tuple([t_module(), t_atom()]), t_fun()), t_list()]; @@ -3359,6 +3361,8 @@ arg_types(erlang, binary_to_list, 3) -> [t_binary(), t_pos_integer(), t_pos_integer()]; % I want fixnum, but cannot arg_types(erlang, binary_to_term, 1) -> [t_binary()]; +arg_types(erlang, binary_to_term, 2) -> + [t_binary(), t_list(t_atom('safe'))]; arg_types(erlang, bitsize, 1) -> % XXX: TAKE OUT arg_types(erlang, bit_size, 1); arg_types(erlang, bit_size, 1) -> @@ -4351,6 +4355,7 @@ structure_inspecting_args(erlang, is_pid, 1) -> [1]; structure_inspecting_args(erlang, is_port, 1) -> [1]; structure_inspecting_args(erlang, is_reference, 1) -> [1]; structure_inspecting_args(erlang, is_tuple, 1) -> [1]; +structure_inspecting_args(erlang, length, 1) -> [1]; %%structure_inspecting_args(erlang, setelement, 3) -> [2]. structure_inspecting_args(_, _, _) -> []. % XXX: assume no arg needs inspection diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index fac308d0c6..871856da83 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -97,6 +97,7 @@ t_inf/3, t_inf_lists/2, t_inf_lists/3, + t_inf_lists_masked/3, t_integer/0, t_integer/1, t_non_neg_integer/0, @@ -167,6 +168,7 @@ t_opaque_match_record/2, t_opaque_matching_structure/2, t_opaque_structure/1, + %% t_parameterized_module/0, t_pid/0, t_port/0, t_maybe_improper_list/0, @@ -194,9 +196,11 @@ t_tuple_sizes/1, t_tuple_subtypes/1, t_unify/2, + t_unify/3, t_unit/0, t_unopaque/1, t_unopaque/2, + t_unopaque_on_mismatch/3, t_var/1, t_var_name/1, %% t_assign_variables_to_subtype/2, @@ -227,6 +231,8 @@ %% Limits %% +-define(REC_TYPE_LIMIT, 2). + -define(TUPLE_TAG_LIMIT, 5). -define(TUPLE_ARITY_LIMIT, 10). -define(SET_LIMIT, 13). @@ -590,33 +596,48 @@ t_opaque_tuple_tags(OpaqueStruct) -> end. %% Decompose opaque instances of type arg2 to structured types, in arg1 --spec t_struct_from_opaque(erl_type(), erl_type()) -> erl_type(). - -t_struct_from_opaque(?function(Domain, Range), Opaque) -> - ?function(t_struct_from_opaque(Domain, Opaque), - t_struct_from_opaque(Range, Opaque)); -t_struct_from_opaque(?list(Types, Term, Size), Opaque) -> - ?list(t_struct_from_opaque(Types, Opaque), Term, Size); -t_struct_from_opaque(?opaque(_) = T, Opaque) -> - case T =:= Opaque of +%% XXX: Same as t_unopaque +-spec t_struct_from_opaque(erl_type(), [erl_type()]) -> erl_type(). + +t_struct_from_opaque(?function(Domain, Range), Opaques) -> + ?function(t_struct_from_opaque(Domain, Opaques), + t_struct_from_opaque(Range, Opaques)); +t_struct_from_opaque(?list(Types, Term, Size), Opaques) -> + ?list(t_struct_from_opaque(Types, Opaques), Term, Size); +t_struct_from_opaque(?opaque(_) = T, Opaques) -> + case lists:member(T, Opaques) of true -> t_opaque_structure(T); false -> T end; -t_struct_from_opaque(?product(Types), Opaque) -> - ?product(list_struct_from_opaque(Types, Opaque)); -t_struct_from_opaque(?tuple(?any, _, _) = T, _Opaque) -> T; -t_struct_from_opaque(?tuple(Types, Arity, Tag), Opaque) -> - ?tuple(list_struct_from_opaque(Types, Opaque), Arity, Tag); -t_struct_from_opaque(?tuple_set(Set), Opaque) -> - NewSet = [{Sz, [t_struct_from_opaque(T, Opaque) || T <- Tuples]} +t_struct_from_opaque(?product(Types), Opaques) -> + ?product(list_struct_from_opaque(Types, Opaques)); +t_struct_from_opaque(?tuple(?any, _, _) = T, _Opaques) -> T; +t_struct_from_opaque(?tuple(Types, Arity, Tag), Opaques) -> + ?tuple(list_struct_from_opaque(Types, Opaques), Arity, Tag); +t_struct_from_opaque(?tuple_set(Set), Opaques) -> + NewSet = [{Sz, [t_struct_from_opaque(T, Opaques) || T <- Tuples]} || {Sz, Tuples} <- Set], ?tuple_set(NewSet); -t_struct_from_opaque(?union(List), Opaque) -> - t_sup(list_struct_from_opaque(List, Opaque)); -t_struct_from_opaque(Type, _Opaque) -> Type. - -list_struct_from_opaque(Types, Opaque) -> - [t_struct_from_opaque(Type, Opaque) || Type <- Types]. +t_struct_from_opaque(?union(List), Opaques) -> + t_sup(list_struct_from_opaque(List, Opaques)); +t_struct_from_opaque(Type, _Opaques) -> Type. + +list_struct_from_opaque(Types, Opaques) -> + [t_struct_from_opaque(Type, Opaques) || Type <- Types]. + +-spec t_unopaque_on_mismatch(erl_type(), erl_type(), [erl_type()]) -> erl_type(). + +t_unopaque_on_mismatch(GenType, Type, Opaques) -> + case t_inf(GenType, Type) of + ?none -> + Unopaqued = t_unopaque(Type, Opaques), + %% Unions might be a problem, must investigate. + case t_inf(GenType, Unopaqued) of + ?none -> Type; + _ -> Unopaqued + end; + _ -> Type + end. -spec module_builtin_opaques(module()) -> [erl_type()]. @@ -630,7 +651,7 @@ module_builtin_opaques(Module) -> -spec t_remote(module(), atom(), [_]) -> erl_type(). t_remote(Mod, Name, Args) -> - ?remote(set_singleton(#remote{mod=Mod, name=Name, args=Args})). + ?remote(set_singleton(#remote{mod = Mod, name = Name, args = Args})). -spec t_is_remote(erl_type()) -> boolean(). @@ -640,78 +661,124 @@ t_is_remote(_) -> false. -spec t_solve_remote(erl_type(), dict()) -> erl_type(). t_solve_remote(Type , Records) -> - t_solve_remote(Type, Records, ordsets:new()). + {RT, _RR} = t_solve_remote(Type, Records, []), + RT. t_solve_remote(?function(Domain, Range), R, C) -> - ?function(t_solve_remote(Domain, R, C), t_solve_remote(Range, R, C)); + {RT1, RR1} = t_solve_remote(Domain, R, C), + {RT2, RR2} = t_solve_remote(Range, R, C), + {?function(RT1, RT2), RR1 ++ RR2}; t_solve_remote(?list(Types, Term, Size), R, C) -> - ?list(t_solve_remote(Types, R, C), Term, Size); + {RT, RR} = t_solve_remote(Types, R, C), + {?list(RT, Term, Size), RR}; t_solve_remote(?product(Types), R, C) -> - ?product(list_solve_remote(Types, R, C)); + {RL, RR} = list_solve_remote(Types, R, C), + {?product(RL), RR}; t_solve_remote(?opaque(Set), R, C) -> List = ordsets:to_list(Set), - NewList = [Remote#opaque{struct = t_solve_remote(Struct, R, C)} - || Remote = #opaque{struct = Struct} <- List], - ?opaque(ordsets:from_list(NewList)); -t_solve_remote(?tuple(?any, _, _) = T, _R, _C) -> T; + {NewList, RR} = opaques_solve_remote(List, R, C), + {?opaque(ordsets:from_list(NewList)), RR}; +t_solve_remote(?tuple(?any, _, _) = T, _R, _C) -> {T, []}; t_solve_remote(?tuple(Types, Arity, Tag), R, C) -> - ?tuple(list_solve_remote(Types, R, C), Arity, Tag); -t_solve_remote(?tuple_set(Set), R, C) -> - NewSet = [{Sz, [t_solve_remote(T, R, C) || T <- Tuples]} || {Sz, Tuples} <- Set], - ?tuple_set(NewSet); + {RL, RR} = list_solve_remote(Types, R, C), + {?tuple(RL, Arity, Tag), RR}; +t_solve_remote(?tuple_set(Set), R, C) -> + {NewSet, RR} = tuples_solve_remote(Set, R, C), + {?tuple_set(NewSet), RR}; t_solve_remote(?remote(Set), R, C) -> - Cycle = ordsets:intersection(Set, C), - case ordsets:size(Cycle) of - 0 -> ok; - _ -> - CycleMsg = "Cycle detected while processing remote types: " ++ - t_to_string(?remote(C), dict:new()), - throw({error, CycleMsg}) - end, - NewCycle = ordsets:union(C, Set), - TypeFun = - fun(#remote{mod = RemoteModule, name = Name, args = Args}) -> - case dict:find(RemoteModule, R) of - error -> - Msg = io_lib:format("Cannot locate module ~w to " - "resolve the remote type: ~w:~w()~n", - [RemoteModule, RemoteModule, Name]), - throw({error, Msg}); - {ok, RemoteDict} -> - case lookup_type(Name, RemoteDict) of - {type, {_TypeMod, Type, ArgNames}} when length(Args) =:= length(ArgNames) -> - List = lists:zip(ArgNames, Args), - TmpVardict = dict:from_list(List), - NewType = t_from_form(Type, RemoteDict, TmpVardict), - t_solve_remote(NewType, R, NewCycle); - {opaque, {OpModule, Type, ArgNames}} when length(Args) =:= length(ArgNames) -> - List = lists:zip(ArgNames, Args), - TmpVardict = dict:from_list(List), - Rep = t_from_form(Type, RemoteDict, TmpVardict), - NewRep = t_solve_remote(Rep, R, NewCycle), - t_from_form({opaque, -1, Name, {OpModule, Args, NewRep}}, - RemoteDict, TmpVardict); - {type, _} -> - Msg = io_lib:format("Unknown remote type ~w\n", [Name]), - throw({error, Msg}); - {opaque, _} -> - Msg = io_lib:format("Unknown remote opaque type ~w\n", [Name]), - throw({error, Msg}); - error -> - Msg = io_lib:format("Unable to find remote type ~w:~w()\n", - [RemoteModule, Name]), - throw({error, Msg}) - end - end - end, RemoteList = ordsets:to_list(Set), - t_sup([TypeFun(RemoteType) || RemoteType <- RemoteList]); -t_solve_remote(?union(List), R, C) -> - t_sup(list_solve_remote(List, R, C)); -t_solve_remote(T, _R, _C) -> T. + {RL, RR} = list_solve_remote_type(RemoteList, R, C), + {t_sup(RL), RR}; +t_solve_remote(?union(List), R, C) -> + {RL, RR} = list_solve_remote(List, R, C), + {t_sup(RL), RR}; +t_solve_remote(T, _R, _C) -> {T, []}. + +t_solve_remote_type(#remote{mod = RemMod, name = Name, args = Args} = RemType, + R, C) -> + case dict:find(RemMod, R) of + error -> + Msg = io_lib:format("Cannot locate module ~w to " + "resolve the remote type: ~w:~w()~n", + [RemMod, RemMod, Name]), + throw({error, Msg}); + {ok, RemDict} -> + case lookup_type(Name, RemDict) of + {type, {_Mod, Type, ArgNames}} when length(Args) =:= length(ArgNames) -> + {NewType, NewCycle, NewRR} = + case unfold(RemType, C) of + true -> + List = lists:zip(ArgNames, Args), + TmpVarDict = dict:from_list(List), + {t_from_form(Type, RemDict, TmpVarDict), [RemType|C], []}; + false -> {t_any(), C, [RemType]} + end, + {RT, RR} = t_solve_remote(NewType, R, NewCycle), + RetRR = NewRR ++ RR, + RT1 = + case lists:member(RemType, RetRR) of + true -> t_limit(RT, ?REC_TYPE_LIMIT); + false -> RT + end, + {RT1, RetRR}; + {opaque, {Mod, Type, ArgNames}} when length(Args) =:= length(ArgNames) -> + List = lists:zip(ArgNames, Args), + TmpVarDict = dict:from_list(List), + {Rep, NewCycle, NewRR} = + case unfold(RemType, C) of + true -> {t_from_form(Type, RemDict, TmpVarDict), [RemType|C], []}; + false -> {t_any(), C, [RemType]} + end, + {NewRep, RR} = t_solve_remote(Rep, R, NewCycle), + RetRR = NewRR ++ RR, + RT1 = + case lists:member(RemType, RetRR) of + true -> t_limit(NewRep, ?REC_TYPE_LIMIT); + false -> NewRep + end, + {t_from_form({opaque, -1, Name, {Mod, Args, RT1}}, + RemDict, TmpVarDict), + RetRR}; + {type, _} -> + Msg = io_lib:format("Unknown remote type ~w\n", [Name]), + throw({error, Msg}); + {opaque, _} -> + Msg = io_lib:format("Unknown remote opaque type ~w\n", [Name]), + throw({error, Msg}); + error -> + Msg = io_lib:format("Unable to find remote type ~w:~w()\n", + [RemMod, Name]), + throw({error, Msg}) + end + end. -list_solve_remote(Types, R, C) -> - [t_solve_remote(Type, R, C) || Type <- Types]. +list_solve_remote([], _R, _C) -> + {[], []}; +list_solve_remote([Type|Types], R, C) -> + {RT, RR1} = t_solve_remote(Type, R, C), + {RL, RR2} = list_solve_remote(Types, R, C), + {[RT|RL], RR1 ++ RR2}. + +list_solve_remote_type([], _R, _C) -> + {[], []}; +list_solve_remote_type([Type|Types], R, C) -> + {RT, RR1} = t_solve_remote_type(Type, R, C), + {RL, RR2} = list_solve_remote_type(Types, R, C), + {[RT|RL], RR1 ++ RR2}. + +opaques_solve_remote([], _R, _C) -> + {[], []}; +opaques_solve_remote([#opaque{struct = Struct} = Remote|Tail], R, C) -> + {RT, RR1} = t_solve_remote(Struct, R, C), + {LOp, RR2} = opaques_solve_remote(Tail, R, C), + {[Remote#opaque{struct = RT}|LOp], RR1 ++ RR2}. + +tuples_solve_remote([], _R, _C) -> + {[], []}; +tuples_solve_remote([{Sz, Tuples}|Tail], R, C) -> + {RL, RR1} = list_solve_remote(Tuples, R, C), + {LSzTpls, RR2} = tuples_solve_remote(Tail, R, C), + {[{Sz, RL}|LSzTpls], RR1 ++ RR2}. %%----------------------------------------------------------------------------- %% Unit type. Signals non termination. @@ -1432,7 +1499,7 @@ t_mfa() -> -spec t_module() -> erl_type(). t_module() -> - t_atom(). + t_sup(t_atom(), t_parameterized_module()). -spec t_node() -> erl_type(). @@ -1457,6 +1524,11 @@ t_iolist(N) when N > 0 -> t_iolist(0) -> t_maybe_improper_list(t_any(), t_sup(t_binary(), t_nil())). +-spec t_parameterized_module() -> erl_type(). + +t_parameterized_module() -> + t_tuple(). + -spec t_timeout() -> erl_type(). t_timeout() -> @@ -2219,9 +2291,23 @@ t_inf(T, ?union(U2), Mode) -> ?union(U1) = force_union(T), inf_union(U1, U2, Mode); %% and as a result, the cases for ?opaque should appear *after* ?union -t_inf(?opaque(Set1), ?opaque(Set2), _Mode) -> +t_inf(?opaque(Set1) = T1, ?opaque(Set2) = T2, Mode) -> case set_intersection(Set1, Set2) of - ?none -> ?none; + ?none -> + case Mode =:= opaque of + true -> + Struct1 = t_opaque_structure(T1), + case t_inf(Struct1, T2) of + ?none -> + Struct2 = t_opaque_structure(T2), + case t_inf(Struct2, T1) of + ?none -> ?none; + _ -> T2 + end; + _ -> T1 + end; + false -> ?none + end; NewSet -> ?opaque(NewSet) end; t_inf(?opaque(_) = T1, T2, opaque) -> @@ -2272,6 +2358,12 @@ t_inf_lists_strict([T1|Left1], [T2|Left2], Acc, Mode) -> t_inf_lists_strict([], [], Acc, _Mode) -> lists:reverse(Acc). +-spec t_inf_lists_masked([erl_type()], [erl_type()], [t_inf_mode()]) -> [erl_type()]. + +t_inf_lists_masked(List1, List2, Mask) -> + List = lists:zip3(List1, List2, Mask), + [t_inf(T1, T2, Mode) || {T1, T2, Mode} <- List]. + inf_tuple_sets(L1, L2, Mode) -> case inf_tuple_sets(L1, L2, [], Mode) of [] -> ?none; @@ -2434,82 +2526,112 @@ t_subst(T, _Dict, _Fun) -> -spec t_unify(erl_type(), erl_type()) -> {erl_type(), [{_, erl_type()}]}. t_unify(T1, T2) -> - {T, Dict} = t_unify(T1, T2, dict:new()), + t_unify(T1, T2, []). + +-spec t_unify(erl_type(), erl_type(), [erl_type()]) -> {erl_type(), [{_, erl_type()}]}. + +t_unify(T1, T2, Opaques) -> + {T, Dict} = t_unify(T1, T2, dict:new(), Opaques), {t_subst(T, Dict), lists:keysort(1, dict:to_list(Dict))}. -t_unify(?var(Id) = T, ?var(Id), Dict) -> +t_unify(?var(Id) = T, ?var(Id), Dict, _Opaques) -> {T, Dict}; -t_unify(?var(Id1) = T, ?var(Id2), Dict) -> +t_unify(?var(Id1) = T, ?var(Id2), Dict, Opaques) -> case dict:find(Id1, Dict) of error -> case dict:find(Id2, Dict) of error -> {T, dict:store(Id2, T, Dict)}; - {ok, Type} -> {Type, t_unify(T, Type, Dict)} + {ok, Type} -> {Type, t_unify(T, Type, Dict, Opaques)} end; {ok, Type1} -> case dict:find(Id2, Dict) of error -> {Type1, dict:store(Id2, T, Dict)}; - {ok, Type2} -> t_unify(Type1, Type2, Dict) + {ok, Type2} -> t_unify(Type1, Type2, Dict, Opaques) end end; -t_unify(?var(Id), Type, Dict) -> +t_unify(?var(Id), Type, Dict, Opaques) -> case dict:find(Id, Dict) of error -> {Type, dict:store(Id, Type, Dict)}; - {ok, VarType} -> t_unify(VarType, Type, Dict) + {ok, VarType} -> t_unify(VarType, Type, Dict, Opaques) end; -t_unify(Type, ?var(Id), Dict) -> +t_unify(Type, ?var(Id), Dict, Opaques) -> case dict:find(Id, Dict) of error -> {Type, dict:store(Id, Type, Dict)}; - {ok, VarType} -> t_unify(VarType, Type, Dict) + {ok, VarType} -> t_unify(VarType, Type, Dict, Opaques) end; -t_unify(?function(Domain1, Range1), ?function(Domain2, Range2), Dict) -> - {Domain, Dict1} = t_unify(Domain1, Domain2, Dict), - {Range, Dict2} = t_unify(Range1, Range2, Dict1), +t_unify(?function(Domain1, Range1), ?function(Domain2, Range2), Dict, Opaques) -> + {Domain, Dict1} = t_unify(Domain1, Domain2, Dict, Opaques), + {Range, Dict2} = t_unify(Range1, Range2, Dict1, Opaques), {?function(Domain, Range), Dict2}; t_unify(?list(Contents1, Termination1, Size), - ?list(Contents2, Termination2, Size), Dict) -> - {Contents, Dict1} = t_unify(Contents1, Contents2, Dict), - {Termination, Dict2} = t_unify(Termination1, Termination2, Dict1), + ?list(Contents2, Termination2, Size), Dict, Opaques) -> + {Contents, Dict1} = t_unify(Contents1, Contents2, Dict, Opaques), + {Termination, Dict2} = t_unify(Termination1, Termination2, Dict1, Opaques), {?list(Contents, Termination, Size), Dict2}; -t_unify(?product(Types1), ?product(Types2), Dict) -> - {Types, Dict1} = unify_lists(Types1, Types2, Dict), +t_unify(?product(Types1), ?product(Types2), Dict, Opaques) -> + {Types, Dict1} = unify_lists(Types1, Types2, Dict, Opaques), {?product(Types), Dict1}; -t_unify(?tuple(?any, ?any, ?any) = T, ?tuple(?any, ?any, ?any), Dict) -> +t_unify(?tuple(?any, ?any, ?any) = T, ?tuple(?any, ?any, ?any), Dict, _Opaques) -> {T, Dict}; t_unify(?tuple(Elements1, Arity, _), - ?tuple(Elements2, Arity, _), Dict) when Arity =/= ?any -> - {NewElements, Dict1} = unify_lists(Elements1, Elements2, Dict), + ?tuple(Elements2, Arity, _), Dict, Opaques) when Arity =/= ?any -> + {NewElements, Dict1} = unify_lists(Elements1, Elements2, Dict, Opaques), {t_tuple(NewElements), Dict1}; t_unify(?tuple_set([{Arity, _}]) = T1, - ?tuple(_, Arity, _) = T2, Dict) when Arity =/= ?any -> - unify_tuple_set_and_tuple(T1, T2, Dict); + ?tuple(_, Arity, _) = T2, Dict, Opaques) when Arity =/= ?any -> + unify_tuple_set_and_tuple(T1, T2, Dict, Opaques); t_unify(?tuple(_, Arity, _) = T1, - ?tuple_set([{Arity, _}]) = T2, Dict) when Arity =/= ?any -> - unify_tuple_set_and_tuple(T2, T1, Dict); -t_unify(?tuple_set(List1), ?tuple_set(List2), Dict) -> + ?tuple_set([{Arity, _}]) = T2, Dict, Opaques) when Arity =/= ?any -> + unify_tuple_set_and_tuple(T2, T1, Dict, Opaques); +t_unify(?tuple_set(List1), ?tuple_set(List2), Dict, Opaques) -> {Tuples, NewDict} = unify_lists(lists:append([T || {_Arity, T} <- List1]), - lists:append([T || {_Arity, T} <- List2]), Dict), + lists:append([T || {_Arity, T} <- List2]), Dict, Opaques), {t_sup(Tuples), NewDict}; -t_unify(T, T, Dict) -> +t_unify(?opaque(Elements) = T, ?opaque(Elements), Dict, _Opaques) -> {T, Dict}; -t_unify(T1, T2, _) -> +t_unify(?opaque(_) = T1, ?opaque(_) = T2, _Dict, _Opaques) -> + throw({mismatch, T1, T2}); +t_unify(Type, ?opaque(_) = OpType, Dict, Opaques) -> + t_unify_with_opaque(Type, OpType, Dict, Opaques); +t_unify(?opaque(_) = OpType, Type, Dict, Opaques) -> + t_unify_with_opaque(Type, OpType, Dict, Opaques); +t_unify(T, T, Dict, _Opaques) -> + {T, Dict}; +t_unify(T1, T2, _, _) -> throw({mismatch, T1, T2}). +t_unify_with_opaque(Type, OpType, Dict, Opaques) -> + case lists:member(OpType, Opaques) of + true -> + Struct = t_opaque_structure(OpType), + try t_unify(Type, Struct, Dict, Opaques) of + {_T, Dict1} -> {OpType, Dict1} + catch + throw:{mismatch, _T1, _T2} -> + case t_inf(OpType, Type, opaque) of + ?none -> throw({mismatch, Type, OpType}); + _ -> {OpType, Dict} + end + end; + false -> + throw({mismatch, Type, OpType}) + end. + unify_tuple_set_and_tuple(?tuple_set([{Arity, List}]), - ?tuple(Elements2, Arity, _), Dict) -> + ?tuple(Elements2, Arity, _), Dict, Opaques) -> %% Can only work if the single tuple has variables at correct places. %% Collapse the tuple set. - {NewElements, Dict1} = unify_lists(sup_tuple_elements(List), Elements2, Dict), + {NewElements, Dict1} = unify_lists(sup_tuple_elements(List), Elements2, Dict, Opaques), {t_tuple(NewElements), Dict1}. -unify_lists(L1, L2, Dict) -> - unify_lists(L1, L2, Dict, []). +unify_lists(L1, L2, Dict, Opaques) -> + unify_lists(L1, L2, Dict, [], Opaques). -unify_lists([T1|Left1], [T2|Left2], Dict, Acc) -> - {NewT, NewDict} = t_unify(T1, T2, Dict), - unify_lists(Left1, Left2, NewDict, [NewT|Acc]); -unify_lists([], [], Dict, Acc) -> +unify_lists([T1|Left1], [T2|Left2], Dict, Acc, Opaques) -> + {NewT, NewDict} = t_unify(T1, T2, Dict, Opaques), + unify_lists(Left1, Left2, NewDict, [NewT|Acc], Opaques); +unify_lists([], [], Dict, Acc, _Opaques) -> {lists:reverse(Acc), Dict}. %%t_assign_variables_to_subtype(T1, T2) -> @@ -3237,123 +3359,218 @@ t_from_form(Form, RecDict) -> -spec t_from_form(parse_form(), dict(), dict()) -> erl_type(). -t_from_form({var, _L, '_'}, _RecDict, _VarDict) -> t_any(); -t_from_form({var, _L, Name}, _RecDict, VarDict) -> +t_from_form(Form, RecDict, VarDict) -> + {T, _R} = t_from_form(Form, [], RecDict, VarDict), + T. + +-type type_names() :: [{'type' | 'opaque' | 'record', atom()}]. +-spec t_from_form(parse_form(), type_names(), dict(), dict()) -> + {erl_type(), type_names()}. + +t_from_form({var, _L, '_'}, _TypeNames, _RecDict, _VarDict) -> + {t_any(), []}; +t_from_form({var, _L, Name}, _TypeNames, _RecDict, VarDict) -> case dict:find(Name, VarDict) of - error -> t_var(Name); - {ok, Val} -> Val + error -> {t_var(Name), []}; + {ok, Val} -> {Val, []} end; -t_from_form({ann_type, _L, [_Var, Type]}, RecDict, VarDict) -> - t_from_form(Type, RecDict, VarDict); -t_from_form({paren_type, _L, [Type]}, RecDict, VarDict) -> - t_from_form(Type, RecDict, VarDict); +t_from_form({ann_type, _L, [_Var, Type]}, TypeNames, RecDict, VarDict) -> + t_from_form(Type, TypeNames, RecDict, VarDict); +t_from_form({paren_type, _L, [Type]}, TypeNames, RecDict, VarDict) -> + t_from_form(Type, TypeNames, RecDict, VarDict); t_from_form({remote_type, _L, [{atom, _, Module}, {atom, _, Type}, Args]}, - RecDict, VarDict) -> - t_remote(Module, Type, [t_from_form(A, RecDict, VarDict) || A <- Args]); -t_from_form({atom, _L, Atom}, _RecDict, _VarDict) -> t_atom(Atom); -t_from_form({integer, _L, Int}, _RecDict, _VarDict) -> t_integer(Int); -t_from_form({type, _L, any, []}, _RecDict, _VarDict) -> t_any(); -t_from_form({type, _L, arity, []}, _RecDict, _VarDict) -> t_arity(); -t_from_form({type, _L, array, []}, _RecDict, _VarDict) -> t_array(); -t_from_form({type, _L, atom, []}, _RecDict, _VarDict) -> t_atom(); -t_from_form({type, _L, binary, []}, _RecDict, _VarDict) -> t_binary(); + TypeNames, RecDict, VarDict) -> + {L, R} = list_from_form(Args, TypeNames, RecDict, VarDict), + {t_remote(Module, Type, L), R}; +t_from_form({atom, _L, Atom}, _TypeNames, _RecDict, _VarDict) -> + {t_atom(Atom), []}; +t_from_form({integer, _L, Int}, _TypeNames, _RecDict, _VarDict) -> + {t_integer(Int), []}; +t_from_form({type, _L, any, []}, _TypeNames, _RecDict, _VarDict) -> + {t_any(), []}; +t_from_form({type, _L, arity, []}, _TypeNames, _RecDict, _VarDict) -> + {t_arity(), []}; +t_from_form({type, _L, array, []}, _TypeNames, _RecDict, _VarDict) -> + {t_array(), []}; +t_from_form({type, _L, atom, []}, _TypeNames, _RecDict, _VarDict) -> + {t_atom(), []}; +t_from_form({type, _L, binary, []}, _TypeNames, _RecDict, _VarDict) -> + {t_binary(), []}; t_from_form({type, _L, binary, [{integer, _, Base}, {integer, _, Unit}]}, - _RecDict, _VarDict) -> - t_bitstr(Unit, Base); -t_from_form({type, _L, bitstring, []}, _RecDict, _VarDict) -> t_bitstr(); -t_from_form({type, _L, bool, []}, _RecDict, _VarDict) -> t_boolean(); % XXX: Temporarily -t_from_form({type, _L, boolean, []}, _RecDict, _VarDict) -> t_boolean(); -t_from_form({type, _L, byte, []}, _RecDict, _VarDict) -> t_byte(); -t_from_form({type, _L, char, []}, _RecDict, _VarDict) -> t_char(); -t_from_form({type, _L, dict, []}, _RecDict, _VarDict) -> t_dict(); -t_from_form({type, _L, digraph, []}, _RecDict, _VarDict) -> t_digraph(); -t_from_form({type, _L, float, []}, _RecDict, _VarDict) -> t_float(); -t_from_form({type, _L, function, []}, _RecDict, _VarDict) -> t_fun(); -t_from_form({type, _L, 'fun', []}, _RecDict, _VarDict) -> t_fun(); -t_from_form({type, _L, 'fun', [{type, _, any, []}, Range]}, RecDict, VarDict) -> - t_fun(t_from_form(Range, RecDict, VarDict)); -t_from_form({type, _L, 'fun', [{type, _, product, Domain}, Range]}, - RecDict, VarDict) -> - t_fun([t_from_form(D, RecDict, VarDict) || D <- Domain], - t_from_form(Range, RecDict, VarDict)); -t_from_form({type, _L, gb_set, []}, _RecDict, _VarDict) -> t_gb_set(); -t_from_form({type, _L, gb_tree, []}, _RecDict, _VarDict) -> t_gb_tree(); -t_from_form({type, _L, identifier, []}, _RecDict, _VarDict) -> t_identifier(); -t_from_form({type, _L, integer, []}, _RecDict, _VarDict) -> t_integer(); -t_from_form({type, _L, iodata, []}, _RecDict, _VarDict) -> t_iodata(); -t_from_form({type, _L, iolist, []}, _RecDict, _VarDict) -> t_iolist(); -t_from_form({type, _L, list, []}, _RecDict, _VarDict) -> t_list(); -t_from_form({type, _L, list, [Type]}, RecDict, VarDict) -> - t_list(t_from_form(Type, RecDict, VarDict)); -t_from_form({type, _L, mfa, []}, _RecDict, _VarDict) -> t_mfa(); -t_from_form({type, _L, module, []}, _RecDict, _VarDict) -> t_module(); -t_from_form({type, _L, nil, []}, _RecDict, _VarDict) -> t_nil(); -t_from_form({type, _L, neg_integer, []}, _RecDict, _VarDict) -> t_neg_integer(); -t_from_form({type, _L, non_neg_integer, []}, _RecDict, _VarDict) -> - t_non_neg_integer(); -t_from_form({type, _L, no_return, []}, _RecDict, _VarDict) -> t_unit(); -t_from_form({type, _L, node, []}, _RecDict, _VarDict) -> t_node(); -t_from_form({type, _L, none, []}, _RecDict, _VarDict) -> t_none(); -t_from_form({type, _L, nonempty_list, []}, _RecDict, _VarDict) -> - t_nonempty_list(); -t_from_form({type, _L, nonempty_list, [Type]}, RecDict, VarDict) -> - t_nonempty_list(t_from_form(Type, RecDict, VarDict)); -t_from_form({type, _L, nonempty_improper_list, [Cont, Term]}, - RecDict, VarDict) -> - t_cons(t_from_form(Cont, RecDict, VarDict), - t_from_form(Term, RecDict, VarDict)); -t_from_form({type, _L, nonempty_maybe_improper_list, []}, _RecDict, _VarDict) -> - t_cons(?any, ?any); -t_from_form({type, _L, nonempty_maybe_improper_list, [Cont, Term]}, - RecDict, VarDict) -> - t_cons(t_from_form(Cont, RecDict, VarDict), - t_from_form(Term, RecDict, VarDict)); -t_from_form({type, _L, nonempty_string, []}, _RecDict, _VarDict) -> - t_nonempty_string(); -t_from_form({type, _L, number, []}, _RecDict, _VarDict) -> t_number(); -t_from_form({type, _L, pid, []}, _RecDict, _VarDict) -> t_pid(); -t_from_form({type, _L, port, []}, _RecDict, _VarDict) -> t_port(); -t_from_form({type, _L, pos_integer, []}, _RecDict, _VarDict) -> t_pos_integer(); -t_from_form({type, _L, maybe_improper_list, []}, _RecDict, _VarDict) -> - t_maybe_improper_list(); -t_from_form({type, _L, maybe_improper_list, [Content, Termination]}, - RecDict, VarDict) -> - t_maybe_improper_list(t_from_form(Content, RecDict, VarDict), - t_from_form(Termination, RecDict, VarDict)); -t_from_form({type, _L, product, Elements}, RecDict, VarDict) -> - t_product([t_from_form(E, RecDict, VarDict) || E <- Elements]); -t_from_form({type, _L, queue, []}, _RecDict, _VarDict) -> t_queue(); + _TypeNames, _RecDict, _VarDict) -> + {t_bitstr(Unit, Base), []}; +t_from_form({type, _L, bitstring, []}, _TypeNames, _RecDict, _VarDict) -> + {t_bitstr(), []}; +t_from_form({type, _L, bool, []}, _TypeNames, _RecDict, _VarDict) -> + {t_boolean(), []}; % XXX: Temporarily +t_from_form({type, _L, boolean, []}, _TypeNames, _RecDict, _VarDict) -> + {t_boolean(), []}; +t_from_form({type, _L, byte, []}, _TypeNames, _RecDict, _VarDict) -> + {t_byte(), []}; +t_from_form({type, _L, char, []}, _TypeNames, _RecDict, _VarDict) -> + {t_char(), []}; +t_from_form({type, _L, dict, []}, _TypeNames, _RecDict, _VarDict) -> + {t_dict(), []}; +t_from_form({type, _L, digraph, []}, _TypeNames, _RecDict, _VarDict) -> + {t_digraph(), []}; +t_from_form({type, _L, float, []}, _TypeNames, _RecDict, _VarDict) -> + {t_float(), []}; +t_from_form({type, _L, function, []}, _TypeNames, _RecDict, _VarDict) -> + {t_fun(), []}; +t_from_form({type, _L, 'fun', []}, _TypeNames, _RecDict, _VarDict) -> + {t_fun(), []}; +t_from_form({type, _L, 'fun', [{type, _, any, []}, Range]}, TypeNames, + RecDict, VarDict) -> + {T, R} = t_from_form(Range, TypeNames, RecDict, VarDict), + {t_fun(T), R}; +t_from_form({type, _L, 'fun', [{type, _, product, Domain}, Range]}, + TypeNames, RecDict, VarDict) -> + {L, R1} = list_from_form(Domain, TypeNames, RecDict, VarDict), + {T, R2} = t_from_form(Range, TypeNames, RecDict, VarDict), + {t_fun(L, T), R1 ++ R2}; +t_from_form({type, _L, gb_set, []}, _TypeNames, _RecDict, _VarDict) -> + {t_gb_set(), []}; +t_from_form({type, _L, gb_tree, []}, _TypeNames, _RecDict, _VarDict) -> + {t_gb_tree(), []}; +t_from_form({type, _L, identifier, []}, _TypeNames, _RecDict, _VarDict) -> + {t_identifier(), []}; +t_from_form({type, _L, integer, []}, _TypeNames, _RecDict, _VarDict) -> + {t_integer(), []}; +t_from_form({type, _L, iodata, []}, _TypeNames, _RecDict, _VarDict) -> + {t_iodata(), []}; +t_from_form({type, _L, iolist, []}, _TypeNames, _RecDict, _VarDict) -> + {t_iolist(), []}; +t_from_form({type, _L, list, []}, _TypeNames, _RecDict, _VarDict) -> + {t_list(), []}; +t_from_form({type, _L, list, [Type]}, TypeNames, RecDict, VarDict) -> + {T, R} = t_from_form(Type, TypeNames, RecDict, VarDict), + {t_list(T), R}; +t_from_form({type, _L, mfa, []}, _TypeNames, _RecDict, _VarDict) -> + {t_mfa(), []}; +t_from_form({type, _L, module, []}, _TypeNames, _RecDict, _VarDict) -> + {t_module(), []}; +t_from_form({type, _L, nil, []}, _TypeNames, _RecDict, _VarDict) -> + {t_nil(), []}; +t_from_form({type, _L, neg_integer, []}, _TypeNames, _RecDict, _VarDict) -> + {t_neg_integer(), []}; +t_from_form({type, _L, non_neg_integer, []}, _TypeNames, _RecDict, _VarDict) -> + {t_non_neg_integer(), []}; +t_from_form({type, _L, no_return, []}, _TypeNames, _RecDict, _VarDict) -> + {t_unit(), []}; +t_from_form({type, _L, node, []}, _TypeNames, _RecDict, _VarDict) -> + {t_node(), []}; +t_from_form({type, _L, none, []}, _TypeNames, _RecDict, _VarDict) -> + {t_none(), []}; +t_from_form({type, _L, nonempty_list, []}, _TypeNames, _RecDict, _VarDict) -> + {t_nonempty_list(), []}; +t_from_form({type, _L, nonempty_list, [Type]}, TypeNames, RecDict, VarDict) -> + {T, R} = t_from_form(Type, TypeNames, RecDict, VarDict), + {t_nonempty_list(T), R}; +t_from_form({type, _L, nonempty_improper_list, [Cont, Term]}, TypeNames, + RecDict, VarDict) -> + {T1, R1} = t_from_form(Cont, TypeNames, RecDict, VarDict), + {T2, R2} = t_from_form(Term, TypeNames, RecDict, VarDict), + {t_cons(T1, T2), R1 ++ R2}; +t_from_form({type, _L, nonempty_maybe_improper_list, []}, _TypeNames, + _RecDict, _VarDict) -> + {t_cons(?any, ?any), []}; +t_from_form({type, _L, nonempty_maybe_improper_list, [Cont, Term]}, TypeNames, + RecDict, VarDict) -> + {T1, R1} = t_from_form(Cont, TypeNames, RecDict, VarDict), + {T2, R2} = t_from_form(Term, TypeNames, RecDict, VarDict), + {t_cons(T1, T2), R1 ++ R2}; +t_from_form({type, _L, nonempty_string, []}, _TypeNames, _RecDict, _VarDict) -> + {t_nonempty_string(), []}; +t_from_form({type, _L, number, []}, _TypeNames, _RecDict, _VarDict) -> + {t_number(), []}; +t_from_form({type, _L, pid, []}, _TypeNames, _RecDict, _VarDict) -> + {t_pid(), []}; +t_from_form({type, _L, port, []}, _TypeNames, _RecDict, _VarDict) -> + {t_port(), []}; +t_from_form({type, _L, pos_integer, []}, _TypeNames, _RecDict, _VarDict) -> + {t_pos_integer(), []}; +t_from_form({type, _L, maybe_improper_list, []}, _TypeNames, _RecDict, + _VarDict) -> + {t_maybe_improper_list(), []}; +t_from_form({type, _L, maybe_improper_list, [Content, Termination]}, TypeNames, + RecDict, VarDict) -> + {T1, R1} = t_from_form(Content, TypeNames, RecDict, VarDict), + {T2, R2} = t_from_form(Termination, TypeNames, RecDict, VarDict), + {t_maybe_improper_list(T1, T2), R1 ++ R2}; +t_from_form({type, _L, product, Elements}, TypeNames, RecDict, VarDict) -> + {L, R} = list_from_form(Elements, TypeNames, RecDict, VarDict), + {t_product(L), R}; +t_from_form({type, _L, queue, []}, _TypeNames, _RecDict, _VarDict) -> + {t_queue(), []}; t_from_form({type, _L, range, [{integer, _, From}, {integer, _, To}]}, - _RecDict, _VarDict) -> - t_from_range(From, To); -t_from_form({type, _L, record, [Name|Fields]}, RecDict, VarDict) -> - record_from_form(Name, Fields, RecDict, VarDict); -t_from_form({type, _L, reference, []}, _RecDict, _VarDict) -> t_reference(); -t_from_form({type, _L, set, []}, _RecDict, _VarDict) -> t_set(); -t_from_form({type, _L, string, []}, _RecDict, _VarDict) -> t_string(); -t_from_form({type, _L, term, []}, _RecDict, _VarDict) -> t_any(); -t_from_form({type, _L, tid, []}, _RecDict, _VarDict) -> t_tid(); -t_from_form({type, _L, timeout, []}, _RecDict, _VarDict) -> t_timeout(); -t_from_form({type, _L, tuple, any}, _RecDict, _VarDict) -> t_tuple(); -t_from_form({type, _L, tuple, Args}, RecDict, VarDict) -> - t_tuple([t_from_form(A, RecDict, VarDict) || A <- Args]); -t_from_form({type, _L, union, Args}, RecDict, VarDict) -> - t_sup([t_from_form(A, RecDict, VarDict) || A <- Args]); -t_from_form({type, _L, Name, Args}, RecDict, VarDict) -> + _TypeNames, _RecDict, _VarDict) -> + {t_from_range(From, To), []}; +t_from_form({type, _L, record, [Name|Fields]}, TypeNames, RecDict, VarDict) -> + record_from_form(Name, Fields, TypeNames, RecDict, VarDict); +t_from_form({type, _L, reference, []}, _TypeNames, _RecDict, _VarDict) -> + {t_reference(), []}; +t_from_form({type, _L, set, []}, _TypeNames, _RecDict, _VarDict) -> + {t_set(), []}; +t_from_form({type, _L, string, []}, _TypeNames, _RecDict, _VarDict) -> + {t_string(), []}; +t_from_form({type, _L, term, []}, _TypeNames, _RecDict, _VarDict) -> + {t_any(), []}; +t_from_form({type, _L, tid, []}, _TypeNames, _RecDict, _VarDict) -> + {t_tid(), []}; +t_from_form({type, _L, timeout, []}, _TypeNames, _RecDict, _VarDict) -> + {t_timeout(), []}; +t_from_form({type, _L, tuple, any}, _TypeNames, _RecDict, _VarDict) -> + {t_tuple(), []}; +t_from_form({type, _L, tuple, Args}, TypeNames, RecDict, VarDict) -> + {L, R} = list_from_form(Args, TypeNames, RecDict, VarDict), + {t_tuple(L), R}; +t_from_form({type, _L, union, Args}, TypeNames, RecDict, VarDict) -> + {L, R} = list_from_form(Args, TypeNames, RecDict, VarDict), + {t_sup(L), R}; +t_from_form({type, _L, Name, Args}, TypeNames, RecDict, VarDict) -> case lookup_type(Name, RecDict) of {type, {_Module, Type, ArgNames}} when length(Args) =:= length(ArgNames) -> - List = lists:zipwith(fun(ArgName, ArgType) -> - {ArgName, t_from_form(ArgType, RecDict, VarDict)} - end, ArgNames, Args), - TmpVardict = dict:from_list(List), - t_from_form(Type, RecDict, TmpVardict); + case unfold({type, Name}, TypeNames) of + true -> + List = lists:zipwith( + fun(ArgName, ArgType) -> + {Ttemp, _R} = t_from_form(ArgType, TypeNames, + RecDict, VarDict), + {ArgName, Ttemp} + end, + ArgNames, Args), + TmpVarDict = dict:from_list(List), + {T, R} = t_from_form(Type, [{type, Name}|TypeNames], RecDict, + TmpVarDict), + case lists:member({type, Name}, R) of + true -> {t_limit(T, ?REC_TYPE_LIMIT), R}; + false -> {T, R} + end; + false -> {t_any(), [{type, Name}]} + end; {opaque, {Module, Type, ArgNames}} when length(Args) =:= length(ArgNames) -> - List = lists:zipwith(fun(ArgName, ArgType) -> - {ArgName, t_from_form(ArgType, RecDict, VarDict)} - end, ArgNames, Args), - TmpVardict = dict:from_list(List), - Rep = t_from_form(Type, RecDict, TmpVardict), - t_from_form({opaque, -1, Name, {Module, Args, Rep}}, RecDict, VarDict); + {Rep, Rret} = + case unfold({opaque, Name}, TypeNames) of + true -> + List = lists:zipwith( + fun(ArgName, ArgType) -> + {Ttemp, _R} = t_from_form(ArgType, TypeNames, + RecDict, VarDict), + {ArgName, Ttemp} + end, + ArgNames, Args), + TmpVarDict = dict:from_list(List), + {T, R} = t_from_form(Type, [{opaque, Name}|TypeNames], RecDict, + TmpVarDict), + case lists:member({opaque, Name}, R) of + true -> {t_limit(T, ?REC_TYPE_LIMIT), R}; + false -> {T, R} + end; + false -> {t_any(), [{opaque, Name}]} + end, + Tret = t_from_form({opaque, -1, Name, {Module, Args, Rep}}, + RecDict, VarDict), + {Tret, Rret}; {type, _} -> throw({error, io_lib:format("Unknown type ~w\n", [Name])}); {opaque, _} -> @@ -3361,48 +3578,70 @@ t_from_form({type, _L, Name, Args}, RecDict, VarDict) -> error -> throw({error, io_lib:format("Unable to find type ~w\n", [Name])}) end; -t_from_form({opaque, _L, Name, {Mod, Args, Rep}}, _RecDict, _VarDict) -> +t_from_form({opaque, _L, Name, {Mod, Args, Rep}}, _TypeNames, _RecDict, + _VarDict) -> case Args of - [] -> t_opaque(Mod, Name, Args, Rep); + [] -> {t_opaque(Mod, Name, Args, Rep), []}; _ -> throw({error, "Polymorphic opaque types not supported yet"}) end. -record_from_form({atom, _, Name}, ModFields, RecDict, VarDict) -> - case lookup_record(Name, RecDict) of - {ok, DeclFields} -> - case get_mod_record(ModFields, DeclFields, RecDict, VarDict) of - {error, FieldName} -> - throw({error, io_lib:format("Illegal declaration of ~w#{~w}\n", - [Name, FieldName])}); - {ok, NewFields} -> - t_tuple([t_atom(Name)|[Type || {_FieldName, Type} <- NewFields]]) +record_from_form({atom, _, Name}, ModFields, TypeNames, RecDict, VarDict) -> + case unfold({record, Name}, TypeNames) of + true -> + case lookup_record(Name, RecDict) of + {ok, DeclFields} -> + TypeNames1 = [{record, Name}|TypeNames], + AreTyped = [is_erl_type(FieldType) + || {_FieldName, FieldType} <- DeclFields], + {DeclFields1, R1} = + case lists:all(fun(Elem) -> Elem end, AreTyped) of + true -> {DeclFields, []}; + false -> fields_from_form(DeclFields, TypeNames1, + RecDict, dict:new()) + end, + {GetModRec, R2} = get_mod_record(ModFields, DeclFields1, + TypeNames1, RecDict, VarDict), + case GetModRec of + {error, FieldName} -> + throw({error, io_lib:format("Illegal declaration of ~w#{~w}\n", + [Name, FieldName])}); + {ok, NewFields} -> + {t_tuple( + [t_atom(Name)|[Type || {_FieldName, Type} <- NewFields]]), + R1 ++ R2} + end; + error -> + throw({error, erlang:error(io_lib:format("Unknown record #~w{}\n", + [Name]))}) end; - error -> - throw({error, - erlang:error(io_lib:format("Unknown record #~w{}\n", [Name]))}) + false -> {t_any(), []} end. -get_mod_record([], DeclFields, _RecDict, _VarDict) -> - {ok, DeclFields}; -get_mod_record(ModFields, DeclFields, RecDict, VarDict) -> +get_mod_record([], DeclFields, _TypeNames, _RecDict, _VarDict) -> + {{ok, DeclFields}, []}; +get_mod_record(ModFields, DeclFields, TypeNames, RecDict, VarDict) -> DeclFieldsDict = orddict:from_list(DeclFields), - ModFieldsDict = build_field_dict(ModFields, RecDict, VarDict), + {ModFieldsDict, R} = build_field_dict(ModFields, TypeNames, + RecDict, VarDict), case get_mod_record(DeclFieldsDict, ModFieldsDict, []) of - {error, _FieldName} = Error -> Error; + {error, _FieldName} = Error -> {Error, R}; {ok, FinalOrdDict} -> - {ok, [{FieldName, orddict:fetch(FieldName, FinalOrdDict)} - || {FieldName, _} <- DeclFields]} + {{ok, [{FieldName, orddict:fetch(FieldName, FinalOrdDict)} + || {FieldName, _} <- DeclFields]}, + R} end. -build_field_dict(FieldTypes, RecDict, VarDict) -> - build_field_dict(FieldTypes, RecDict, VarDict, []). +build_field_dict(FieldTypes, TypeNames, RecDict, VarDict) -> + build_field_dict(FieldTypes, TypeNames, RecDict, VarDict, []). build_field_dict([{type, _, field_type, [{atom, _, Name}, Type]}|Left], - RecDict, VarDict, Acc) -> - NewAcc = [{Name, t_from_form(Type, RecDict, VarDict)}|Acc], - build_field_dict(Left, RecDict, VarDict, NewAcc); -build_field_dict([], _RecDict, _VarDict, Acc) -> - orddict:from_list(Acc). + TypeNames, RecDict, VarDict, Acc) -> + {T, R1} = t_from_form(Type, TypeNames, RecDict, VarDict), + NewAcc = [{Name, T}|Acc], + {D, R2} = build_field_dict(Left, TypeNames, RecDict, VarDict, NewAcc), + {D, R1 ++ R2}; +build_field_dict([], _TypeNames, _RecDict, _VarDict, Acc) -> + {orddict:from_list(Acc), []}. get_mod_record([{FieldName, DeclType}|Left1], [{FieldName, ModType}|Left2], Acc) -> @@ -3419,6 +3658,20 @@ get_mod_record(DeclFields, [], Acc) -> get_mod_record(_, [{FieldName2, _ModType}|_], _Acc) -> {error, FieldName2}. +fields_from_form([], _TypeNames, _RecDict, _VarDict) -> + {[], []}; +fields_from_form([{Name, Type}|Tail], TypeNames, RecDict, VarDict) -> + {T, R1} = t_from_form(Type, TypeNames, RecDict, VarDict), + {F, R2} = fields_from_form(Tail, TypeNames, RecDict, VarDict), + {[{Name, T}|F], R1 ++ R2}. + +list_from_form([], _TypeNames, _RecDict, _VarDict) -> + {[], []}; +list_from_form([H|Tail], TypeNames, RecDict, VarDict) -> + {T, R1} = t_from_form(H, TypeNames, RecDict, VarDict), + {L, R2} = list_from_form(Tail, TypeNames, RecDict, VarDict), + {[T|L], R1 ++ R2}. + -spec t_form_to_string(parse_form()) -> string(). t_form_to_string({var, _L, '_'}) -> "_"; @@ -3510,11 +3763,19 @@ any_none_or_unit([?unit|_]) -> true; any_none_or_unit([_|Left]) -> any_none_or_unit(Left); any_none_or_unit([]) -> false. --spec lookup_record(atom(), dict()) -> 'error' | {'ok', [{atom(), erl_type()}]}. +is_erl_type(?any) -> true; +is_erl_type(?none) -> true; +is_erl_type(?unit) -> true; +is_erl_type(#c{}) -> true; +is_erl_type(_) -> false. + +-spec lookup_record(atom(), dict()) -> + 'error' | {'ok', [{atom(), parse_form() | erl_type()}]}. lookup_record(Tag, RecDict) when is_atom(Tag) -> case dict:find({record, Tag}, RecDict) of - {ok, [{_Arity, Fields}]} -> {ok, Fields}; + {ok, [{_Arity, Fields}]} -> + {ok, Fields}; {ok, List} when is_list(List) -> %% This will have to do, since we do not know which record we %% are looking for. @@ -3547,6 +3808,9 @@ lookup_type(Name, RecDict) -> type_is_defined(TypeOrOpaque, Name, RecDict) -> dict:is_key({TypeOrOpaque, Name}, RecDict). +unfold(TypeName, TypeNames) -> + not lists:member(TypeName, TypeNames). + %% ----------------------------------- %% Set %% |