File 3506-erl_eval-Implement-support-for-maybe-.-end.patch of Package erlang

From 05b1d96a6a2a9980ad75bdc2e717b572149f6a7b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= <bjorn@erlang.org>
Date: Mon, 8 Nov 2021 14:22:21 +0100
Subject: [PATCH 06/12] erl_eval: Implement support for maybe ... end

---
 lib/stdlib/src/erl_eval.erl          | 41 ++++++++++++++
 lib/stdlib/src/shell.erl             |  8 ++-
 lib/stdlib/test/Makefile             |  3 +-
 lib/stdlib/test/epp_SUITE.erl        |  4 +-
 lib/stdlib/test/erl_eval_SUITE.erl   | 82 ++++++++++++++++++++++++++--
 lib/stdlib/test/io_proto_SUITE.erl   |  8 +--
 lib/stdlib/test/supervisor_SUITE.erl |  4 +-
 7 files changed, 136 insertions(+), 14 deletions(-)

diff --git a/lib/stdlib/src/erl_eval.erl b/lib/stdlib/src/erl_eval.erl
index fc2e2a4194..987ba0cf0a 100644
--- a/lib/stdlib/src/erl_eval.erl
+++ b/lib/stdlib/src/erl_eval.erl
@@ -136,6 +136,32 @@ exprs([E|Es], Bs0, Lf, Ef, RBs, FUVs) ->
     {value,_V,Bs} = expr(E, Bs0, Lf, Ef, RBs1, FUVs),
     exprs(Es, Bs, Lf, Ef, RBs, FUVs).
 
+%% maybe_match_exprs(Expression, Bindings, LocalFuncHandler, ExternalFuncHandler)
+%%  Returns one of:
+%%	 {success,Value}
+%%	 {failure,Value}
+%%  or raises an exception.
+
+maybe_match_exprs([{maybe_match,Anno,Lhs,Rhs0}|Es], Bs0, Lf, Ef) ->
+    {value,Rhs,Bs1} = expr(Rhs0, Bs0, Lf, Ef, none),
+    case match(Lhs, Rhs, Anno, Bs1, Bs1, Ef) of
+	{match,Bs} ->
+            case Es of
+                [] ->
+                    {success,Rhs};
+                [_|_] ->
+                    maybe_match_exprs(Es, Bs, Lf, Ef)
+            end;
+	nomatch ->
+            {failure,Rhs}
+    end;
+maybe_match_exprs([E], Bs0, Lf, Ef) ->
+    {value,V,_Bs} = expr(E, Bs0, Lf, Ef, none),
+    {success,V};
+maybe_match_exprs([E|Es], Bs0, Lf, Ef) ->
+    {value,_V,Bs} = expr(E, Bs0, Lf, Ef, none),
+    maybe_match_exprs(Es, Bs, Lf, Ef).
+
 %% expr(Expression, Bindings)
 %% expr(Expression, Bindings, LocalFuncHandler)
 %% expr(Expression, Bindings, LocalFuncHandler, ExternalFuncHandler)
@@ -469,6 +495,21 @@ expr({match,Anno,Lhs,Rhs0}, Bs0, Lf, Ef, RBs, FUVs) ->
             ret_expr(Rhs, Bs, RBs);
 	nomatch -> apply_error({badmatch,Rhs}, ?STACKTRACE, Anno, Bs0, Ef, RBs)
     end;
