Avoid optimization that beam_validator might consider unsafe

lib/compiler/src/beam_clean.erl

@@ -35,7 +35,8 @@ module({Mod,Exp,Attr,Fs0,_}, Opts) ->
     {Fs2,Lc} = clean_labels(Fs1),
     Fs3 = fix_swap(Fs2, Opts),
     Fs4 = fix_bs_create_bin(Fs3, Opts),
-    Fs = maybe_remove_lines(Fs4, Opts),
+    Fs5 = fix_badrecord(Fs4, Opts),
+    Fs = maybe_remove_lines(Fs5, Opts),
     {ok,{Mod,Exp,Attr,Fs,Lc}}.
 
 %% Determine the rootset, i.e. exported functions and
@@ -314,6 +315,28 @@ bs_puts([{atom,Type},_Seg,Unit,Flags0,Src,Size|Is], Fail) ->
     [I|bs_puts(Is, Fail)];
 bs_puts([], _Fail) -> [].
 
+%%%
+%%% If compatibility with a previous release (OTP 24 or earlier) has
+%%% been requested, eliminate badrecord instructions by translating
+%%% them to calls to error({badrecord,Value}).
+%%%
+
+fix_badrecord(Fs, Opts) ->
+    case proplists:get_bool(no_badrecord, Opts) of
+        false -> Fs;
+        true -> fold_functions(fun fix_badrecord/1, Fs)
+    end.
+
+fix_badrecord([{badrecord,Value}|Is]) ->
+    [{move,Value,{x,0}},
+     {test_heap,3,1},
+     {put_tuple2,{x,0},{list,[{atom,badrecord},{x,0}]}},
+     {call_ext_only,1,{extfunc,erlang,error,1}}|fix_badrecord(Is)];
+fix_badrecord([I|Is]) ->
+    [I|fix_badrecord(Is)];
+fix_badrecord([]) -> [].
+
+
 %%%
 %%% Helpers.
 %%%

lib/compiler/src/beam_ssa_dead.erl

