From 19b7ccfe076d88a96b62f3222f38be31bb087df2 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?John=20H=C3=B6gberg?= <john@erlang.org>
Date: Thu, 4 Jan 2018 18:08:42 +0100
Subject: Remove unsafe is_record/test_arity optimizations

The type optimizations for is_record and test_arity checked whether
the arity was equal to the size stored in the type information,
which is incorrect since said size is the *minimum* size of the
tuple (as determined by previous instructions) and not its exact
size.

A future patch to the 'master' branch will restore these
optimizations in a safe manner.
---
 lib/compiler/src/beam_type.erl        | 16 ----------------
 lib/compiler/test/beam_type_SUITE.erl | 31 +++++++++++++++++++++++++++++--
 2 files changed, 29 insertions(+), 18 deletions(-)

(limited to 'lib/compiler')

diff --git a/lib/compiler/src/beam_type.erl b/lib/compiler/src/beam_type.erl
index 3d842a6fd3..6bf3f2795b 100644
--- a/lib/compiler/src/beam_type.erl
+++ b/lib/compiler/src/beam_type.erl
@@ -117,14 +117,6 @@ simplify_basic_1([{test,is_tuple,_,[R]}=I|Is], Ts, Acc) ->
 	{tuple,_,_} -> simplify_basic_1(Is, Ts, Acc);
 	_ -> simplify_basic_1(Is, Ts, [I|Acc])
     end;
-simplify_basic_1([{test,test_arity,_,[R,Arity]}=I|Is], Ts0, Acc) ->
-    case tdb_find(R, Ts0) of
-	{tuple,Arity,_} ->
-	    simplify_basic_1(Is, Ts0, Acc);
-	_Other ->
-	    Ts = update(I, Ts0),
-	    simplify_basic_1(Is, Ts, [I|Acc])
-    end;
 simplify_basic_1([{test,is_map,_,[R]}=I|Is], Ts0, Acc) ->
     case tdb_find(R, Ts0) of
 	map -> simplify_basic_1(Is, Ts0, Acc);
@@ -147,14 +139,6 @@ simplify_basic_1([{test,is_eq_exact,Fail,[R,{atom,_}=Atom]}=I|Is0], Ts0, Acc0) -
 	  end,
     Ts = update(I, Ts0),
     simplify_basic_1(Is0, Ts, Acc);
-simplify_basic_1([{test,is_record,_,[R,{atom,_}=Tag,{integer,Arity}]}=I|Is], Ts0, Acc) ->
-    case tdb_find(R, Ts0) of
-	{tuple,Arity,[Tag]} ->
-	    simplify_basic_1(Is, Ts0, Acc);
-	_Other ->
-	    Ts = update(I, Ts0),
-	    simplify_basic_1(Is, Ts, [I|Acc])
-    end;
 simplify_basic_1([{select,select_val,Reg,_,_}=I0|Is], Ts, Acc) ->
     I = case tdb_find(Reg, Ts) of
 	    {integer,Range} ->
diff --git a/lib/compiler/test/beam_type_SUITE.erl b/lib/compiler/test/beam_type_SUITE.erl
index 86146c614f..fe856b12b6 100644
--- a/lib/compiler/test/beam_type_SUITE.erl
+++ b/lib/compiler/test/beam_type_SUITE.erl
@@ -22,7 +22,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,cons/1,
-	 tuple/1,record_float/1,binary_float/1,float_compare/1]).
+	 tuple/1,record_float/1,binary_float/1,float_compare/1,
+	 arity_checks/1]).
 
 suite() -> [{ct_hooks,[ts_install_cth]}].
 
@@ -40,7 +41,8 @@ groups() ->
        tuple,
        record_float,
        binary_float,
-       float_compare
+       float_compare,
+       arity_checks
       ]}].
 
 init_per_suite(Config) ->
@@ -171,6 +173,31 @@ do_float_compare(X) ->
         _T -> Y > 0
     end.
 
+arity_checks(_Config) ->
+    %% ERL-549: an unsafe optimization removed a test_arity instruction,
+    %% causing the following to return 'broken' instead of 'ok'.
+    ok = do_record_arity_check({rgb, 255, 255, 255, 1}),
+    ok = do_tuple_arity_check({255, 255, 255, 1}).
+ 
+-record(rgb, {r = 255, g = 255, b = 255}).
+
+do_record_arity_check(RGB) when
+        (element(2, RGB) >= 0), (element(2, RGB) =< 255),
+        (element(3, RGB) >= 0), (element(3, RGB) =< 255),
+        (element(4, RGB) >= 0), (element(4, RGB) =< 255) ->
+    if
+        element(1, RGB) =:= rgb, is_record(RGB, rgb) -> broken;
+        true -> ok
+    end.
+
+do_tuple_arity_check(RGB) when is_tuple(RGB),
+        (element(1, RGB) >= 0), (element(1, RGB) =< 255),
+        (element(2, RGB) >= 0), (element(2, RGB) =< 255),
+        (element(3, RGB) >= 0), (element(3, RGB) =< 255) ->
+    case RGB of
+        {255, _, _} -> broken;
+        _ -> ok
+    end.
 
 id(I) ->
     I.
-- 
cgit v1.2.3