+expr({'maybe',_,Es}, Bs, Lf, Ef, RBs, _FUVs) ->
+    {_,Val} = maybe_match_exprs(Es, Bs, Lf, Ef),
+    ret_expr(Val, Bs, RBs);
+expr({'maybe',Anno,Es,{'else',_,Cs}}, Bs0, Lf, Ef, RBs, FUVs) ->
+    case maybe_match_exprs(Es, Bs0, Lf, Ef) of
+        {success,Val} ->
+            ret_expr(Val, Bs0, RBs);
+        {failure,Val} ->
+            case match_clause(Cs, [Val], Bs0, Lf, Ef) of
+                {B, Bs} ->
+                    exprs(B, Bs, Lf, Ef, RBs, FUVs);
+                nomatch ->
+                    apply_error({else_clause,Val}, ?STACKTRACE, Anno, Bs0, Ef, RBs)
+            end
+    end;
 expr({op,Anno,Op,A0}, Bs0, Lf, Ef, RBs, FUVs) ->
     {value,A,Bs} = expr(A0, Bs0, Lf, Ef, none, FUVs),
     eval_op(Op, A, Anno, Bs, Ef, RBs);
diff --git a/lib/stdlib/src/shell.erl b/lib/stdlib/src/shell.erl
index 06372d9baa..cc147848e3 100644
--- a/lib/stdlib/src/shell.erl
+++ b/lib/stdlib/src/shell.erl
@@ -273,11 +273,17 @@ server_loop(N0, Eval_0, Bs00, RT, Ds00, History0, Results0) ->
     end.
 
 get_command(Prompt, Eval, Bs, RT, Ds) ->
+    ResWordFun =
+        fun('maybe') -> true;
+           ('else') -> true;
+           (Other) -> erl_scan:reserved_word(Other)
+        end,
     Parse =
         fun() ->
                 exit(
                   case
-                      io:scan_erl_exprs(group_leader(), Prompt, {1,1}, [text])
+                      io:scan_erl_exprs(group_leader(), Prompt, {1,1},
+                                        [text,{reserved_word_fun,ResWordFun}])
                   of
                       {ok,Toks,_EndPos} ->
                           erl_eval:extended_parse_exprs(Toks);
diff --git a/lib/stdlib/test/Makefile b/lib/stdlib/test/Makefile
index 6b2711089b..382efd2803 100644
--- a/lib/stdlib/test/Makefile
+++ b/lib/stdlib/test/Makefile
@@ -118,9 +118,10 @@ RELSYSDIR = $(RELEASE_PATH)/stdlib_test
 # FLAGS
 # ----------------------------------------------------
 
+MAYBE_OPT = '+{enable_feature,maybe_expr}'
 ERL_MAKE_FLAGS +=
 ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/kernel/include \
-		-I$(ERL_TOP)/lib/stdlib/include
+		-I$(ERL_TOP)/lib/stdlib/include $(MAYBE_OPT)
 
 EBIN = .
 
diff --git a/lib/stdlib/test/epp_SUITE.erl b/lib/stdlib/test/epp_SUITE.erl
index 9a4b430c88..30437de302 100644
--- a/lib/stdlib/test/epp_SUITE.erl
+++ b/lib/stdlib/test/epp_SUITE.erl
@@ -941,7 +941,7 @@ ifdef(Config) ->
              "-else.\n"
              "t() -> a.\n"
              "-endif.\n">>,
-           {errors,[{{3,1},epp,{bad,else}}],[]}},
+           {errors,[{{3,1},epp,{bad,'else'}}],[]}},
 
           {ifdef_c8,
            <<"-ifdef(a).\n"
@@ -1802,7 +1802,7 @@ otp_16824(Config) when is_list(Config) ->
           {otp_16824_8,
            <<"\n-else\n"
              "-endif.">>,
-           {errors,[{{3,1},epp,{bad,else}}],[]}},
+           {errors,[{{3,1},epp,{bad,'else'}}],[]}},
 
           {otp_16824_9,
            <<"\n-ifndef.\n"
diff --git a/lib/stdlib/test/erl_eval_SUITE.erl b/lib/stdlib/test/erl_eval_SUITE.erl
index 16a92f7ff5..6c8d79dbfc 100644
--- a/lib/stdlib/test/erl_eval_SUITE.erl
+++ b/lib/stdlib/test/erl_eval_SUITE.erl
@@ -54,6 +54,7 @@
          otp_14708/1,
          otp_16545/1,
          otp_16865/1,
+         eep49/1,
          binary_skip/1]).
 
 %%
