Merge pull request #7207 from frej/frej/private-append-fix

Fix bug in private-append transform

4 files changed, 65 insertions, 4 deletions

diff --git a/lib/compiler/src/beam_ssa_check.erl b/lib/compiler/src/beam_ssa_check.erl
index 0d3faa0ee2..f344286943 100644
--- a/lib/compiler/src/beam_ssa_check.erl
+++ b/lib/compiler/src/beam_ssa_check.erl
@@ -285,8 +285,9 @@ env_post1(_Pattern, _Actual, _Env) ->
     ?DP("Failed to match ~p <-> ~p~n", [_Pattern, _Actual]),
     error({internal_pattern_match_error,env_post1}).
 
-post_bitstring(Bytes, Actual, _Env) ->
-    Actual = build_bitstring(Bytes, <<>>).
+post_bitstring(Bytes, Actual, Env) ->
+    Actual = build_bitstring(Bytes, <<>>),
+    Env.
 
 %% Convert the parsed literal binary to an actual bitstring.
 build_bitstring([{integer,_,V}|Bytes], Acc) ->
diff --git a/lib/compiler/src/beam_ssa_private_append.erl b/lib/compiler/src/beam_ssa_private_append.erl
index bf51e8b81a..c295492762 100644
--- a/lib/compiler/src/beam_ssa_private_append.erl
+++ b/lib/compiler/src/beam_ssa_private_append.erl
@@ -86,6 +86,17 @@ find_appends_blk([], _, Found) ->
     Found.
 
 find_appends_is([#b_set{dst=Dst, op=bs_create_bin,
+                        args=[#b_literal{val=append},
+                              _,
+                              Lit=#b_literal{val= <<>>}|_]}|Is],
+                Fun, Found0) ->
+    %% Special case for when the first fragment is a literal <<>> as
+    %% it won't be annotated as unique nor will it die with the
+    %% instruction.
+    AlreadyFound = maps:get(Fun, Found0, []),
+    Found = Found0#{Fun => [{append,Dst,Lit}|AlreadyFound]},
+    find_appends_is(Is, Fun, Found);
+find_appends_is([#b_set{dst=Dst, op=bs_create_bin,
                         args=[#b_literal{val=append},SegmentInfo,Var|_],
                         anno=#{first_fragment_dies:=Dies}=Anno}|Is],
                 Fun, Found0) ->
@@ -468,6 +479,16 @@ patch_appends_is([I0=#b_set{dst=Dst}|Rest], PD0, Cnt0, Acc, BlockAdditions0)
             Ps = keysort(1, map(ExtractOpargs, Patches)),
             {Is, Cnt} = patch_opargs(I0, Ps, Cnt0),
             patch_appends_is(Rest, PD, Cnt, Is++Acc, BlockAdditions0);
+        [{append,Dst,#b_literal{val= <<>>}=Lit}] ->
+            %% Special case for when the first fragment is a literal
+            %% <<>> and it has to be replaced with a bs_init_writable.
+            #b_set{op=bs_create_bin,dst=Dst,args=Args0}=I0,
+            [#b_literal{val=append},SegInfo,Lit|OtherArgs] = Args0,
+            {V,Cnt} = new_var(Cnt0),
+            Init = #b_set{op=bs_init_writable,dst=V,args=[#b_literal{val=256}]},
+            I = I0#b_set{args=[#b_literal{val=private_append},
+                               SegInfo,V|OtherArgs]},
+            patch_appends_is(Rest, PD, Cnt, [I,Init|Acc], BlockAdditions0);
         [{append,Dst,_}] ->
             #b_set{op=bs_create_bin,dst=Dst,args=Args0}=I0,
             [#b_literal{val=append}|OtherArgs] = Args0,
diff --git a/lib/compiler/test/beam_ssa_check_SUITE_data/private_append.erl b/lib/compiler/test/beam_ssa_check_SUITE_data/private_append.erl
index 4d4b0f1bbd..c1edc54460 100644
--- a/lib/compiler/test/beam_ssa_check_SUITE_data/private_append.erl
+++ b/lib/compiler/test/beam_ssa_check_SUITE_data/private_append.erl
@@ -22,6 +22,8 @@
 %%
 -module(private_append).
 
+-feature(maybe_expr, enable).
+
 -export([transformable0/1,
 	 transformable1/1,
 	 transformable1b/1,
@@ -76,7 +78,9 @@
          not_transformable14/0,
          not_transformable15/2,
 
-         id/1]).
+         id/1,
+
+         bs_create_bin_on_literal/0]).
 
 %% Trivial smoke test
 transformable0(L) ->
@@ -977,3 +981,24 @@ not_transformable15(_, V) ->
 
 id(I) ->
     I.
+
+%% Check that we don't try to private_append to something created by
+%% bs_create_bin `append`, _, `<<>>`, ...
+bs_create_bin_on_literal() ->
+%ssa% () when post_ssa_opt ->
+%ssa% X = bs_init_writable(_),
+%ssa% Y = bs_create_bin(private_append, _, X, ...),
+%ssa% Z = bs_create_bin(private_append, _, Y, ...),
+%ssa% ret(Z).
+    <<
+      <<
+	(maybe
+	     2147483647 ?= ok
+	 else
+	     <<_>> ->
+		 ok;
+	     _ ->
+		 <<>>
+	 end)/bytes
+      >>/binary
+    >>.
diff --git a/lib/compiler/test/beam_ssa_check_SUITE_data/sanity_checks.erl b/lib/compiler/test/beam_ssa_check_SUITE_data/sanity_checks.erl
index ae4bb28eea..47c60fd8d6 100644
--- a/lib/compiler/test/beam_ssa_check_SUITE_data/sanity_checks.erl
+++ b/lib/compiler/test/beam_ssa_check_SUITE_data/sanity_checks.erl
@@ -18,6 +18,8 @@
 
 -module(sanity_checks).
 
+-compile(no_ssa_opt_private_append).
+
 -export([check_fail/0,
          check_wrong_pass/0,
          check_xfail/0,
@@ -33,7 +35,9 @@
          t25/0, t26/0, t27/0, t28/0, t29/0,
          t30/0, t31/0, t32/1, t33/1, t34/1,
          t35/1, t36/0, t37/0, t38/0, t39/1,
-         t40/0, t41/0, t42/0, t43/0, t44/0]).
+         t40/0, t41/0, t42/0, t43/0, t44/0,
+
+         check_env/0]).
 
 %% Check that we do not trigger on the wrong pass
 check_wrong_pass() ->
@@ -325,3 +329,13 @@ t44() ->
 %ssa% () when post_ssa_opt ->
 %ssa% _ = call(fun e:f0/1, {...}).
     e:f0({}).
+
+%% Ensure bug which trashed the environment after matching a literal
+%% bitstring stays fixed.
+check_env() ->
+%ssa% () when post_ssa_opt ->
+%ssa% X = bs_create_bin(append, _, <<>>, ...),
+%ssa% ret(X).
+    A = <<>>,
+    B = ex:f(),
+    <<A/binary, B/binary>>.