aboutsummaryrefslogtreecommitdiffstats
path: root/lib/stdlib
diff options
context:
space:
mode:
Diffstat (limited to 'lib/stdlib')
-rw-r--r--lib/stdlib/src/erl_expand_records.erl132
-rw-r--r--lib/stdlib/src/erl_parse.yrl12
-rw-r--r--lib/stdlib/src/erl_scan.erl10
-rw-r--r--lib/stdlib/src/gen_fsm.erl15
-rw-r--r--lib/stdlib/src/gen_server.erl15
-rw-r--r--lib/stdlib/test/erl_scan_SUITE.erl5
-rw-r--r--lib/stdlib/test/gen_fsm_SUITE.erl28
-rw-r--r--lib/stdlib/test/gen_server_SUITE.erl22
-rw-r--r--lib/stdlib/test/qlc_SUITE.erl4
9 files changed, 216 insertions, 27 deletions
diff --git a/lib/stdlib/src/erl_expand_records.erl b/lib/stdlib/src/erl_expand_records.erl
index a38b7639d8..18c467db81 100644
--- a/lib/stdlib/src/erl_expand_records.erl
+++ b/lib/stdlib/src/erl_expand_records.erl
@@ -95,8 +95,9 @@ forms([F | Fs0], St0) ->
forms([], St) -> {[],St}.
clauses([{clause,Line,H0,G0,B0} | Cs0], St0) ->
- {H,St1} = head(H0, St0),
- {G,St2} = guard(G0, St1),
+ {H1,St1} = head(H0, St0),
+ {G1,St2} = guard(G0, St1),
+ {H,G} = optimize_is_record(H1, G1),
{B,St3} = exprs(B0, St2),
{Cs,St4} = clauses(Cs0, St3),
{[{clause,Line,H,G,B} | Cs],St4};
@@ -800,5 +801,132 @@ imported(F, A, St) ->
error -> no
end.
+%%%
+%%% Replace is_record/3 in guards with matching if possible.
+%%%
+
+optimize_is_record(H0, G0) ->
+ case opt_rec_vars(G0) of
+ [] ->
+ {H0,G0};
+ Rs0 ->
+ {H,Rs} = opt_pattern_list(H0, Rs0),
+ G = opt_remove(G0, Rs),
+ {H,G}
+ end.
+
+
+%% opt_rec_vars(Guards) -> Vars.
+%% Search through the guard expression, looking for
+%% variables referenced in those is_record/3 calls that
+%% will fail the entire guard if they evaluate to 'false'
+%%
+%% In the following code
+%%
+%% f(X, Y, Z) when is_record(X, r1) andalso
+%% (is_record(Y, r2) orelse is_record(Z, r3))
+%%
+%% the entire guard will be false if the record test for
+%% X fails, and the clause can be rewritten to:
+%%
+%% f({r1,...}=X, Y, Z) when true andalso
+%% (is_record(Y, r2) or is_record(Z, r3))
+%%
+opt_rec_vars([G|Gs]) ->
+ Rs = opt_rec_vars_1(G, orddict:new()),
+ opt_rec_vars(Gs, Rs);
+opt_rec_vars([]) -> orddict:new().
+
+opt_rec_vars([G|Gs], Rs0) ->
+ Rs1 = opt_rec_vars_1(G, orddict:new()),
+ Rs = ordsets:intersection(Rs0, Rs1),
+ opt_rec_vars(Gs, Rs);
+opt_rec_vars([], Rs) -> Rs.
+
+opt_rec_vars_1([T|Ts], Rs0) ->
+ Rs = opt_rec_vars_2(T, Rs0),
+ opt_rec_vars_1(Ts, Rs);
+opt_rec_vars_1([], Rs) -> Rs.
+
+opt_rec_vars_2({op,_,'and',A1,A2}, Rs) ->
+ opt_rec_vars_1([A1,A2], Rs);
+opt_rec_vars_2({op,_,'andalso',A1,A2}, Rs) ->
+ opt_rec_vars_1([A1,A2], Rs);
+opt_rec_vars_2({op,_,'orelse',Arg,{atom,_,fail}}, Rs) ->
+ %% Since the second argument guarantees failure,
+ %% it is safe to inspect the first argument.
+ opt_rec_vars_2(Arg, Rs);
+opt_rec_vars_2({call,_,{remote,_,{atom,_,erlang},{atom,_,is_record}},
+ [{var,_,V},{atom,_,Tag},{integer,_,Sz}]}, Rs) ->
+ orddict:store(V, {Tag,Sz}, Rs);
+opt_rec_vars_2({call,_,{atom,_,is_record},
+ [{var,_,V},{atom,_,Tag},{integer,_,Sz}]}, Rs) ->
+ orddict:store(V, {Tag,Sz}, Rs);
+opt_rec_vars_2(_, Rs) -> Rs.
+
+opt_pattern_list(Ps, Rs) ->
+ opt_pattern_list(Ps, Rs, []).
+
+opt_pattern_list([P0|Ps], Rs0, Acc) ->
+ {P,Rs} = opt_pattern(P0, Rs0),
+ opt_pattern_list(Ps, Rs, [P|Acc]);
+opt_pattern_list([], Rs, Acc) ->
+ {reverse(Acc),Rs}.
+
+opt_pattern({var,_,V}=Var, Rs0) ->
+ case orddict:find(V, Rs0) of
+ {ok,{Tag,Sz}} ->
+ Rs = orddict:store(V, {remove,Tag,Sz}, Rs0),
+ {opt_var(Var, Tag, Sz),Rs};
+ _ ->
+ {Var,Rs0}
+ end;
+opt_pattern({cons,Line,H0,T0}, Rs0) ->
+ {H,Rs1} = opt_pattern(H0, Rs0),
+ {T,Rs} = opt_pattern(T0, Rs1),
+ {{cons,Line,H,T},Rs};
+opt_pattern({tuple,Line,Es0}, Rs0) ->
+ {Es,Rs} = opt_pattern_list(Es0, Rs0),
+ {{tuple,Line,Es},Rs};
+opt_pattern({match,Line,Pa0,Pb0}, Rs0) ->
+ {Pa,Rs1} = opt_pattern(Pa0, Rs0),
+ {Pb,Rs} = opt_pattern(Pb0, Rs1),
+ {{match,Line,Pa,Pb},Rs};
+opt_pattern(P, Rs) -> {P,Rs}.
+
+opt_var({var,Line,_}=Var, Tag, Sz) ->
+ Rp = record_pattern(2, -1, ignore, Sz, Line, [{atom,Line,Tag}]),
+ {match,Line,{tuple,Line,Rp},Var}.
+
+opt_remove(Gs, Rs) ->
+ [opt_remove_1(G, Rs) || G <- Gs].
+
+opt_remove_1(Ts, Rs) ->
+ [opt_remove_2(T, Rs) || T <- Ts].
+
+opt_remove_2({op,L,'and'=Op,A1,A2}, Rs) ->
+ {op,L,Op,opt_remove_2(A1, Rs),opt_remove_2(A2, Rs)};
+opt_remove_2({op,L,'andalso'=Op,A1,A2}, Rs) ->
+ {op,L,Op,opt_remove_2(A1, Rs),opt_remove_2(A2, Rs)};
+opt_remove_2({op,L,'orelse',A1,A2}, Rs) ->
+ {op,L,'orelse',opt_remove_2(A1, Rs),A2};
+opt_remove_2({call,Line,{remote,_,{atom,_,erlang},{atom,_,is_record}},
+ [{var,_,V},{atom,_,Tag},{integer,_,Sz}]}=A, Rs) ->
+ case orddict:find(V, Rs) of
+ {ok,{remove,Tag,Sz}} ->
+ {atom,Line,true};
+ _ ->
+ A
+ end;
+opt_remove_2({call,Line,{atom,_,is_record},
+ [{var,_,V},{atom,_,Tag},{integer,_,Sz}]}=A, Rs) ->
+ case orddict:find(V, Rs) of
+ {ok,{remove,Tag,Sz}} ->
+ {atom,Line,true};
+ _ ->
+ A
+ end;
+opt_remove_2(A, _) -> A.
+
neg_line(L) ->
erl_parse:set_line(L, fun(Line) -> -abs(Line) end).
diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl
index 5287f55e59..141ee18afd 100644
--- a/lib/stdlib/src/erl_parse.yrl
+++ b/lib/stdlib/src/erl_parse.yrl
@@ -61,7 +61,7 @@ char integer float atom string var
'++' '--'
'==' '/=' '=<' '<' '>=' '>' '=:=' '=/=' '<='
'<<' '>>'
-'!' '=' '::'
+'!' '=' '::' '..' '...'
'spec' % helper
dot.
@@ -135,7 +135,7 @@ type -> atom ':' atom '(' top_types ')' : {remote_type, ?line('$1'),
['$1', '$3', '$5']}.
type -> '[' ']' : {type, ?line('$1'), nil, []}.
type -> '[' top_type ']' : {type, ?line('$1'), list, ['$2']}.
-type -> '[' top_type ',' '.' '.' '.' ']' : {type, ?line('$1'),
+type -> '[' top_type ',' '...' ']' : {type, ?line('$1'),
nonempty_list, ['$2']}.
type -> '{' '}' : {type, ?line('$1'), tuple, []}.
type -> '{' top_types '}' : {type, ?line('$1'), tuple, '$2'}.
@@ -144,8 +144,8 @@ type -> '#' atom '{' field_types '}' : {type, ?line('$1'),
record, ['$2'|'$4']}.
type -> binary_type : '$1'.
type -> int_type : '$1'.
-type -> int_type '.' '.' int_type : {type, ?line('$1'), range,
- ['$1', '$4']}.
+type -> int_type '..' int_type : {type, ?line('$1'), range,
+ ['$1', '$3']}.
type -> 'fun' '(' ')' : {type, ?line('$1'), 'fun', []}.
type -> 'fun' '(' fun_type_100 ')' : '$3'.
@@ -153,9 +153,9 @@ int_type -> integer : '$1'.
int_type -> '-' integer : abstract(-normalise('$2'),
?line('$2')).
-fun_type_100 -> '(' '.' '.' '.' ')' '->' top_type
+fun_type_100 -> '(' '...' ')' '->' top_type
: {type, ?line('$1'), 'fun',
- [{type, ?line('$1'), any}, '$7']}.
+ [{type, ?line('$1'), any}, '$5']}.
fun_type_100 -> fun_type : '$1'.
fun_type -> '(' ')' '->' top_type : {type, ?line('$1'), 'fun',
diff --git a/lib/stdlib/src/erl_scan.erl b/lib/stdlib/src/erl_scan.erl
index 1013d54bdc..c179c3d067 100644
--- a/lib/stdlib/src/erl_scan.erl
+++ b/lib/stdlib/src/erl_scan.erl
@@ -442,6 +442,14 @@ scan1([$\%=C|Cs], St, Line, Col, Toks) ->
scan_comment(Cs, St, Line, Col, Toks, [C]);
scan1([C|Cs], St, Line, Col, Toks) when ?DIGIT(C) ->
scan_number(Cs, St, Line, Col, Toks, [C]);
+scan1("..."++Cs, St, Line, Col, Toks) ->
+ tok2(Cs, St, Line, Col, Toks, "...", '...', 3);
+scan1(".."=Cs, _St, Line, Col, Toks) ->
+ {more,{Cs,Col,Toks,Line,[],fun scan/6}};
+scan1(".."++Cs, St, Line, Col, Toks) ->
+ tok2(Cs, St, Line, Col, Toks, "..", '..', 2);
+scan1("."=Cs, _St, Line, Col, Toks) ->
+ {more,{Cs,Col,Toks,Line,[],fun scan/6}};
scan1([$.=C|Cs], St, Line, Col, Toks) ->
scan_dot(Cs, St, Line, Col, Toks, [C]);
scan1([$"|Cs], St, Line, Col, Toks) -> %" Emacs
@@ -644,8 +652,6 @@ scan_dot([$\n=C|Cs], St, Line, Col, Toks, Ncs) ->
scan_dot([C|Cs], St, Line, Col, Toks, Ncs) when ?WHITE_SPACE(C) ->
Attrs = attributes(Line, Col, St, Ncs++[C]),
{ok,[{dot,Attrs}|Toks],Cs,Line,incr_column(Col, 2)};
-scan_dot([]=Cs, _St, Line, Col, Toks, Ncs) ->
- {more,{Cs,Col,Toks,Line,Ncs,fun scan_dot/6}};
scan_dot(eof=Cs, St, Line, Col, Toks, Ncs) ->
Attrs = attributes(Line, Col, St, Ncs),
{ok,[{dot,Attrs}|Toks],Cs,Line,incr_column(Col, 1)};
diff --git a/lib/stdlib/src/gen_fsm.erl b/lib/stdlib/src/gen_fsm.erl
index 8d1b46d6ab..7d9960b912 100644
--- a/lib/stdlib/src/gen_fsm.erl
+++ b/lib/stdlib/src/gen_fsm.erl
@@ -614,12 +614,15 @@ get_msg(Msg) -> Msg.
format_status(Opt, StatusData) ->
[PDict, SysState, Parent, Debug, [Name, StateName, StateData, Mod, _Time]] =
StatusData,
- NameTag = if is_pid(Name) ->
- pid_to_list(Name);
- is_atom(Name) ->
- Name
- end,
- Header = lists:concat(["Status for state machine ", NameTag]),
+ StatusHdr = "Status for state machine",
+ Header = if
+ is_pid(Name) ->
+ lists:concat([StatusHdr, " ", pid_to_list(Name)]);
+ is_atom(Name); is_list(Name) ->
+ lists:concat([StatusHdr, " ", Name]);
+ true ->
+ {StatusHdr, Name}
+ end,
Log = sys:get_debug(log, Debug, []),
DefaultStatus = [{data, [{"StateData", StateData}]}],
Specfic =
diff --git a/lib/stdlib/src/gen_server.erl b/lib/stdlib/src/gen_server.erl
index dc8e7ecd16..ac81df9cab 100644
--- a/lib/stdlib/src/gen_server.erl
+++ b/lib/stdlib/src/gen_server.erl
@@ -840,12 +840,15 @@ name_to_pid(Name) ->
%%-----------------------------------------------------------------
format_status(Opt, StatusData) ->
[PDict, SysState, Parent, Debug, [Name, State, Mod, _Time]] = StatusData,
- NameTag = if is_pid(Name) ->
- pid_to_list(Name);
- is_atom(Name) ->
- Name
- end,
- Header = lists:concat(["Status for generic server ", NameTag]),
+ StatusHdr = "Status for generic server",
+ Header = if
+ is_pid(Name) ->
+ lists:concat([StatusHdr, " ", pid_to_list(Name)]);
+ is_atom(Name); is_list(Name) ->
+ lists:concat([StatusHdr, " ", Name]);
+ true ->
+ {StatusHdr, Name}
+ end,
Log = sys:get_debug(log, Debug, []),
DefaultStatus = [{data, [{"State", State}]}],
Specfic =
diff --git a/lib/stdlib/test/erl_scan_SUITE.erl b/lib/stdlib/test/erl_scan_SUITE.erl
index afeb67eeb1..32eb97bc92 100644
--- a/lib/stdlib/test/erl_scan_SUITE.erl
+++ b/lib/stdlib/test/erl_scan_SUITE.erl
@@ -185,7 +185,7 @@ reserved_words() ->
'andalso', 'orelse', 'end', 'fun', 'if', 'let', 'of',
'query', 'receive', 'when', 'bnot', 'not', 'div',
'rem', 'band', 'and', 'bor', 'bxor', 'bsl', 'bsr',
- 'or', 'xor'] ,
+ 'or', 'xor'],
[begin
?line {RW, true} = {RW, erl_scan:reserved_word(RW)},
S = atom_to_list(RW),
@@ -244,6 +244,9 @@ punctuations() ->
{'\\',1},{'^',1},{'`',1},{'~',1}],
?line test_string("#&*+/:<>?@\\^`~", PTs2),
+ ?line test_string(".. ", [{'..',1}]),
+ ?line test("1 .. 2"),
+ ?line test_string("...", [{'...',1}]),
ok.
comments() ->
diff --git a/lib/stdlib/test/gen_fsm_SUITE.erl b/lib/stdlib/test/gen_fsm_SUITE.erl
index d61eeb403b..dd120f8c05 100644
--- a/lib/stdlib/test/gen_fsm_SUITE.erl
+++ b/lib/stdlib/test/gen_fsm_SUITE.erl
@@ -320,9 +320,32 @@ sys1(Config) when is_list(Config) ->
call_format_status(Config) when is_list(Config) ->
?line {ok, Pid} = gen_fsm:start(gen_fsm_SUITE, [], []),
?line Status = sys:get_status(Pid),
- ?line {status, Pid, _Mod, [_PDict, running, _Parent, _, Data]} = Status,
+ ?line {status, Pid, _Mod, [_PDict, running, _, _, Data]} = Status,
?line [format_status_called | _] = lists:reverse(Data),
- ?line stop_it(Pid).
+ ?line stop_it(Pid),
+
+ %% check that format_status can handle a name being an atom (pid is
+ %% already checked by the previous test)
+ ?line {ok, Pid2} = gen_fsm:start({local, gfsm}, gen_fsm_SUITE, [], []),
+ ?line Status2 = sys:get_status(gfsm),
+ ?line {status, Pid2, _Mod, [_PDict2, running, _, _, Data2]} = Status2,
+ ?line [format_status_called | _] = lists:reverse(Data2),
+ ?line stop_it(Pid2),
+
+ %% check that format_status can handle a name being a term other than a
+ %% pid or atom
+ GlobalName1 = {global, "CallFormatStatus"},
+ ?line {ok, Pid3} = gen_fsm:start(GlobalName1, gen_fsm_SUITE, [], []),
+ ?line Status3 = sys:get_status(GlobalName1),
+ ?line {status, Pid3, _Mod, [_PDict3, running, _, _, Data3]} = Status3,
+ ?line [format_status_called | _] = lists:reverse(Data3),
+ ?line stop_it(Pid3),
+ GlobalName2 = {global, {name, "term"}},
+ ?line {ok, Pid4} = gen_fsm:start(GlobalName2, gen_fsm_SUITE, [], []),
+ ?line Status4 = sys:get_status(GlobalName2),
+ ?line {status, Pid4, _Mod, [_PDict4, running, _, _, Data4]} = Status4,
+ ?line [format_status_called | _] = lists:reverse(Data4),
+ ?line stop_it(Pid4).
error_format_status(Config) when is_list(Config) ->
?line error_logger_forwarder:register(),
@@ -345,7 +368,6 @@ error_format_status(Config) when is_list(Config) ->
process_flag(trap_exit, OldFl),
ok.
-
%% Hibernation
hibernate(suite) -> [];
hibernate(Config) when is_list(Config) ->
diff --git a/lib/stdlib/test/gen_server_SUITE.erl b/lib/stdlib/test/gen_server_SUITE.erl
index 0966734c89..99388ba2e3 100644
--- a/lib/stdlib/test/gen_server_SUITE.erl
+++ b/lib/stdlib/test/gen_server_SUITE.erl
@@ -905,6 +905,28 @@ call_format_status(Config) when is_list(Config) ->
?line Status2 = sys:get_status(call_format_status, 5000),
?line {status, Pid, _Mod, [_PDict, running, _Parent, _, Data2]} = Status2,
?line [format_status_called | _] = lists:reverse(Data2),
+
+ %% check that format_status can handle a name being a pid (atom is
+ %% already checked by the previous test)
+ ?line {ok, Pid3} = gen_server:start_link(gen_server_SUITE, [], []),
+ ?line Status3 = sys:get_status(Pid3),
+ ?line {status, Pid3, _Mod, [_PDict3, running, _Parent, _, Data3]} = Status3,
+ ?line [format_status_called | _] = lists:reverse(Data3),
+
+ %% check that format_status can handle a name being a term other than a
+ %% pid or atom
+ GlobalName1 = {global, "CallFormatStatus"},
+ ?line {ok, Pid4} = gen_server:start_link(GlobalName1,
+ gen_server_SUITE, [], []),
+ ?line Status4 = sys:get_status(Pid4),
+ ?line {status, Pid4, _Mod, [_PDict4, running, _Parent, _, Data4]} = Status4,
+ ?line [format_status_called | _] = lists:reverse(Data4),
+ GlobalName2 = {global, {name, "term"}},
+ ?line {ok, Pid5} = gen_server:start_link(GlobalName2,
+ gen_server_SUITE, [], []),
+ ?line Status5 = sys:get_status(GlobalName2),
+ ?line {status, Pid5, _Mod, [_PDict5, running, _Parent, _, Data5]} = Status5,
+ ?line [format_status_called | _] = lists:reverse(Data5),
ok.
%% Verify that error termination correctly calls our format_status/2 fun
diff --git a/lib/stdlib/test/qlc_SUITE.erl b/lib/stdlib/test/qlc_SUITE.erl
index aa12ed57da..e21de8770a 100644
--- a/lib/stdlib/test/qlc_SUITE.erl
+++ b/lib/stdlib/test/qlc_SUITE.erl
@@ -3184,7 +3184,9 @@ lookup2(Config) when is_list(Config) ->
[] = qlc:e(Q),
false = lookup_keys(Q)
end, [{1,b},{2,3}])">>,
- {warnings,[{{3,48},qlc,nomatch_filter}]}},
+ {warnings,[{2,sys_core_fold,nomatch_guard},
+ {3,qlc,nomatch_filter},
+ {3,sys_core_fold,{eval_failure,badarg}}]}},
<<"etsc(fun(E) ->
Q = qlc:q([X || {X} <- ets:table(E), element(1,{X}) =:= 1]),
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-22 03:32:26 +0000