@@ -95,7 +96,7 @@ all() ->
      otp_8133, otp_10622, otp_13228, otp_14826,
      funs, custom_stacktrace, try_catch, eval_expr_5, zero_width,
      eep37, eep43, otp_15035, otp_16439, otp_14708, otp_16545, otp_16865,
-     binary_skip].
+     eep49, binary_skip].
 
 groups() -> 
     [].
@@ -1899,6 +1900,67 @@ otp_16865(Config) when is_list(Config) ->
                 {badmatch, b}),
     ok.
 
+eep49(Config) when is_list(Config) ->
+    check(fun() ->
+                  maybe empty end
+          end,
+          "maybe empty end.",
+          empty),
+    check(fun() ->
+                  maybe ok ?= ok end
+          end,
+          "maybe ok ?= ok end.",
+          ok),
+    check(fun() ->
+                  maybe {ok,A} ?= {ok,good}, A end
+          end,
+          "maybe {ok,A} ?= {ok,good}, A end.",
+          good),
+    check(fun() ->
+                  maybe {ok,A} ?= {ok,good}, {ok,B} ?= {ok,also_good}, {A,B} end
+          end,
+          "maybe {ok,A} ?= {ok,good}, {ok,B} ?= {ok,also_good}, {A,B} end.",
+          {good,also_good}),
+    check(fun() ->
+                  maybe {ok,A} ?= {ok,good}, {ok,B} ?= {error,wrong}, {A,B} end
+          end,
+          "maybe {ok,A} ?= {ok,good}, {ok,B} ?= {error,wrong}, {A,B} end.",
+          {error,wrong}),
+
+    %% Test maybe ... else ... end.
+    check(fun() ->
+                  maybe empty else _ -> error end
+          end,
+          "maybe empty else _ -> error end.",
+          empty),
+    check(fun() ->
+                  maybe ok ?= ok else _ -> error end
+          end,
+          "maybe ok ?= ok else _ -> error end.",
+          ok),
+    check(fun() ->
+                  maybe ok ?= other else _ -> error end
+          end,
+          "maybe ok ?= other else _ -> error end.",
+          error),
+    check(fun() ->
+                  maybe {ok,A} ?= {ok,good}, {ok,B} ?= {ok,also_good}, {A,B}
+                  else {error,_} -> error end
+          end,
+          "maybe {ok,A} ?= {ok,good}, {ok,B} ?= {ok,also_good}, {A,B} "
+          "else {error,_} -> error end.",
+          {good,also_good}),
+    check(fun() ->
+                  maybe {ok,A} ?= {ok,good}, {ok,B} ?= {error,other}, {A,B}
+                  else {error,_} -> error end
+          end,
+          "maybe {ok,A} ?= {ok,good}, {ok,B} ?= {error,other}, {A,B} "
+          "else {error,_} -> error end.",
+          error),
+    error_check("maybe ok ?= simply_wrong else {error,_} -> error end.",
+                {else_clause,simply_wrong}),
+    ok.
+
 binary_skip(Config) when is_list(Config) ->
     check(fun() -> X = 32, [X || <<X:64/float>> <= <<-1:64, 0:64, 0:64, 0:64>>] end,
 	  "begin X = 32, [X || <<X:64/float>> <= <<-1:64, 0:64, 0:64, 0:64>>] end.",
@@ -2030,15 +2093,26 @@ eval_string(String) ->
     Result.
 
 parse_expr(String) ->
-    {ok,Tokens,_} = erl_scan:string(String),
+    Tokens = erl_scan_string(String),
     {ok, [Expr]} = erl_parse:parse_exprs(Tokens),
     Expr.
 
 parse_exprs(String) ->
-    {ok,Tokens,_} = erl_scan:string(String),
+    Tokens = erl_scan_string(String),
     {ok, Exprs} = erl_parse:parse_exprs(Tokens),
     Exprs.
 
+erl_scan_string(String) ->
+    %% FIXME: When the experimental features EEP has been implemented, we should
+    %% dig out all keywords defined in all features.
+    ResWordFun =
+        fun('maybe') -> true;
+           ('else') -> true;
+           (Other) -> erl_scan:reserved_word(Other)
+        end,
+    {ok,Tokens,_} = erl_scan:string(String, 1, [{reserved_word_fun,ResWordFun}]),
+    Tokens.
+
 parse_and_run(String) ->
     erl_eval:expr(parse_expr(String), []).
 
diff --git a/lib/stdlib/test/io_proto_SUITE.erl b/lib/stdlib/test/io_proto_SUITE.erl
index df6958cfa9..f80cd0794e 100644
--- a/lib/stdlib/test/io_proto_SUITE.erl
+++ b/lib/stdlib/test/io_proto_SUITE.erl
@@ -1179,7 +1179,7 @@ get_and_put(CPid, [{getline_pred,Pred,Msg}|T]=T0, N)
 					   "(command number ~p)\n",
 					   [?MODULE,Msg,N]),
 		    {error, no_match};
