aboutsummaryrefslogtreecommitdiffstats
path: root/lib/compiler
diff options
context:
space:
mode:
Diffstat (limited to 'lib/compiler')
-rw-r--r--lib/compiler/src/beam_bool.erl7
-rw-r--r--lib/compiler/src/beam_jump.erl1
-rw-r--r--lib/compiler/src/cerl.erl67
-rw-r--r--lib/compiler/src/cerl_clauses.erl11
-rw-r--r--lib/compiler/src/cerl_inline.erl25
-rw-r--r--lib/compiler/src/cerl_trees.erl8
-rw-r--r--lib/compiler/src/compile.erl59
-rw-r--r--lib/compiler/src/core_lib.erl2
-rw-r--r--lib/compiler/src/core_parse.hrl2
-rw-r--r--lib/compiler/src/core_parse.yrl8
-rw-r--r--lib/compiler/src/core_pp.erl14
-rw-r--r--lib/compiler/src/erl_bifs.erl1
-rw-r--r--lib/compiler/src/sys_core_fold.erl19
-rw-r--r--lib/compiler/src/v3_core.erl58
-rw-r--r--lib/compiler/src/v3_kernel.erl34
-rw-r--r--lib/compiler/src/v3_kernel_pp.erl18
-rw-r--r--lib/compiler/test/andor_SUITE.erl2
-rw-r--r--lib/compiler/test/core_SUITE_data/map_core_test.core4
-rw-r--r--lib/compiler/test/core_fold_SUITE.erl13
-rw-r--r--lib/compiler/test/error_SUITE.erl28
-rw-r--r--lib/compiler/test/map_SUITE.erl15
-rw-r--r--lib/compiler/test/warnings_SUITE.erl56
22 files changed, 374 insertions, 78 deletions
diff --git a/lib/compiler/src/beam_bool.erl b/lib/compiler/src/beam_bool.erl
index d01f9ee13d..5a4621dc37 100644
--- a/lib/compiler/src/beam_bool.erl
+++ b/lib/compiler/src/beam_bool.erl
@@ -438,9 +438,10 @@ bopt_bool_args(As, Forest) ->
mapfoldl(fun bopt_bool_arg/2, Forest, As).
bopt_bool_arg({T,_}=R, Forest) when T =:= x; T =:= y; T =:= tmp ->
- Val = case gb_trees:get(R, Forest) of
- any -> {test,is_eq_exact,fail,[R,{atom,true}]};
- Val0 -> Val0
+ Val = case gb_trees:lookup(R, Forest) of
+ {value,any} -> {test,is_eq_exact,fail,[R,{atom,true}]};
+ {value,Val0} -> Val0;
+ none -> throw(mixed)
end,
{Val,gb_trees:delete(R, Forest)};
bopt_bool_arg(Term, Forest) ->
diff --git a/lib/compiler/src/beam_jump.erl b/lib/compiler/src/beam_jump.erl
index 100acaede3..b952139f2c 100644
--- a/lib/compiler/src/beam_jump.erl
+++ b/lib/compiler/src/beam_jump.erl
@@ -446,6 +446,7 @@ is_label_used_in_2({set,_,_,Info}, Lbl) ->
case Info of
{bif,_,{f,F}} -> F =:= Lbl;
{alloc,_,{gc_bif,_,{f,F}}} -> F =:= Lbl;
+ {alloc,_,{put_map,_,{f,F}}} -> F =:= Lbl;
{'catch',{f,F}} -> F =:= Lbl;
{alloc,_,_} -> false;
{put_tuple,_} -> false;
diff --git a/lib/compiler/src/cerl.erl b/lib/compiler/src/cerl.erl
index 3c121f3b04..ecc4b2c9b1 100644
--- a/lib/compiler/src/cerl.erl
+++ b/lib/compiler/src/cerl.erl
@@ -124,9 +124,9 @@
%% keep map exports here for now
map_es/1,
- map_val/1,
+ map_arg/1,
update_c_map/3,
- ann_c_map/3,
+ ann_c_map/2, ann_c_map/3,
map_pair_op/1,map_pair_key/1,map_pair_val/1,
update_c_map_pair/4,
ann_c_map_pair/4
@@ -135,6 +135,9 @@
-export_type([c_binary/0, c_call/0, c_clause/0, c_cons/0, c_fun/0, c_literal/0,
c_module/0, c_tuple/0, c_values/0, c_var/0, cerl/0, var_name/0]).
+%% HiPE does not understand Maps
+%% (guard functions is_map/1 and map_size/1 in ann_c_map/3)
+-compile(no_native).
%%
%% needed by the include file below -- do not move
%%
@@ -1575,20 +1578,70 @@ ann_make_list(_, [], Node) ->
%% ---------------------------------------------------------------------
%% maps
--spec map_es(c_map()) -> [cerl()].
+-spec map_es(c_map()) -> [c_map_pair()].
map_es(#c_map{es = Es}) ->
Es.
--spec map_val(c_map()) -> cerl().
-map_val(#c_map{var = M}) ->
+-spec map_arg(c_map()) -> c_map() | c_literal().
+
+map_arg(#c_map{arg = M}) ->
M.
+-spec ann_c_map([term()], [cerl()]) -> c_map() | c_literal().
+
+ann_c_map(As,Es) ->
+ ann_c_map(As, #c_literal{val=#{}}, Es).
+
+-spec ann_c_map([term()], c_map() | c_literal(), [c_map_pair()]) -> c_map() | c_literal().
+
+ann_c_map(As,#c_literal{val=Mval}=M,Es) when is_map(Mval), map_size(Mval) =:= 0 ->
+ Pairs = [[Ck,Cv]||#c_map_pair{key=Ck,val=Cv}<-Es],
+ IsLit = lists:foldl(fun(Pair,Res) ->
+ Res andalso is_lit_list(Pair)
+ end, true, Pairs),
+ Fun = fun(Pair) -> [K,V] = lit_list_vals(Pair), {K,V} end,
+ case IsLit of
+ false ->
+ #c_map{arg=M, es=Es, anno=As };
+ true ->
+ #c_literal{anno=As, val=maps:from_list(lists:map(Fun, Pairs))}
+ end;
+ann_c_map(As,#c_literal{val=M},Es) when is_map(M) ->
+ fold_map_pairs(As,Es,M);
ann_c_map(As,M,Es) ->
- #c_map{var=M,es = Es, anno = As }.
+ #c_map{arg=M, es=Es, anno=As }.
+
+fold_map_pairs(As,[],M) -> #c_literal{anno=As,val=M};
+%% M#{ K => V}
+fold_map_pairs(As,[#c_map_pair{op=#c_literal{val=assoc},key=Ck,val=Cv}=E|Es],M) ->
+ case is_lit_list([Ck,Cv]) of
+ true ->
+ [K,V] = lit_list_vals([Ck,Cv]),
+ fold_map_pairs(As,Es,maps:put(K,V,M));
+ false ->
+ #c_map{arg=#c_literal{val=M,anno=As}, es=[E|Es], anno=As }
+ end;
+%% M#{ K := V}
+fold_map_pairs(As,[#c_map_pair{op=#c_literal{val=exact},key=Ck,val=Cv}=E|Es],M) ->
+ case is_lit_list([Ck,Cv]) of
+ true ->
+ [K,V] = lit_list_vals([Ck,Cv]),
+ case maps:is_key(K,M) of
+ true -> fold_map_pairs(As,Es,maps:put(K,V,M));
+ false ->
+ #c_map{arg=#c_literal{val=M,anno=As}, es=[E|Es], anno=As }
+ end;
+ false ->
+ #c_map{arg=#c_literal{val=M,anno=As}, es=[E|Es], anno=As }
+ end;
+fold_map_pairs(As,Es,M) ->
+ #c_map{arg=#c_literal{val=M,anno=As}, es=Es, anno=As }.
+
+%-spec update_c_map(c_map() | c_literal(), [c_map_pair()]) -> c_map() | c_literal().
update_c_map(Old,M,Es) ->
- #c_map{var=M, es = Es, anno = get_ann(Old)}.
+ #c_map{arg=M, es = Es, anno = get_ann(Old)}.
map_pair_key(#c_map_pair{key=K}) -> K.
map_pair_val(#c_map_pair{val=V}) -> V.
diff --git a/lib/compiler/src/cerl_clauses.erl b/lib/compiler/src/cerl_clauses.erl
index 76d70dcabf..87bd47c08b 100644
--- a/lib/compiler/src/cerl_clauses.erl
+++ b/lib/compiler/src/cerl_clauses.erl
@@ -356,14 +356,19 @@ match(P, E, Bs) ->
end;
map ->
%% The most we can do is to say "definitely no match" if a
- %% binary pattern is matched against non-binary data.
+ %% map pattern is matched against non-map data.
case E of
any ->
{false, Bs};
_ ->
case type(E) of
- literal ->
- none;
+ literal ->
+ case is_map(concrete(E)) of
+ false ->
+ none;
+ true ->
+ {false, Bs}
+ end;
cons ->
none;
tuple ->
diff --git a/lib/compiler/src/cerl_inline.erl b/lib/compiler/src/cerl_inline.erl
index 44293bb8ce..75740e8b9d 100644
--- a/lib/compiler/src/cerl_inline.erl
+++ b/lib/compiler/src/cerl_inline.erl
@@ -42,7 +42,7 @@
bitstr_flags/1, binary_segments/1, update_c_alias/3,
update_c_apply/3, update_c_binary/2, update_c_bitstr/6,
update_c_call/4, update_c_case/3, update_c_catch/2,
- update_c_clause/4, c_fun/2, c_int/1, c_let/3,
+ update_c_clause/4, c_fun/2, c_int/1, c_let/3, ann_c_let/4,
update_c_let/4, update_c_letrec/3, update_c_module/5,
update_c_primop/3, update_c_receive/4, update_c_seq/3,
c_seq/2, update_c_try/6, c_tuple/1, update_c_values/2,
@@ -51,7 +51,7 @@
catch_body/1, clause_body/1, clause_guard/1,
clause_pats/1, clause_vars/1, concrete/1, cons_hd/1,
cons_tl/1, data_arity/1, data_es/1, data_type/1,
- fun_body/1, fun_vars/1, get_ann/1, int_val/1,
+ fname_arity/1, fun_body/1, fun_vars/1, get_ann/1, int_val/1,
is_c_atom/1, is_c_cons/1, is_c_fname/1, is_c_int/1,
is_c_list/1, is_c_seq/1, is_c_tuple/1, is_c_var/1,
is_data/1, is_literal/1, is_literal_term/1, let_arg/1,
@@ -64,7 +64,7 @@
seq_body/1, set_ann/2, try_arg/1, try_body/1, try_vars/1,
try_evars/1, try_handler/1, tuple_es/1, tuple_arity/1,
type/1, values_es/1, var_name/1,
- map_val/1, map_es/1, update_c_map/3,
+ map_arg/1, map_es/1, update_c_map/3,
update_c_map_pair/4,
map_pair_op/1, map_pair_key/1, map_pair_val/1
]).
@@ -1030,8 +1030,17 @@ i_apply(E, Ctxt, Ren, Env, S) ->
visit_and_count_size(Opnd, S)
end,
S3, Opnds),
- N = apply_size(length(Es)),
- {update_c_apply(E, E1, Es), count_size(N, S4)}
+ Arity = length(Es),
+ E2 = case is_c_fname(E1) andalso length(Es) =/= fname_arity(E1) of
+ true ->
+ V = new_var(Env),
+ ann_c_let(get_ann(E), [V], E1,
+ update_c_apply(E, V, Es));
+ false ->
+ update_c_apply(E, E1, Es)
+ end,
+ N = apply_size(Arity),
+ {E2, count_size(N, S4)}
end.
apply_size(A) ->
@@ -1334,7 +1343,7 @@ i_bitstr(E, Ren, Env, S) ->
i_map(E, Ctx, Ren, Env, S) ->
%% Visit the segments for value.
- {M1, S1} = i(map_val(E), value, Ren, Env, S),
+ {M1, S1} = i(map_arg(E), value, Ren, Env, S),
{Es, S2} = mapfoldl(fun (E, S) ->
i_map_pair(E, Ctx, Ren, Env, S)
end, S1, map_es(E)),
@@ -1411,8 +1420,8 @@ i_pattern(E, Ren, Env, Ren0, Env0, S) ->
S2 = count_size(weight(binary), S1),
{update_c_binary(E, Es), S2};
map ->
- %% map patterns should not have vals
- M = map_val(E),
+ %% map patterns should not have args
+ M = map_arg(E),
{Es, S1} = mapfoldl(fun (E, S) ->
i_map_pair_pattern(E, Ren, Env, Ren0, Env0, S)
diff --git a/lib/compiler/src/cerl_trees.erl b/lib/compiler/src/cerl_trees.erl
index 2ebeab243f..e53bdd4efb 100644
--- a/lib/compiler/src/cerl_trees.erl
+++ b/lib/compiler/src/cerl_trees.erl
@@ -57,7 +57,7 @@
update_c_try/6, update_c_tuple/2, update_c_tuple_skel/2,
update_c_values/2, values_es/1, var_name/1,
- map_val/1, map_es/1,
+ map_arg/1, map_es/1,
ann_c_map/3,
update_c_map/3,
map_pair_key/1,map_pair_val/1,map_pair_op/1,
@@ -138,7 +138,7 @@ map_1(F, T) ->
tuple ->
update_c_tuple_skel(T, map_list(F, tuple_es(T)));
map ->
- update_c_map(T, map(F,map_val(T)), map_list(F, map_es(T)));
+ update_c_map(T, map(F, map_arg(T)), map_list(F, map_es(T)));
map_pair ->
update_c_map_pair(T, map(F, map_pair_op(T)),
map(F, map_pair_key(T)),
@@ -372,7 +372,7 @@ mapfold(F, S0, T) ->
{Ts, S1} = mapfold_list(F, S0, tuple_es(T)),
F(update_c_tuple_skel(T, Ts), S1);
map ->
- {M , S1} = mapfold(F, S0, map_val(T)),
+ {M , S1} = mapfold(F, S0, map_arg(T)),
{Ts, S2} = mapfold_list(F, S1, map_es(T)),
F(update_c_map(T, M, Ts), S2);
map_pair ->
@@ -724,7 +724,7 @@ label(T, N, Env) ->
{As, N2} = label_ann(T, N1),
{ann_c_tuple_skel(As, Ts), N2};
map ->
- {M, N1} = label(map_val(T), N, Env),
+ {M, N1} = label(map_arg(T), N, Env),
{Ts, N2} = label_list(map_es(T), N1, Env),
{As, N3} = label_ann(T, N2),
{ann_c_map(As, M, Ts), N3};
diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl
index 9030dd998b..c7d91070f6 100644
--- a/lib/compiler/src/compile.erl
+++ b/lib/compiler/src/compile.erl
@@ -234,7 +234,9 @@ format_error({crash,Pass,Reason}) ->
format_error({bad_return,Pass,Reason}) ->
io_lib:format("internal error in ~p;\nbad return value: ~ts", [Pass,format_error_reason(Reason)]);
format_error({module_name,Mod,Filename}) ->
- io_lib:format("Module name '~s' does not match file name '~ts'", [Mod,Filename]).
+ io_lib:format("Module name '~s' does not match file name '~ts'", [Mod,Filename]);
+format_error(reparsing_invalid_unicode) ->
+ "Non-UTF-8 character(s) detected, but no encoding declared. Encode the file in UTF-8 or add \"%% coding: latin-1\" at the beginning of the file. Retrying with latin-1 encoding.".
format_error_reason({Reason, Stack}) when is_list(Stack) ->
StackFun = fun
@@ -792,20 +794,59 @@ no_native_compilation(BeamFile, #compile{options=Opts0}) ->
_ -> false
end.
-parse_module(St) ->
- Opts = St#compile.options,
- Cwd = ".",
- IncludePath = [Cwd, St#compile.dir|inc_paths(Opts)],
- R = epp:parse_file(St#compile.ifile, IncludePath, pre_defs(Opts)),
+parse_module(St0) ->
+ case do_parse_module(utf8, St0) of
+ {ok,_}=Ret ->
+ Ret;
+ {error,_}=Ret ->
+ Ret;
+ {invalid_unicode,File,Line} ->
+ case do_parse_module(latin1, St0) of
+ {ok,St} ->
+ Es = [{File,[{Line,?MODULE,reparsing_invalid_unicode}]}],
+ {ok,St#compile{warnings=Es++St#compile.warnings}};
+ {error,St} ->
+ Es = [{File,[{Line,?MODULE,reparsing_invalid_unicode}]}],
+ {error,St#compile{errors=Es++St#compile.errors}}
+ end
+ end.
+
+do_parse_module(DefEncoding, #compile{ifile=File,options=Opts,dir=Dir}=St) ->
+ R = epp:parse_file(File,
+ [{includes,[".",Dir|inc_paths(Opts)]},
+ {macros,pre_defs(Opts)},
+ {default_encoding,DefEncoding},
+ extra]),
case R of
- {ok,Forms} ->
- Encoding = epp:read_encoding(St#compile.ifile),
- {ok,St#compile{code=Forms,encoding=Encoding}};
+ {ok,Forms,Extra} ->
+ Encoding = proplists:get_value(encoding, Extra),
+ case find_invalid_unicode(Forms, File) of
+ none ->
+ {ok,St#compile{code=Forms,encoding=Encoding}};
+ {invalid_unicode,_,_}=Ret ->
+ case Encoding of
+ none ->
+ Ret;
+ _ ->
+ {ok,St#compile{code=Forms,encoding=Encoding}}
+ end
+ end;
{error,E} ->
Es = [{St#compile.ifile,[{none,?MODULE,{epp,E}}]}],
{error,St#compile{errors=St#compile.errors ++ Es}}
end.
+find_invalid_unicode([H|T], File0) ->
+ case H of
+ {attribute,_,file,{File,_}} ->
+ find_invalid_unicode(T, File);
+ {error,{Line,file_io_server,invalid_unicode}} ->
+ {invalid_unicode,File0,Line};
+ _Other ->
+ find_invalid_unicode(T, File0)
+ end;
+find_invalid_unicode([], _) -> none.
+
parse_core(St) ->
case file:read_file(St#compile.ifile) of
{ok,Bin} ->
diff --git a/lib/compiler/src/core_lib.erl b/lib/compiler/src/core_lib.erl
index ed181e3baa..93ec3bbad5 100644
--- a/lib/compiler/src/core_lib.erl
+++ b/lib/compiler/src/core_lib.erl
@@ -105,7 +105,7 @@ vu_expr(V, #c_cons{hd=H,tl=T}) ->
vu_expr(V, H) orelse vu_expr(V, T);
vu_expr(V, #c_tuple{es=Es}) ->
vu_expr_list(V, Es);
-vu_expr(V, #c_map{var=M,es=Es}) ->
+vu_expr(V, #c_map{arg=M,es=Es}) ->
vu_expr(V, M) orelse vu_expr_list(V, Es);
vu_expr(V, #c_map_pair{key=Key,val=Val}) ->
vu_expr_list(V, [Key,Val]);
diff --git a/lib/compiler/src/core_parse.hrl b/lib/compiler/src/core_parse.hrl
index d54715ef59..20f3a46991 100644
--- a/lib/compiler/src/core_parse.hrl
+++ b/lib/compiler/src/core_parse.hrl
@@ -103,5 +103,5 @@
val}).
-record(c_map, {anno=[],
- var=#c_literal{val=[]} :: #c_var{} | #c_literal{},
+ arg=#c_literal{val=#{}} :: #c_var{} | #c_literal{},
es :: [#c_map_pair{}]}).
diff --git a/lib/compiler/src/core_parse.yrl b/lib/compiler/src/core_parse.yrl
index b8db0f683a..a66ad4235f 100644
--- a/lib/compiler/src/core_parse.yrl
+++ b/lib/compiler/src/core_parse.yrl
@@ -21,7 +21,7 @@
%% Have explicit productions for annotated phrases named anno_XXX.
%% This just does an XXX and adds the annotation.
-Expect 1.
+Expect 0.
Nonterminals
@@ -285,9 +285,9 @@ tuple -> '{' '}' : c_tuple([]).
tuple -> '{' anno_expressions '}' : c_tuple('$2').
map_expr -> '~' '{' '}' '~' : #c_map{es=[]}.
-map_expr -> '~' '{' map_pairs '}' '~' : #c_map{es='$3'}.
-map_expr -> variable '~' '{' '}' '~' : #c_map{var='$1',es=[]}.
-map_expr -> variable '~' '{' map_pairs '}' '~' : #c_map{var='$1',es='$4'}.
+map_expr -> '~' '{' map_pairs '}' '~' : #c_map{es='$3'}.
+map_expr -> '~' '{' map_pairs '|' variable '}' '~' : #c_map{arg='$5',es='$3'}.
+map_expr -> '~' '{' map_pairs '|' map_expr '}' '~' : #c_map{arg='$5',es='$3'}.
map_pairs -> map_pair : ['$1'].
map_pairs -> map_pair ',' map_pairs : ['$1' | '$3'].
diff --git a/lib/compiler/src/core_pp.erl b/lib/compiler/src/core_pp.erl
index faa26ec6df..a76327457d 100644
--- a/lib/compiler/src/core_pp.erl
+++ b/lib/compiler/src/core_pp.erl
@@ -118,6 +118,12 @@ format_1(#c_literal{val=Tuple}, Ctxt) when is_tuple(Tuple) ->
format_1(#c_literal{anno=A,val=Bitstring}, Ctxt) when is_bitstring(Bitstring) ->
Segs = segs_from_bitstring(Bitstring),
format_1(#c_binary{anno=A,segments=Segs}, Ctxt);
+format_1(#c_literal{anno=A,val=M},Ctxt) when is_map(M) ->
+ Pairs = maps:to_list(M),
+ Cpairs = [#c_map_pair{op=#c_literal{val=assoc},
+ key=#c_literal{val=V},
+ val=#c_literal{val=K}} || {K,V} <- Pairs],
+ format_1(#c_map{anno=A,arg=#c_literal{val=#{}},es=Cpairs},Ctxt);
format_1(#c_var{name={I,A}}, _) ->
[core_atom(I),$/,integer_to_list(A)];
format_1(#c_var{name=V}, _) ->
@@ -161,15 +167,15 @@ format_1(#c_tuple{es=Es}, Ctxt) ->
format_hseq(Es, ",", add_indent(Ctxt, 1), fun format/2),
$}
];
-format_1(#c_map{var=#c_var{}=Var,es=Es}, Ctxt) ->
- [format_1(Var, Ctxt),
- "~{",
+format_1(#c_map{arg=#c_literal{val=M},es=Es}, Ctxt) when is_map(M),map_size(M)=:=0 ->
+ ["~{",
format_hseq(Es, ",", add_indent(Ctxt, 1), fun format/2),
"}~"
];
-format_1(#c_map{es=Es}, Ctxt) ->
+format_1(#c_map{arg=Var,es=Es}, Ctxt) ->
["~{",
format_hseq(Es, ",", add_indent(Ctxt, 1), fun format/2),
+ "|",format(Var, add_indent(Ctxt, 1)),
"}~"
];
format_1(#c_map_pair{op=#c_literal{val=assoc},key=K,val=V}, Ctxt) ->
diff --git a/lib/compiler/src/erl_bifs.erl b/lib/compiler/src/erl_bifs.erl
index 3ad3c8c690..6c75538194 100644
--- a/lib/compiler/src/erl_bifs.erl
+++ b/lib/compiler/src/erl_bifs.erl
@@ -91,6 +91,7 @@ is_pure(erlang, is_float, 1) -> true;
is_pure(erlang, is_function, 1) -> true;
is_pure(erlang, is_integer, 1) -> true;
is_pure(erlang, is_list, 1) -> true;
+is_pure(erlang, is_map, 1) -> true;
is_pure(erlang, is_number, 1) -> true;
is_pure(erlang, is_pid, 1) -> true;
is_pure(erlang, is_port, 1) -> true;
diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl
index 6fdeea51d1..52d6dfe184 100644
--- a/lib/compiler/src/sys_core_fold.erl
+++ b/lib/compiler/src/sys_core_fold.erl
@@ -72,7 +72,7 @@
-import(lists, [map/2,foldl/3,foldr/3,mapfoldl/3,all/2,any/2,
reverse/1,reverse/2,member/2,nth/2,flatten/1,unzip/1]).
--import(cerl, [ann_c_cons/3,ann_c_tuple/2]).
+-import(cerl, [ann_c_cons/3,ann_c_map/3,ann_c_tuple/2]).
-include("core_parse.hrl").
@@ -246,7 +246,7 @@ expr(#c_tuple{anno=Anno,es=Es0}=Tuple, Ctxt, Sub) ->
value ->
ann_c_tuple(Anno, Es)
end;
-expr(#c_map{var=V0,es=Es0}=Map, Ctxt, Sub) ->
+expr(#c_map{anno=Anno,arg=V0,es=Es0}=Map, Ctxt, Sub) ->
Es = pair_list(Es0, Ctxt, Sub),
case Ctxt of
effect ->
@@ -254,7 +254,7 @@ expr(#c_map{var=V0,es=Es0}=Map, Ctxt, Sub) ->
expr(make_effect_seq(Es, Sub), Ctxt, Sub);
value ->
V = expr(V0, Ctxt, Sub),
- Map#c_map{var=V,es=Es}
+ ann_c_map(Anno,V,Es)
end;
expr(#c_binary{segments=Ss}=Bin0, Ctxt, Sub) ->
%% Warn for useless building, but always build the binary
@@ -1378,6 +1378,7 @@ eval_is_record(Call, _, _, _, _) -> Call.
is_not_integer(#c_literal{val=Val}) when not is_integer(Val) -> true;
is_not_integer(#c_tuple{}) -> true;
is_not_integer(#c_cons{}) -> true;
+is_not_integer(#c_map{}) -> true;
is_not_integer(_) -> false.
%% is_not_tuple(Core) -> true | false.
@@ -1385,6 +1386,7 @@ is_not_integer(_) -> false.
is_not_tuple(#c_literal{val=Val}) when not is_tuple(Val) -> true;
is_not_tuple(#c_cons{}) -> true;
+is_not_tuple(#c_map{}) -> true;
is_not_tuple(_) -> false.
%% eval_setelement(Call, Pos, Tuple, NewVal) -> Core.
@@ -1810,9 +1812,14 @@ opt_bool_clauses([#c_clause{pats=[#c_literal{val=Lit}],
true ->
%% This clause will match.
C = C0#c_clause{body=opt_bool_case(B)},
- case Lit of
- false -> [C|opt_bool_clauses(Cs, SeenT, true)];
- true -> [C|opt_bool_clauses(Cs, true, SeenF)]
+ case {Lit,SeenT,SeenF} of
+ {false,_,false} ->
+ [C|opt_bool_clauses(Cs, SeenT, true)];
+ {true,false,_} ->
+ [C|opt_bool_clauses(Cs, true, SeenF)];
+ _ ->
+ add_warning(C, nomatch_shadow),
+ opt_bool_clauses(Cs, SeenT, SeenF)
end
end;
opt_bool_clauses([#c_clause{pats=Ps,guard=#c_literal{val=true}}=C|Cs], SeenT, SeenF) ->
diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl
index 3d17557e01..04210ae243 100644
--- a/lib/compiler/src/v3_core.erl
+++ b/lib/compiler/src/v3_core.erl
@@ -77,7 +77,8 @@
splitwith/2,keyfind/3,sort/1,foreach/2,droplast/1,last/1]).
-import(ordsets, [add_element/2,del_element/2,is_element/2,
union/1,union/2,intersection/2,subtract/2]).
--import(cerl, [ann_c_cons/3,ann_c_cons_skel/3,ann_c_tuple/2,c_tuple/1]).
+-import(cerl, [ann_c_cons/3,ann_c_cons_skel/3,ann_c_tuple/2,c_tuple/1,
+ ann_c_map/2, ann_c_map/3]).
-include("core_parse.hrl").
@@ -515,12 +516,20 @@ expr({map,L,Es0}, St0) ->
% in map construction.
{Es1,Eps,St1} = map_pair_list(Es0, St0),
A = lineno_anno(L, St1),
- {#c_map{anno=A,es=Es1},Eps,St1};
+ {ann_c_map(A,Es1),Eps,St1};
expr({map,L,M0,Es0}, St0) ->
- {M1,Mps,St1} = safe(M0, St0),
- {Es1,Eps,St2} = map_pair_list(Es0, St1),
- A = lineno_anno(L, St2),
- {#c_map{anno=A,var=M1,es=Es1},Mps++Eps,St2};
+ try expr_map(M0,Es0,lineno_anno(L, St0),St0) of
+ {_,_,_}=Res -> Res
+ catch
+ throw:bad_map ->
+ St = add_warning(L, bad_map, St0),
+ LineAnno = lineno_anno(L, St),
+ As = [#c_literal{anno=LineAnno,val=badarg}],
+ {#icall{anno=#a{anno=LineAnno}, %Must have an #a{}
+ module=#c_literal{anno=LineAnno,val=erlang},
+ name=#c_literal{anno=LineAnno,val=error},
+ args=As},[],St}
+ end;
expr({bin,L,Es0}, St0) ->
try expr_bin(Es0, lineno_anno(L, St0), St0) of
{_,_,_}=Res -> Res
@@ -730,6 +739,37 @@ make_bool_switch_guard(L, E, V, T, F) ->
{clause,NegL,[V],[],[V]}
]}.
+expr_map(M0,Es0,A,St0) ->
+ {M1,Mps,St1} = safe(M0, St0),
+ case is_valid_map_src(M1) of
+ true ->
+ case {M1,Es0} of
+ {#c_var{}, []} ->
+ %% transform M#{} to is_map(M)
+ {Vpat,St2} = new_var(St1),
+ {Fpat,St3} = new_var(St2),
+ Cs = [#iclause{
+ anno=A,
+ pats=[Vpat],
+ guard=[#icall{anno=#a{anno=A},
+ module=#c_literal{anno=A,val=erlang},
+ name=#c_literal{anno=A,val=is_map},
+ args=[Vpat]}],
+ body=[Vpat]}],
+ Fc = fail_clause([Fpat], A, #c_literal{val=badarg}),
+ {#icase{anno=#a{anno=A},args=[M1],clauses=Cs,fc=Fc},Mps,St3};
+ {_,_} ->
+ {Es1,Eps,St2} = map_pair_list(Es0, St1),
+ {ann_c_map(A,M1,Es1),Mps++Eps,St2}
+ end;
+ false -> throw(bad_map)
+ end.
+
+is_valid_map_src(#c_literal{val = M}) when is_map(M) -> true;
+is_valid_map_src(#c_map{}) -> true;
+is_valid_map_src(#c_var{}) -> true;
+is_valid_map_src(_) -> false.
+
map_pair_list(Es, St) ->
foldr(fun
({map_field_assoc,L,K0,V0}, {Ces,Esp,St0}) ->
@@ -2166,6 +2206,8 @@ lit_vars(Lit) -> lit_vars(Lit, []).
lit_vars(#c_cons{hd=H,tl=T}, Vs) -> lit_vars(H, lit_vars(T, Vs));
lit_vars(#c_tuple{es=Es}, Vs) -> lit_list_vars(Es, Vs);
+lit_vars(#c_map{arg=V,es=Es}, Vs) -> lit_vars(V, lit_list_vars(Es, Vs));
+lit_vars(#c_map_pair{key=K,val=V}, Vs) -> lit_vars(K, lit_vars(V, Vs));
lit_vars(#c_var{name=V}, Vs) -> add_element(V, Vs);
lit_vars(_, Vs) -> Vs. %These are atomic
@@ -2256,7 +2298,9 @@ is_simple_list(Es) -> lists:all(fun is_simple/1, Es).
format_error(nomatch) ->
"pattern cannot possibly match";
format_error(bad_binary) ->
- "binary construction will fail because of a type mismatch".
+ "binary construction will fail because of a type mismatch";
+format_error(bad_map) ->
+ "map construction will fail because of a type mismatch".
add_warning(Line, Term, #core{ws=Ws,file=[{file,File}]}=St) when Line >= 0 ->
St#core{ws=[{File,[{location(Line),?MODULE,Term}]}|Ws]};
diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl
index d00dd56f30..d3b785aa14 100644
--- a/lib/compiler/src/v3_kernel.erl
+++ b/lib/compiler/src/v3_kernel.erl
@@ -272,9 +272,18 @@ expr(#c_cons{anno=A,hd=Ch,tl=Ct}, Sub, St0) ->
expr(#c_tuple{anno=A,es=Ces}, Sub, St0) ->
{Kes,Ep,St1} = atomic_list(Ces, Sub, St0),
{#k_tuple{anno=A,es=Kes},Ep,St1};
-expr(#c_map{anno=A,var=Var0,es=Ces}, Sub, St0) ->
- {Var,[],St1} = expr(Var0, Sub, St0),
- map_split_pairs(A, Var, Ces, Sub, St1);
+expr(#c_map{anno=A,arg=Var,es=Ces}, Sub, St0) ->
+ try expr_map(A,Var,Ces,Sub,St0) of
+ {_,_,_}=Res -> Res
+ catch
+ throw:bad_map ->
+ St1 = add_warning(get_line(A), bad_map, A, St0),
+ Erl = #c_literal{val=erlang},
+ Name = #c_literal{val=error},
+ Args = [#c_literal{val=badarg}],
+ Error = #c_call{anno=A,module=Erl,name=Name,args=Args},
+ expr(Error, Sub, St1)
+ end;
expr(#c_binary{anno=A,segments=Cv}, Sub, St0) ->
try atomic_bin(Cv, Sub, St0) of
{Kv,Ep,St1} ->
@@ -496,6 +505,21 @@ translate_match_fail_1(Anno, As, Sub, #kern{ff=FF}) ->
translate_fc(Args) ->
[#c_literal{val=function_clause},make_list(Args)].
+expr_map(A,Var0,Ces,Sub,St0) ->
+ %% An extra pass of validation of Map src because of inlining
+ {Var,Mps,St1} = expr(Var0, Sub, St0),
+ case is_valid_map_src(Var) of
+ true ->
+ {Km,Eps,St2} = map_split_pairs(A, Var, Ces, Sub, St1),
+ {Km,Eps++Mps,St2};
+ false -> throw(bad_map)
+ end.
+
+is_valid_map_src(#k_map{}) -> true;
+is_valid_map_src(#k_literal{val=M}) when is_map(M) -> true;
+is_valid_map_src(#k_var{}) -> true;
+is_valid_map_src(_) -> false.
+
map_split_pairs(A, Var, Ces, Sub, St0) ->
%% two steps
%% 1. force variables
@@ -1986,7 +2010,9 @@ format_error(nomatch_shadow) ->
format_error(bad_call) ->
"invalid module and/or function name; this call will always fail";
format_error(bad_segment_size) ->
- "binary construction will fail because of a type mismatch".
+ "binary construction will fail because of a type mismatch";
+format_error(bad_map) ->
+ "map construction will fail because of a type mismatch".
add_warning(none, Term, Anno, #kern{ws=Ws}=St) ->
File = get_file(Anno),
diff --git a/lib/compiler/src/v3_kernel_pp.erl b/lib/compiler/src/v3_kernel_pp.erl
index b4e486f97c..b33eba50eb 100644
--- a/lib/compiler/src/v3_kernel_pp.erl
+++ b/lib/compiler/src/v3_kernel_pp.erl
@@ -104,20 +104,26 @@ format_1(#k_tuple{es=Es}, Ctxt) ->
format_hseq(Es, ",", ctxt_bump_indent(Ctxt, 1), fun format/2),
$}
];
-format_1(#k_map{var=#k_var{}=Var,es=Es}, Ctxt) ->
- [$~,${,
+format_1(#k_map{var=#k_literal{val=M},op=assoc,es=Es}, Ctxt) when is_map(M), map_size(M) =:= 0 ->
+ ["~{",
format_hseq(Es, ",", ctxt_bump_indent(Ctxt, 1), fun format/2),
- " | ",format_1(Var, Ctxt),
- $},$~
+ "}~"
];
-format_1(#k_map{op=assoc,es=Es}, Ctxt) ->
+format_1(#k_map{var=#k_literal{val=M},op=exact,es=Es}, Ctxt) when is_map(M), map_size(M) =:= 0 ->
+ ["::{",
+ format_hseq(Es, ",", ctxt_bump_indent(Ctxt, 1), fun format/2),
+ "}::"
+ ];
+format_1(#k_map{var=Var,op=assoc,es=Es}, Ctxt) ->
["~{",
format_hseq(Es, ",", ctxt_bump_indent(Ctxt, 1), fun format/2),
+ " | ",format_1(Var, Ctxt),
"}~"
];
-format_1(#k_map{es=Es}, Ctxt) ->
+format_1(#k_map{var=Var,op=exact,es=Es}, Ctxt) ->
["::{",
format_hseq(Es, ",", ctxt_bump_indent(Ctxt, 1), fun format/2),
+ " | ",format_1(Var, Ctxt),
"}::"
];
format_1(#k_map_pair{key=K,val=V}, Ctxt) ->
diff --git a/lib/compiler/test/andor_SUITE.erl b/lib/compiler/test/andor_SUITE.erl
index d79696df38..b5408ecd8f 100644
--- a/lib/compiler/test/andor_SUITE.erl
+++ b/lib/compiler/test/andor_SUITE.erl
@@ -171,6 +171,8 @@ t_and_or(Config) when is_list(Config) ->
false = ?GUARD(erlang:'not'(erlang:'and'(bar, True))),
false = ?GUARD(erlang:'not'(erlang:'not'(erlang:'and'(bar, True)))),
+ true = (fun (X = true) when X or true or X -> true end)(True),
+
ok.
t_andalso(Config) when is_list(Config) ->
diff --git a/lib/compiler/test/core_SUITE_data/map_core_test.core b/lib/compiler/test/core_SUITE_data/map_core_test.core
index 7ece8a8bbd..2aa853d450 100644
--- a/lib/compiler/test/core_SUITE_data/map_core_test.core
+++ b/lib/compiler/test/core_SUITE_data/map_core_test.core
@@ -67,7 +67,7 @@ module 'map_core_test' ['map_core_test'/0,
(Val, V)
in let <_cor5> =
%% Line 21
- M~{~<1337,_cor4>,~<'val',_cor2>}~
+ ~{~<1337,_cor4>,~<'val',_cor2>|M}~
in %% Line 21
apply 'call'/2
(_cor5, Vs)
@@ -92,4 +92,4 @@ module 'map_core_test' ['map_core_test'/0,
fun (_cor0) ->
call 'erlang':'get_module_info'
('map_core_test', _cor0)
-end \ No newline at end of file
+end
diff --git a/lib/compiler/test/core_fold_SUITE.erl b/lib/compiler/test/core_fold_SUITE.erl
index 8151dc1b16..9c986576d5 100644
--- a/lib/compiler/test/core_fold_SUITE.erl
+++ b/lib/compiler/test/core_fold_SUITE.erl
@@ -23,7 +23,7 @@
t_element/1,setelement/1,t_length/1,append/1,t_apply/1,bifs/1,
eq/1,nested_call_in_case/1,guard_try_catch/1,coverage/1,
unused_multiple_values_error/1,unused_multiple_values/1,
- multiple_aliases/1]).
+ multiple_aliases/1,redundant_boolean_clauses/1]).
-export([foo/0,foo/1,foo/2,foo/3]).
@@ -40,7 +40,7 @@ groups() ->
[t_element,setelement,t_length,append,t_apply,bifs,
eq,nested_call_in_case,guard_try_catch,coverage,
unused_multiple_values_error,unused_multiple_values,
- multiple_aliases]}].
+ multiple_aliases,redundant_boolean_clauses]}].
init_per_suite(Config) ->
@@ -365,4 +365,13 @@ run_once() ->
ok.
+redundant_boolean_clauses(Config) when is_list(Config) ->
+ X = id(0),
+ yes = case X == 0 of
+ false -> no;
+ false -> no;
+ true -> yes
+ end.
+
+
id(I) -> I.
diff --git a/lib/compiler/test/error_SUITE.erl b/lib/compiler/test/error_SUITE.erl
index 5cdf429a5f..bd877bb528 100644
--- a/lib/compiler/test/error_SUITE.erl
+++ b/lib/compiler/test/error_SUITE.erl
@@ -23,7 +23,7 @@
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
init_per_group/2,end_per_group/2,
head_mismatch_line/1,warnings_as_errors/1, bif_clashes/1,
- transforms/1,forbidden_maps/1]).
+ transforms/1,forbidden_maps/1,bad_utf8/1]).
%% Used by transforms/1 test case.
-export([parse_transform/2]).
@@ -36,7 +36,8 @@ all() ->
groups() ->
[{p,test_lib:parallel(),
- [head_mismatch_line,warnings_as_errors,bif_clashes,transforms,forbidden_maps]}].
+ [head_mismatch_line,warnings_as_errors,bif_clashes,
+ transforms,forbidden_maps,bad_utf8]}].
init_per_suite(Config) ->
Config.
@@ -254,6 +255,23 @@ forbidden_maps(Config) when is_list(Config) ->
[] = run2(Config, Ts1),
ok.
+bad_utf8(Config) ->
+ Ts = [{bad_utf8,
+ %% If coding is specified explicitly as utf-8, there should be
+ %% a compilation error; we must not fallback to parsing the
+ %% file in latin-1 mode.
+ <<"%% coding: utf-8
+ %% Bj",246,"rn
+ t() -> \"",246,"\".
+ ">>,
+ [],
+ {error,[{2,epp,cannot_parse},
+ {2,file_io_server,invalid_unicode}],
+ []}
+ }],
+ [] = run2(Config, Ts),
+ ok.
+
run(Config, Tests) ->
?line File = test_filename(Config),
@@ -318,6 +336,7 @@ run_test(Test0, File, Warnings, WriteBeam) ->
?line compile:file(File, [binary,report|Warnings]),
%% Test result of compilation.
+ io:format("~p\n", [Opts]),
?line Res = case compile:file(File, Opts) of
{ok,Mod,_,[{_File,Ws}]} ->
%io:format("compile:file(~s,~p) ->~n~p~n",
@@ -335,6 +354,11 @@ run_test(Test0, File, Warnings, WriteBeam) ->
%io:format("compile:file(~s,~p) ->~n~p~n",
% [File,Opts,_ZZ]),
{error,Es,Ws};
+ {error,[{XFile,Es1},{XFile,Es2}],Ws} = _ZZ
+ when is_list(XFile) ->
+ %io:format("compile:file(~s,~p) ->~n~p~n",
+ % [File,Opts,_ZZ]),
+ {error,Es1++Es2,Ws};
{error,Es,[{_File,Ws}]} = _ZZ->
%io:format("compile:file(~s,~p) ->~n~p~n",
% [File,Opts,_ZZ]),
diff --git a/lib/compiler/test/map_SUITE.erl b/lib/compiler/test/map_SUITE.erl
index 4fc4768802..90eae6fb4f 100644
--- a/lib/compiler/test/map_SUITE.erl
+++ b/lib/compiler/test/map_SUITE.erl
@@ -43,7 +43,8 @@
%% errors in 17.0-rc1
t_update_values/1,
- t_expand_map_update/1
+ t_expand_map_update/1,
+ t_export/1
]).
suite() -> [].
@@ -70,7 +71,8 @@ all() -> [
%% errors in 17.0-rc1
t_update_values,
- t_expand_map_update
+ t_expand_map_update,
+ t_export
].
groups() -> [].
@@ -285,6 +287,12 @@ t_expand_map_update(Config) when is_list(Config) ->
#{<<"hello">> := <<"les gens">>} = M,
ok.
+t_export(Config) when is_list(Config) ->
+ Raclette = id(#{}),
+ case brie of brie -> Fromage = Raclette end,
+ Raclette = Fromage#{},
+ ok.
+
check_val(#{val1:=V1, val2:=V2},V1,V2) -> ok.
get_val(#{ "wazzup" := _, val := V}) -> V;
@@ -292,6 +300,7 @@ get_val(#{ val := V }) -> {some_val, V}.
t_guard_bifs(Config) when is_list(Config) ->
true = map_guard_empty(),
+ true = map_guard_empty_2(),
true = map_guard_head(#{a=>1}),
false = map_guard_head([]),
true = map_guard_body(#{a=>1}),
@@ -304,6 +313,8 @@ t_guard_bifs(Config) when is_list(Config) ->
map_guard_empty() when is_map(#{}); false -> true.
+map_guard_empty_2() when true; #{} andalso false -> true.
+
map_guard_head(M) when is_map(M) -> true;
map_guard_head(_) -> false.
diff --git a/lib/compiler/test/warnings_SUITE.erl b/lib/compiler/test/warnings_SUITE.erl
index f63299ea35..c3b02819f9 100644
--- a/lib/compiler/test/warnings_SUITE.erl
+++ b/lib/compiler/test/warnings_SUITE.erl
@@ -37,8 +37,9 @@
-export([pattern/1,pattern2/1,pattern3/1,pattern4/1,
guard/1,bad_arith/1,bool_cases/1,bad_apply/1,
- files/1,effect/1,bin_opt_info/1,bin_construction/1, comprehensions/1,
- maps/1]).
+ files/1,effect/1,bin_opt_info/1,bin_construction/1,
+ comprehensions/1,maps/1,redundant_boolean_clauses/1,
+ latin1_fallback/1]).
% Default timetrap timeout (set in init_per_testcase).
-define(default_timeout, ?t:minutes(2)).
@@ -62,7 +63,8 @@ groups() ->
[{p,test_lib:parallel(),
[pattern,pattern2,pattern3,pattern4,guard,
bad_arith,bool_cases,bad_apply,files,effect,
- bin_opt_info,bin_construction,comprehensions,maps]}].
+ bin_opt_info,bin_construction,comprehensions,maps,
+ redundant_boolean_clauses,latin1_fallback]}].
init_per_suite(Config) ->
Config.
@@ -201,6 +203,8 @@ pattern4(Config) when is_list(Config) ->
[nowarn_unused_vars],
{warnings,
[{9,sys_core_fold,no_clause_match},
+ {11,sys_core_fold,nomatch_shadow},
+ {15,sys_core_fold,nomatch_shadow},
{18,sys_core_fold,no_clause_match},
{23,sys_core_fold,no_clause_match},
{33,sys_core_fold,no_clause_match}
@@ -573,6 +577,52 @@ maps(Config) when is_list(Config) ->
run(Config, Ts),
ok.
+redundant_boolean_clauses(Config) when is_list(Config) ->
+ Ts = [{redundant_boolean_clauses,
+ <<"
+ t(X) ->
+ case X == 0 of
+ false -> no;
+ false -> no;
+ true -> yes
+ end.
+ ">>,
+ [],
+ {warnings,[{5,sys_core_fold,nomatch_shadow}]}}],
+ run(Config, Ts),
+ ok.
+
+latin1_fallback(Conf) when is_list(Conf) ->
+ DataDir = ?privdir,
+ IncFile = filename:join(DataDir, "include_me.hrl"),
+ file:write_file(IncFile, <<"%% ",246," in include file\n">>),
+ Ts1 = [{latin1_fallback1,
+ %% Test that the compiler fall backs to latin-1 with
+ %% a warning if a file has no encoding and does not
+ %% contain correct UTF-8 sequences.
+ <<"%% Bj",246,"rn
+ t(_) -> \"",246,"\";
+ t(x) -> ok.
+ ">>,
+ [],
+ {warnings,[{1,compile,reparsing_invalid_unicode},
+ {3,sys_core_fold,{nomatch_shadow,2}}]}}],
+ [] = run(Conf, Ts1),
+
+ Ts2 = [{latin1_fallback2,
+ %% Test that the compiler fall backs to latin-1 with
+ %% a warning if a file has no encoding and does not
+ %% contain correct UTF-8 sequences.
+ <<"
+
+ -include(\"include_me.hrl\").
+ ">>,
+ [],
+ {warnings,[{1,compile,reparsing_invalid_unicode}]}
+ }],
+ [] = run(Conf, Ts2),
+ ok.
+
%%%
%%% End of test cases.
%%%
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-04 01:51:28 +0000