aboutsummaryrefslogtreecommitdiffstats
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/compiler/src/beam_type.erl43
-rw-r--r--lib/compiler/test/beam_type_SUITE.erl29
2 files changed, 62 insertions, 10 deletions
diff --git a/lib/compiler/src/beam_type.erl b/lib/compiler/src/beam_type.erl
index 79f93d7548..acaf3ede66 100644
--- a/lib/compiler/src/beam_type.erl
+++ b/lib/compiler/src/beam_type.erl
@@ -759,7 +759,7 @@ checkerror_2(OrigIs) -> [{set,[],[],fcheckerror}|OrigIs].
%%%
%%% {tuple,Size,First} means that the corresponding register contains a
%%% tuple with *at least* Size elements. An tuple with unknown
-%%% size is represented as {tuple,0}. First is either [] (meaning that
+%%% size is represented as {tuple,0,[]}. First is either [] (meaning that
%%% the tuple's first element is unknown) or [FirstElement] (the contents
%%% of the first element).
%%%
@@ -796,21 +796,45 @@ tdb_copy({Tag,_}=S, D, Ts) when Tag =:= x; Tag =:= y ->
error -> orddict:erase(D, Ts);
Type -> orddict:store(D, Type, Ts)
end;
-tdb_copy(Literal, D, Ts) -> orddict:store(D, Literal, Ts).
+tdb_copy(Literal, D, Ts) ->
+ Type = case Literal of
+ {atom,_} -> Literal;
+ {float,_} -> float;
+ {integer,Int} -> {integer,{Int,Int}};
+ {literal,[_|_]} -> nonempty_list;
+ {literal,#{}} -> map;
+ {literal,Tuple} when tuple_size(Tuple) >= 1 ->
+ Lit = tag_literal(element(1, Tuple)),
+ {tuple,tuple_size(Tuple),[Lit]};
+ _ -> term
+ end,
+ if
+ Type =:= term ->
+ orddict:erase(D, Ts);
+ true ->
+ verify_type(Type),
+ orddict:store(D, Type, Ts)
+ end.
+
+tag_literal(A) when is_atom(A) -> {atom,A};
+tag_literal(F) when is_float(F) -> {float,F};
+tag_literal(I) when is_integer(I) -> {integer,I};
+tag_literal([]) -> nil;
+tag_literal(Lit) -> {literal,Lit}.
%% tdb_update([UpdateOp], Db) -> NewDb
%% UpdateOp = {Register,kill}|{Register,NewInfo}
%% Updates a type database. If a 'kill' operation is given, the type
%% information for that register will be removed from the database.
%% A kill operation takes precedence over other operations for the same
-%% register (i.e. [{{x,0},kill},{{x,0},{tuple,5}}] means that the
+%% register (i.e. [{{x,0},kill},{{x,0},{tuple,5,[]}}] means that the
%% the existing type information, if any, will be discarded, and the
-%% the '{tuple,5}' information ignored.
+%% the '{tuple,5,[]}' information ignored.
%%
%% If NewInfo information is given and there exists information about
%% the register, the old and new type information will be merged.
-%% For instance, {tuple,5} and {tuple,10} will be merged to produce
-%% {tuple,10}.
+%% For instance, {tuple,5,_} and {tuple,10,_} will be merged to produce
+%% {tuple,10,_}.
tdb_update(Uis0, Ts0) ->
Uis1 = filter(fun ({{x,_},_Op}) -> true;
@@ -821,7 +845,8 @@ tdb_update(Uis0, Ts0) ->
tdb_update1([{Key,kill}|Ops], [{K,_Old}|_]=Db) when Key < K ->
tdb_update1(remove_key(Key, Ops), Db);
-tdb_update1([{Key,_New}=New|Ops], [{K,_Old}|_]=Db) when Key < K ->
+tdb_update1([{Key,Type}=New|Ops], [{K,_Old}|_]=Db) when Key < K ->
+ verify_type(Type),
[New|tdb_update1(Ops, Db)];
tdb_update1([{Key,kill}|Ops], [{Key,_}|Db]) ->
tdb_update1(remove_key(Key, Ops), Db);
@@ -831,7 +856,8 @@ tdb_update1([{_,_}|_]=Ops, [Old|Db]) ->
[Old|tdb_update1(Ops, Db)];
tdb_update1([{Key,kill}|Ops], []) ->
tdb_update1(remove_key(Key, Ops), []);
-tdb_update1([{_,_}=New|Ops], []) ->
+tdb_update1([{_,Type}=New|Ops], []) ->
+ verify_type(Type),
[New|tdb_update1(Ops, [])];
tdb_update1([], Db) -> Db.
@@ -866,6 +892,7 @@ merge_type_info(NewType, _) ->
verify_type(NewType),
NewType.
+verify_type({atom,_}) -> ok;
verify_type(boolean) -> ok;
verify_type(integer) -> ok;
verify_type({integer,{Min,Max}})
diff --git a/lib/compiler/test/beam_type_SUITE.erl b/lib/compiler/test/beam_type_SUITE.erl
index 063a27ad8d..69e2f1838d 100644
--- a/lib/compiler/test/beam_type_SUITE.erl
+++ b/lib/compiler/test/beam_type_SUITE.erl
@@ -21,7 +21,8 @@
-export([all/0,suite/0,groups/0,init_per_suite/1,end_per_suite/1,
init_per_group/2,end_per_group/2,
- integers/1,coverage/1,booleans/1,setelement/1]).
+ integers/1,coverage/1,booleans/1,setelement/1,cons/1,
+ tuple/1]).
suite() -> [{ct_hooks,[ts_install_cth]}].
@@ -34,7 +35,9 @@ groups() ->
[integers,
coverage,
booleans,
- setelement
+ setelement,
+ cons,
+ tuple
]}].
init_per_suite(Config) ->
@@ -56,6 +59,8 @@ integers(_Config) ->
a = do_integers_2(<<0:1>>),
{'EXIT',{{case_clause,-1},_}} = (catch do_integers_2(<<1:1>>)),
+ college = do_integers_3(),
+
ok.
do_integers_1(B0) ->
@@ -72,6 +77,12 @@ do_integers_2(Bin) ->
1 -> b
end.
+do_integers_3() ->
+ case try 0 after [] end of
+ 0 -> college;
+ 1 -> 0
+ end.
+
coverage(_Config) ->
{'EXIT',{badarith,_}} = (catch id(1) bsl 0.5),
{'EXIT',{badarith,_}} = (catch id(2.0) bsl 2),
@@ -101,5 +112,19 @@ setelement(_Config) ->
{b,_} = setelement(1, T0, b),
ok.
+cons(_Config) ->
+ [did] = cons(assigned, did),
+ ok.
+
+cons(assigned, Instrument) ->
+ [Instrument] = [did].
+
+tuple(_Config) ->
+ {'EXIT',{{badmatch,{necessary}},_}} = (catch do_tuple()),
+ ok.
+
+do_tuple() ->
+ {0, _} = {necessary}.
+
id(I) ->
I.