Merge branch 'ks/hipe' into ccase/r13b04_dev

* ks/hipe:
  dialyzer: Fix system_limit exception in race analysis
  syntax_tools: Add types and specs for most exported functions
  syntax_tools: Support the --enable-native-libs configure option
  syntax_tools: Remove $Id$ annotations
  dialyzer: New version for the R13B04 release
  hipe: Miscellaneous additions
  typer: New version for the R13B04 release
  Fix a HiPE compiler bug evaluating an expression that throws system_limit

OTP-8460  ks/hipe

1 files changed, 324 insertions, 0 deletions

diff --git a/lib/dialyzer/src/dialyzer_behaviours.erl b/lib/dialyzer/src/dialyzer_behaviours.erl
new file mode 100644
index 0000000000..4e8dceaa8e
--- /dev/null
+++ b/lib/dialyzer/src/dialyzer_behaviours.erl
@@ -0,0 +1,324 @@
+%% -*- erlang-indent-level: 2 -*-
+%%-----------------------------------------------------------------------
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010. 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) ->
+  [].