-		maybe ->
+		'maybe' ->
 		    List = get(getline_skipped),
 		    put(getline_skipped, List ++ [Data]),
 		    get_and_put(CPid, T0, N)
@@ -1190,7 +1190,7 @@ get_and_put(CPid, [{getline, Match}|T],N) ->
     F = fun(Data) ->
 		case lists:prefix(Match, Data) of
 		    true -> yes;
-		    false -> maybe
+		    false -> 'maybe'
 		end
 	end,
     get_and_put(CPid, [{getline_pred,F,Match}|T], N);
@@ -1198,7 +1198,7 @@ get_and_put(CPid, [{getline_re, Match}|T],N) ->
     F = fun(Data) ->
 		case re:run(Data, Match, [{capture,none}]) of
 		    match -> yes;
-		    _ -> maybe
+		    _ -> 'maybe'
 		end
 	end,
     get_and_put(CPid, [{getline_pred,F,Match}|T], N);
@@ -1498,7 +1498,7 @@ get_default_shell() ->
 			    case re:run(Data, "<\\d+[.]\\d+[.]\\d+>",
 					[{capture,none}]) of
 				match -> no;
-				_ -> maybe
+				_ -> 'maybe'
 			    end
 		    end
 	    end,
diff --git a/lib/stdlib/test/supervisor_SUITE.erl b/lib/stdlib/test/supervisor_SUITE.erl
index a52c5b1b44..78d7e7d7bc 100644
--- a/lib/stdlib/test/supervisor_SUITE.erl
+++ b/lib/stdlib/test/supervisor_SUITE.erl
@@ -904,7 +904,7 @@ child_specs_map(Config) when is_list(Config) ->
     B7 = CS0#{type => wrker},
     B8 = CS0#{modules => dy},
     B9 = CS0#{modules => [1,2,3]},
-    B10 = CS0#{significant => maybe},
+    B10 = CS0#{significant => 'maybe'},
 
     {error, missing_id} = supervisor:start_child(sup_test, B1),
     {error, missing_start} = supervisor:start_child(sup_test, B2),
@@ -932,7 +932,7 @@ child_specs_map(Config) when is_list(Config) ->
     {error, {invalid_modules,dy}} = supervisor:check_childspecs([B8]),
     {error, {invalid_module, 1}} =
 	supervisor:check_childspecs([B9]),
-    {error, {invalid_significant, maybe}} =
+    {error, {invalid_significant, 'maybe'}} =
 	supervisor:check_childspecs([B10]),
 
     CSFilter = fun (CS) -> maps:filter(fun (_, V) -> V =/= undefined end, CS) end,
-- 
2.34.1

openSUSE Build Service is sponsored by