@@ -1176,9 +1176,19 @@ opt_redundant_tests_is([#b_set{op=Op,args=Args,dst=Bool}=I0], Tests, Acc) ->
         {Test,MustInvert} ->
             case old_result(Test, Tests) of
                 Result0 when is_boolean(Result0) ->
-                    Result = #b_literal{val=Result0 xor MustInvert},
-                    I = I0#b_set{op={bif,'=:='},args=[Result,#b_literal{val=true}]},
-                    {old_test,reverse(Acc, [I]),Bool,Result};
+                    case gains_type_information(I0) of
+                        false ->
+                            Result = #b_literal{val=Result0 xor MustInvert},
+                            I = I0#b_set{op={bif,'=:='},args=[Result,#b_literal{val=true}]},
+                            {old_test,reverse(Acc, [I]),Bool,Result};
+                        true ->
+                            %% At least one variable will gain type
+                            %% information from this `=:=`
+                            %% operation. Removing it could make it
+                            %% impossible for beam_validator to
+                            %% realize that the code is type-safe.
+                            none
+                    end;
                 none ->
                     {new_test,Bool,Test,MustInvert}
             end
@@ -1187,6 +1197,33 @@ opt_redundant_tests_is([I|Is], Tests, Acc) ->
     opt_redundant_tests_is(Is, Tests, [I|Acc]);
 opt_redundant_tests_is([], _Tests, _Acc) -> none.
 
+%% Will any of the variables gain type information from this
+%% operation?
+gains_type_information(#b_set{anno=Anno,op={bif,'=:='},args=Args}) ->
+    Types0 = maps:get(arg_types, Anno, #{}),
+    Types = complete_type_information(Args, 0, Types0),
+    case map_size(Types) of
+        0 ->
+            false;
+        1 ->
+            true;
+        2 ->
+            case Types of
+                #{0 := Same,1 := Same} ->
+                    false;
+                #{} ->
+                    true
+            end
+    end;
+gains_type_information(#b_set{}) -> false.
+
+complete_type_information([#b_literal{val=Value}|As], N, Types) ->
+    Type = beam_types:make_type_from_value(Value),
+    complete_type_information(As, N+1, Types#{N => Type});
+complete_type_information([#b_var{}|As], N, Types) ->
+    complete_type_information(As, N+1, Types);
+complete_type_information([], _, Types) -> Types.
+
 old_result(Test, Tests) ->
     case Tests of
         #{Test := Val} -> Val;

lib/compiler/src/compile.erl

@@ -274,7 +274,7 @@ expand_opt(r23, Os) ->
                               no_recv_opt, no_init_yregs |
                               expand_opt(r24, Os)]);
 expand_opt(r24, Os) ->
-    expand_opt(no_type_opt, [no_bs_create_bin, no_ssa_opt_ranges |
+    expand_opt(no_type_opt, [no_badrecord, no_bs_create_bin, no_ssa_opt_ranges |
                              expand_opt(r25, Os)]);
 expand_opt(r25, Os) ->
     [no_ssa_opt_update_tuple, no_bs_match, no_min_max_bifs | Os];

lib/compiler/test/beam_ssa_SUITE.erl

@@ -28,7 +28,7 @@
          mapfoldl/0,mapfoldl/1,
          grab_bag/1,redundant_br/1,
          coverage/1,normalize/1,
-         trycatch/1]).
+         trycatch/1,gh_6599/1]).
 
 suite() -> [{ct_hooks,[ts_install_cth]}].
 
@@ -51,7 +51,8 @@ groups() ->
        redundant_br,
        coverage,
        normalize,
-       trycatch
+       trycatch,
+       gh_6599
       ]}].
 
 init_per_suite(Config) ->
@@ -1411,5 +1412,87 @@ trycatch_3(A) ->
         ok
     end.
 
+%% GH-6599. beam_validator would not realize that the code was safe.
+gh_6599(_Config) ->
+    ok = gh_6599_1(id(42), id(42)),
+    #{ok := ok} = gh_6599_1(id(#{ok => 0}), id(#{ok => 0})),
+
+    {'EXIT',{{try_clause,#{ok:=ok}},_}} =
+        catch gh_6599_2(id(whatever), id(#{0 => whatever})),
+
+    ok = gh_6599_3(id(true), id(true)),
+    {'EXIT',{function_clause,_}} = catch gh_6599_3(id(false), id(false)),
+    0.0 = gh_6599_3(id(0.0), id(0.0)),
+
+    {'EXIT',{{badmatch,true},_}} = catch gh_6599_4(id(false)),
+
+    {'EXIT',{{badmatch,ok},_}} = catch gh_6599_5(id([a]), id(#{0 => [a]}), id([a])),
+
+    #{ok := ok} = gh_6599_6(id(#{}), id(#{})),
+    {'EXIT',{{badmap,a},_}} = catch gh_6599_6(id(a), id(a)),
+
+    {'EXIT',{{badarg,ok},_}} = catch gh_6599_7(id([a]), id([a])),
+
+    ok.
+
+gh_6599_1(X, X) when is_integer(X) ->
+    ok;
+gh_6599_1(Y, Y = #{}) ->
+    Y#{ok := ok}.
+
+gh_6599_2(X, #{0 := X, 0 := Y}) ->
+    try #{ok => ok} of
+        Y ->
+            bnot (Y = X)
+    after
+        ok
+    end.
+
+gh_6599_3(X, X) when X ->
+    ok;
+gh_6599_3(X, X = 0.0) ->
+    X + X.
+
+gh_6599_4(X) ->
+    Y =
+        try
+            false = X
+        catch
+            _ ->
+                ok
+        end /= ok,
+    X = Y,
+    false = Y,
+    0 = ok.
+
+%% Crashes in beam_ssa_type because a type assertion fails.
+gh_6599_5(X, #{0 := X, 0 := Y}, Y=[_ | _]) ->
+    try
+        Y = ok
+    catch
+        _ ->
+            [_ | []] = Y = X
+    end.
+
+gh_6599_6(A, B = A) ->
+    A#{},
+    case A of B -> B end#{ok => ok}.
+
+gh_6599_7(X, Y) ->
+    try Y of
+        X ->
+            (id(
+                try ([_ | _] = Y) of
+                    X ->
+                        ok
+                after
+                    ok
+                end
+            ) orelse X) bsl 0
+    after
+        ok
+    end.
+
+
 %% The identity function.
 id(I) -> I.