From 952de988b0c3a1d31e9422e778a521ca66f571c9 Mon Sep 17 00:00:00 2001 From: Fredrik Frantzen Date: Wed, 26 Feb 2025 13:06:58 +0100 Subject: [PATCH] stdlib: allow variables in record definitions Create an init function e.g. rec_init$^0, for each record with definitions containing variables. This function is created for each module using the record. In the shell they will belong to the shell_default module. e.g. -record(r, {f = fun(X)->case X of {y, Y} -> Y; _ -> X end, g=..., h=abc}). foo(X)->\#r{}. --> foo(X)->('rec_init$^0'()){}. rec_init$^0() will initialize all fields with the default values. If fields are set and the omitted field default value has variables, then a new init function is created that only initializes the omitted fields. e.g. foo(X)->\#r{g=X}. --> foo(X)->('rec_init$^1()){g=X}. - Removes lint error for variables in definitions. - Updates erl_lint_SUITE and erl_expand_records_SUITE to work with this new behavior. - Adds handling of records that are calling functions to the shell. - Records with default values calling local non exported functions will not compile when the function is not available, the shell will be able to import it, but the local functions will have to be defined manually. --- lib/stdlib/src/erl_error.erl | 20 ++- lib/stdlib/src/erl_expand_records.erl | 76 +++++++++++- lib/stdlib/src/erl_lint.erl | 30 +---- lib/stdlib/src/shell.erl | 117 +++++++++++------- lib/stdlib/test/erl_expand_records_SUITE.erl | 34 ++++- lib/stdlib/test/erl_lint_SUITE.erl | 20 +-- lib/stdlib/test/shell_SUITE.erl | 13 ++ .../doc/reference_manual/ref_man_records.md | 9 +- 8 files changed, 227 insertions(+), 92 deletions(-) diff --git a/lib/stdlib/src/erl_error.erl b/lib/stdlib/src/erl_error.erl index c5ae309ce12d..297caf8de491 100644 --- a/lib/stdlib/src/erl_error.erl +++ b/lib/stdlib/src/erl_error.erl @@ -536,10 +536,20 @@ location(L) -> sep(1, S) -> S; sep(_, S) -> [$\n | S]. +is_rec_init(F) when is_atom(F) -> + case atom_to_binary(F) of + <<"rec_init$^", _/binary>> -> true; + _ -> false + end; +is_rec_init(_) -> false. + origin(1, M, F, A) -> case is_op({M, F}, n_args(A)) of {yes, F} -> <<"in operator ">>; - no -> <<"in function ">> + no -> case is_rec_init(F) of + true -> <<"in record">>; + false -> <<"in function ">> + end end; origin(_N, _M, _F, _A) -> <<"in call from">>. @@ -625,7 +635,13 @@ printable_list(_, As) -> io_lib:printable_list(As). mfa_to_string(M, F, A, Enc) -> - io_lib:fwrite(<<"~ts/~w">>, [mf_to_string({M, F}, A, Enc), A]). + case is_rec_init(F) of + true -> + <<"default value">>; + false -> + io_lib:fwrite(<<"~ts/~w">>, + [mf_to_string({M, F}, A, Enc), A]) + end. mf_to_string({M, F}, A, Enc) -> case erl_internal:bif(M, F, A) of diff --git a/lib/stdlib/src/erl_expand_records.erl b/lib/stdlib/src/erl_expand_records.erl index d8ff6c934ed2..8ad50098e12c 100644 --- a/lib/stdlib/src/erl_expand_records.erl +++ b/lib/stdlib/src/erl_expand_records.erl @@ -40,6 +40,8 @@ Section [The Abstract Format](`e:erts:absform.md`) in ERTS User's Guide. strict_ra=[], % Strict record accesses checked_ra=[], % Successfully accessed records dialyzer=false, % Compiler option 'dialyzer' + rec_init_count=0, % Number of generated record init functions + new_forms=#{}, % New forms strict_rec_tests=true :: boolean() }). @@ -95,6 +97,12 @@ forms([{function,Anno,N,A,Cs0} | Fs0], St0) -> forms([F | Fs0], St0) -> {Fs,St} = forms(Fs0, St0), {[F | Fs], St}; +forms([], #exprec{new_forms=FsN}=St) -> + {[{'function', Anno, + maps:get(Def, FsN), + 0, + [{'clause', Anno, [], [], [Def]}]} + || {_,Anno,_}=Def <- maps:keys(FsN)], St}; forms([], St) -> {[],St}. clauses([{clause,Anno,H0,G0,B0} | Cs0], St0) -> @@ -262,6 +270,30 @@ not_a_tuple({op,_,_,_}) -> true; not_a_tuple({op,_,_,_,_}) -> true; not_a_tuple(_) -> false. +variables({var,_,'_'}) -> + []; +variables({var,_,V}) -> + [V]; +variables({'fun',_,Def}) -> + %% The Def tuple has no annotation. Must handle it specially. + case Def of + {clauses,Cs} -> variables(Cs); + {function,F,A} -> variables([F,A]); + {function,M,F,A} -> variables([M,F,A]) + end; +variables(Tuple) when is_tuple(Tuple) -> + [Tag,Anno|T] = tuple_to_list(Tuple), + true = is_atom(Tag), + true = erl_anno:is_anno(Anno), + variables(T); +variables(List) when is_list(List) -> + foldl(fun(E, Vs0) -> + Vs1 = variables(E), + ordsets:union(Vs0, Vs1) + end, [], List); +variables(_) -> + []. + record_test_in_body(Anno, Expr, Name, St0) -> %% As Expr may have side effects, we must evaluate it %% first and bind the value to a new variable. @@ -333,11 +365,45 @@ expr({map_field_exact,Anno,K0,V0}, St0) -> expr({record_index,Anno,Name,F}, St) -> I = index_expr(Anno, F, Name, record_fields(Name, Anno, St)), expr(I, St); -expr({record,Anno0,Name,Is}, St) -> - Anno = mark_record(Anno0, St), - expr({tuple,Anno,[{atom,Anno0,Name} | - record_inits(record_fields(Name, Anno0, St), Is)]}, - St); +expr({record,Anno0,Name,Is}, St0) -> + Anno = mark_record(Anno0, St0), + + RInit = [{atom,Anno,Name} | + record_inits(record_fields(Name, Anno0, St0), Is)], + Vars = variables(Is), + %% Check if there are variables in the initialized record. If + %% there are, we need to initialize the record using a generated + %% function + AnyVariables = not ordsets:is_subset(variables(RInit), Vars), + case AnyVariables of + true -> + %% Initialize the record with only the default values. + %% Setting fields that has been overridden to undefined. + UndefIs = [setelement(4,R,{atom,Anno,undefined}) || {record_field,_,_,_}=R<-Is], + RDefInit = [{atom,Anno,Name} | + record_inits(record_fields(Name, Anno, St0), UndefIs)], + {Def,St1} = expr({tuple,Anno,RDefInit}, St0), + Map0 = St1#exprec.new_forms, + {FName,St2} = + case Map0 of + #{Def := OldName} -> + {OldName,St1}; + #{} -> + C = St1#exprec.rec_init_count, + NewName = list_to_atom("rec_init$^" ++ + integer_to_list(C)), + Map = Map0#{Def => NewName}, + {NewName,St1#exprec{rec_init_count=C+1, + new_forms=Map}} + end, + %% Replace the init record expression with a call expression + %% to the newly added function followed by a record update. + expr({record, Anno0, {call,Anno,{atom,Anno,FName},[]}, Name, Is},St2); + false -> + %% No free variables means that we can just output the + %% record as a tuple. + expr({tuple,Anno,RInit}, St0) + end; expr({record_field,_A,R,Name,F}, St) -> Anno = erl_parse:first_anno(R), get_record_field(Anno, R, F, Name, St); diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index a4bbbf5b5353..8c686b7ae7f2 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -200,8 +200,6 @@ value_option(Flag, Default, On, OnVal, Off, OffVal, Opts) -> errors=[] :: [{file:filename(),error_info()}], %Current errors warnings=[] :: [{file:filename(),error_info()}], %Current warnings file = "" :: string(), %From last file attribute - recdef_top=false :: boolean(), %true in record initialisation - %outside any fun or lc xqlc= false :: boolean(), %true if qlc.hrl included called= [] :: [{fa(),anno()}], %Called functions fun_used_vars = undefined %Funs used vars @@ -469,8 +467,6 @@ format_error_1({shadowed_var,V,In}) -> {~"variable ~w shadowed in ~w", [V,In]}; format_error_1({unused_var, V}) -> {~"variable ~w is unused", [V]}; -format_error_1({variable_in_record_def,V}) -> - {~"variable ~w in record definition", [V]}; format_error_1({stacktrace_guard,V}) -> {~"stacktrace variable ~w must not be used in a guard", [V]}; format_error_1({stacktrace_bound,V}) -> @@ -3090,21 +3086,14 @@ def_fields(Fs0, Name, St0) -> case exist_field(F, Fs) of true -> {Fs,add_error(Af, {redefine_field,Name,F}, St)}; false -> - St1 = St#lint{recdef_top = true}, - {_,St2} = expr(V, [], St1), - %% Warnings and errors found are kept, but - %% updated calls, records, etc. are discarded. - St3 = St1#lint{warnings = St2#lint.warnings, - errors = St2#lint.errors, - called = St2#lint.called, - recdef_top = false}, + {_,St1} = expr(V, [], St), %% This is one way of avoiding a loop for %% "recursive" definitions. - NV = case St2#lint.errors =:= St1#lint.errors of + NV = case St1#lint.errors =:= St#lint.errors of true -> V; false -> {atom,Aa,undefined} end, - {[{record_field,Af,{atom,Aa,F},NV}|Fs],St3} + {[{record_field,Af,{atom,Aa,F},NV}|Fs],St1} end end, {[],St0}, Fs0). @@ -4067,10 +4056,7 @@ comprehension_expr(E, Vt, St) -> %% in ShadowVarTable (these are local variables that are not global variables). lc_quals(Qs, Vt0, St0) -> - OldRecDef = St0#lint.recdef_top, - {Vt,Uvt,St} = lc_quals(Qs, Vt0, [], St0#lint{recdef_top = false}), - {Vt,Uvt,St#lint{recdef_top = OldRecDef}}. - + lc_quals(Qs, Vt0, [], St0). lc_quals([{zip,_Anno,Gens} | Qs], Vt0, Uvt0, St0) -> St1 = are_all_generators(Gens,St0), {Vt,Uvt,St} = handle_generators(Gens,Vt0,Uvt0,St1), @@ -4205,13 +4191,12 @@ fun_clauses(Cs, Vt, St) -> fun_clauses1(Cs, Vt, St). fun_clauses1(Cs, Vt, St) -> - OldRecDef = St#lint.recdef_top, {Bvt,St2} = foldl(fun (C, {Bvt0, St0}) -> {Cvt,St1} = fun_clause(C, Vt, St0), {vtmerge(Cvt, Bvt0),St1} - end, {[],St#lint{recdef_top = false}}, Cs), + end, {[],St}, Cs), Uvt = vt_no_unsafe(vt_no_unused(vtold(Bvt, Vt))), - {Uvt,St2#lint{recdef_top = OldRecDef}}. + {Uvt,St2}. fun_clause({clause,_Anno,H,G,B}, Vt0, St0) -> {Hvt,Hnew,St1} = head(H, Vt0, [], St0), % No imported pattern variables @@ -4289,9 +4274,6 @@ pat_var(V, Anno, Vt, New, St0) -> {[{V,{bound,used,Ls}}],[], %% As this is matching, exported vars are risky. add_warning(Anno, {exported_var,V,From}, St)}; - error when St0#lint.recdef_top -> - {[],[{V,{bound,unused,[Anno]}}], - add_error(Anno, {variable_in_record_def,V}, St0)}; error -> %% add variable to NewVars, not yet used {[],[{V,{bound,unused,[Anno]}}],St0} diff --git a/lib/stdlib/src/shell.erl b/lib/stdlib/src/shell.erl index 098616c8a179..1ca1fb36719b 100644 --- a/lib/stdlib/src/shell.erl +++ b/lib/stdlib/src/shell.erl @@ -476,34 +476,52 @@ escape_quotes([$\" | Rest], Acc) -> escape_quotes([Char | Rest], Acc) -> % In case of any other character, we keep it as is. escape_quotes(Rest, [Char | Acc]). + reconstruct(Fun, Name) -> - lists:flatten(erl_pp:expr(reconstruct1(Fun, Name))). -reconstruct1({function, Anno, Name, Arity, Clauses}, Name) -> - {named_fun, Anno, 'RecursiveFuncVar', reconstruct1(Clauses, Name, Arity)}. -reconstruct1([{call, Anno, {atom, Anno1, Name}, Args}|Body], Name, Arity) when length(Args) =:= Arity -> - [{call, Anno, {var, Anno1, 'RecursiveFuncVar'}, reconstruct1(Args, Name, Arity)}| reconstruct1(Body, Name, Arity)]; -reconstruct1([{call, Anno, {atom, Anno1, Name}, Args}|Body], Name, Arity) -> % arity not the same - [{call, Anno, {remote, Anno1, {atom, Anno1, shell_default}, {atom, Anno1, Name}}, reconstruct1(Args, Name, Arity)}| - reconstruct1(Body, Name, Arity)]; -reconstruct1([{call, Anno, {atom, Anno1, Fun}, Args}|Body], Name, Arity) -> % Name not the same - case {edlin_expand:shell_default_or_bif(atom_to_list(Fun)), shell:local_func(Fun)} of + lists:flatten(erl_pp:expr(reconstruct1(Fun, Name, []))). +reconstruct1({function, Anno, Name, Arity, Clauses}, Name, Extra) -> + Clauses1 = reconstruct1(Clauses, Name, Arity, Extra), + {named_fun, Anno, 'RecursiveFuncVar',Clauses1}. +reconstruct1([{call, Anno, {atom, Anno1, Name}, Args}|Body], Name, Arity, Extra) + when length(Args) =:= Arity -> + Args1 = reconstruct1(Args, Name, Arity, Extra), + Body1 = reconstruct1(Body, Name, Arity, Extra), + [{call, Anno, {var, Anno1, 'RecursiveFuncVar'}, Args1}|Body1]; +reconstruct1([{call, Anno, {atom, Anno1, Name}=F, Args}|Body], Name, Arity, Extra) -> % arity not the same + Args1 = reconstruct1(Args, Name, Arity, Extra), + Body1 = reconstruct1(Body, Name, Arity, Extra), + RC = {remote, Anno1, {atom, Anno1, shell_default}, F}, + [{call, Anno, RC, Args1}|Body1]; +reconstruct1([{call, Anno, {atom, Anno1, Fun}=F, Args}|Body], Name, Arity, Extra) -> % Name not the same + Args1 = reconstruct1(Args, Name, Arity, Extra), + Body1 = reconstruct1(Body, Name, Arity, Extra), + case {edlin_expand:shell_default_or_bif(Fun), shell:local_func(Fun)} of {"user_defined", false} -> - [{call, Anno, {remote, Anno1, {atom, Anno1, shell_default}, {atom, Anno1, Fun}}, reconstruct1(Args, Name, Arity)}| - reconstruct1(Body, Name, Arity)]; + Module = proplists:get_value(module, Extra, shell_default), + Exports = proplists:get_value(exports, Extra, []), + case lists:member({Fun, length(Args)}, Exports) of + true -> [{call, Anno, {remote, Anno1, {atom, Anno1, Module}, F}, Args1}| + Body1]; + false -> [{call, Anno, {remote, Anno1, {atom, Anno1, shell_default}, F}, Args1}| + Body1] + end; {"shell_default", false} -> - [{call, Anno, {remote, Anno1, {atom, Anno1, shell_default}, {atom, Anno1, Fun}}, reconstruct1(Args, Name, Arity)}| reconstruct1(Body, Name, Arity)]; + [{call, Anno, {remote, Anno1, {atom, Anno1, shell_default}, F}, Args1}| Body1]; {"erlang", false} -> - [{call, Anno, {remote, Anno1, {atom, Anno1, erlang}, {atom, Anno1, Fun}}, reconstruct1(Args, Name, Arity)}| reconstruct1(Body, Name, Arity)]; + [{call, Anno, {remote, Anno1, {atom, Anno1, erlang}, F}, Args1}| Body1]; {_, true} -> - [{call, Anno, {atom, Anno1, Fun}, reconstruct1(Args, Name, Arity)}| reconstruct1(Body, Name, Arity)] + [{call, Anno, F, Args1}| Body1] end; -reconstruct1([E|Body], Name, Arity) when is_tuple(E) -> - [list_to_tuple(reconstruct1(tuple_to_list(E), Name, Arity))|reconstruct1(Body, Name, Arity)]; -reconstruct1([E|Body], Name, Arity) when is_list(E) -> - [reconstruct1(E, Name, Arity)|reconstruct1(Body, Name, Arity)]; -reconstruct1([E|Body], Name, Arity) -> - [E|reconstruct1(Body, Name, Arity)]; -reconstruct1([], _, _) -> []. +reconstruct1([E|Body], Name, Arity, Extra) when is_tuple(E) -> + Body1 = reconstruct1(Body, Name, Arity, Extra), + [list_to_tuple(reconstruct1(tuple_to_list(E), Name, Arity, Extra))|Body1]; +reconstruct1([E|Body], Name, Arity, Extra) when is_list(E) -> + Body1 = reconstruct1(Body, Name, Arity, Extra), + [reconstruct1(E, Name, Arity, Extra)|Body1]; +reconstruct1([E|Body], Name, Arity, Extra) -> + Body1 = reconstruct1(Body, Name, Arity, Extra), + [E|Body1]; +reconstruct1([], _, _, _) -> []. get_command1(Pid, Eval, Bs, RT, FT, Ds) -> receive @@ -873,7 +891,7 @@ eval_loop(Shell, Bs0, RT, FT) -> Ef = {value, fun(MForFun, As) -> apply_fun(MForFun, As, Shell) end}, Lf = local_func_handler(Shell, RT, FT, Ef), - Bs = eval_exprs(Es, Shell, Bs0, RT, Lf, Ef, W), + Bs = eval_exprs(Es, Shell, Bs0, RT, Lf, Ef, W, FT), eval_loop(Shell, Bs, RT, FT) end. @@ -882,13 +900,13 @@ restricted_eval_loop(Shell, Bs0, RT, FT, RShMod) -> {shell_cmd,Shell,{eval,Es}, W} -> {LFH,NLFH} = restrict_handlers(RShMod, Shell, RT, FT), put(restricted_expr_state, []), - Bs = eval_exprs(Es, Shell, Bs0, RT, {eval,LFH}, {value,NLFH}, W), + Bs = eval_exprs(Es, Shell, Bs0, RT, {eval,LFH}, {value,NLFH}, W, FT), restricted_eval_loop(Shell, Bs, RT, FT, RShMod) end. -eval_exprs(Es, Shell, Bs0, RT, Lf, Ef, W) -> +eval_exprs(Es, Shell, Bs0, RT, Lf, Ef, W, FT) -> try - {R,Bs2} = exprs(Es, Bs0, RT, Lf, Ef, W), + {R,Bs2} = exprs(Es, Bs0, RT, Lf, Ef, W, FT), Shell ! {shell_rep,self(),R}, Bs2 catch @@ -923,15 +941,15 @@ do_catch(_Class, _Reason) -> false end. -exprs(Es, Bs0, RT, Lf, Ef, W) -> - exprs(Es, Bs0, RT, Lf, Ef, Bs0, W). +exprs(Es, Bs0, RT, Lf, Ef, W, FT) -> + exprs(Es, Bs0, RT, Lf, Ef, Bs0, W, FT). -exprs([E0|Es], Bs1, RT, Lf, Ef, Bs0, W) -> +exprs([E0|Es], Bs1, RT, Lf, Ef, Bs0, W, FT) -> UsedRecords = used_record_defs(E0, RT), RBs = record_bindings(UsedRecords, Bs1), case check_command(prep_check([E0]), RBs) of ok -> - E1 = expand_records(UsedRecords, E0), + E1 = expand_records(UsedRecords, E0, FT), {value,V0,Bs2} = expr(E1, Bs1, Lf, Ef), Bs = orddict:from_list([VV || {X,_}=VV <- erl_eval:bindings(Bs2), not is_expand_variable(X)]), @@ -956,7 +974,7 @@ exprs([E0|Es], Bs1, RT, Lf, Ef, Bs0, W) -> end, {{value,V,Bs,get()},Bs}; true -> - exprs(Es, Bs, RT, Lf, Ef, Bs0, W) + exprs(Es, Bs, RT, Lf, Ef, Bs0, W, FT) end; {error,Error} -> {{command_error,Error},Bs0} @@ -1182,16 +1200,21 @@ prep_check([E | Es]) -> prep_check(E) -> E. -expand_records([], E0) -> +expand_records([], E0, _) -> E0; -expand_records(UsedRecords, E0) -> +expand_records(UsedRecords, E0, FT) -> RecordDefs = [Def || {_Name,Def} <- UsedRecords], A = erl_anno:new(1), E = prep_rec(E0), Forms0 = RecordDefs ++ [{function,A,foo,0,[{clause,A,[],[],[E]}]}], Forms = erl_expand_records:module(Forms0, [strict_record_tests]), - {function,A,foo,0,[{clause,A,[],[],[NE]}]} = lists:last(Forms), - prep_rec(NE). + [{function,A,foo,0,[{clause,A,[],[],NE}]}]=[F||{function,A1,foo,0,_}=F<-Forms, A1=:=A], + %% Rewrite rec_init$^N calls to shell_default:rec_init$^N calls + [NE2]=reconstruct1(NE, [],0, []), + ets:insert(FT, [begin {value, Fun, []} = erl_eval:expr({'fun', A, {clauses, F}}, []), + {{function, {shell_default, FunName, 0}}, Fun} + end || {function,_,FunName,0,F}<-Forms, FunName=/=foo]), + prep_rec(NE2). prep_rec({value,_CommandN,_V}=Value) -> %% erl_expand_records cannot handle the history expansion {value,_,_}. @@ -1736,10 +1759,12 @@ find_file(Mod) when is_atom(Mod) -> {error, nofile} end; preloaded -> - {_M, Beam, File} = code:get_object_code(Mod), - {beam, Beam, File}; + case code:get_object_code(Mod) of + {_M, Beam, File} -> {beam, Beam, File}; + error -> {error, nofile} + end; _Else -> % non_existing, interpreted, cover_compiled - {error,nofile} + {error, nofile} end; find_file(File) -> case catch filelib:wildcard(File) of @@ -1759,8 +1784,8 @@ read_file_records(File, Opts) -> read_records_from_beam(Beam, File) -> case beam_lib:chunks(Beam, [abstract_code,"CInf"]) of - {ok,{_Mod,[{abstract_code,{Version,Forms}},{"CInf",CB}]}} -> - case record_attrs(Forms) of + {ok,{Mod,[{abstract_code,{Version,Forms}},{"CInf",CB}]}} -> + case record_attrs(Forms, Mod) of [] when Version =:= raw_abstract_v1 -> []; [] -> @@ -1810,7 +1835,8 @@ parse_file(File, Opts) -> IncludePath = [Cwd,Dir|inc_paths(Opts)], case epp:parse_file(File, IncludePath, pre_defs(Opts)) of {ok,Forms} -> - record_attrs(Forms); + [Mod] = [Mod || {attribute,_,module,Mod} <- Forms], + record_attrs(Forms, Mod); Error -> Error end. @@ -1826,9 +1852,12 @@ pre_defs([]) -> []. inc_paths(Opts) -> [P || {i,P} <- Opts, is_list(P)]. -record_attrs(Forms) -> - [A || A = {attribute,_,record,_D} <- Forms]. - +record_attrs(Forms, Mod) -> + %% Add module Mod to exported local functions, add shell_default otherwise + [begin [X] = reconstruct1([A], [], 0, + [{module,Mod},{exports,edlin_expand:get_exports(Mod)}]), + X + end || A = {attribute,_,record,_D} <- Forms]. %%% End of reading record information from file(s) shell_req(Shell, Req) -> diff --git a/lib/stdlib/test/erl_expand_records_SUITE.erl b/lib/stdlib/test/erl_expand_records_SUITE.erl index e51044febf2d..cca7bd4e5ee1 100644 --- a/lib/stdlib/test/erl_expand_records_SUITE.erl +++ b/lib/stdlib/test/erl_expand_records_SUITE.erl @@ -272,7 +272,39 @@ init(Config) when is_list(Config) -> t() -> catch #{ok => ok || #r1{}}, ok. - """ + """, + ~""" + -record(r0, {a=[X||X<-[cucumber,banan]], + b=case {cucumber,banan} of X -> X; _ -> ok end, + c=fun()->{X,_} = {cucumber,banan}, X end}). + -record(r1, {a=[X||X<-[side_effect(a)]], + b=[X||X<-[side_effect(b)]]}). + side_effect(X) -> self() ! {side_effect, X}, ok. + t() -> + %% Test that X does not affect default initialization + X = {yes, no}, + {yes,no} = X, + #r0{a=[cucumber,banan], b={cucumber,banan}, c=C} = #r0{}, + cucumber = C(), + %% Test that default initialization is only done on fields not overridden + #r1{a=hello,b=[ok]}=#r1{a=hello}, + ok = receive + {side_effect, a} -> nok; + {side_effect, b} -> ok + after 100 -> nok + end, + #r1{a=[ok],b=[ok]}=#r1{}, + ok = receive + {side_effect, a} -> ok; + {side_effect, b} -> nok + end, + ok = receive + {side_effect, b} -> ok + after 100 -> nok + end, + #r1{a=0,b=0}=#r1{_=0}, + ok. + """ ], run(Config, Ts), ok. diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl index f1f789ce4f6f..7ccbfd0614de 100644 --- a/lib/stdlib/test/erl_lint_SUITE.erl +++ b/lib/stdlib/test/erl_lint_SUITE.erl @@ -2846,10 +2846,8 @@ otp_5878(Config) when is_list(Config) -> t() -> #r2{}. ">>, [warn_unused_record], - {error,[{{1,44},erl_lint,{variable_in_record_def,'A'}}, - {{1,54},erl_lint,{unbound_var,'B'}}, - {{2,38},erl_lint,{variable_in_record_def,'A'}}], - [{{1,22},erl_lint,{unused_record,r1}}]}}, + {errors,[{{1,54},erl_lint,{unbound_var,'B'}}], + []}}, {otp_5878_30, <<"-record(r1, {t = case foo of _ -> 3 end}). @@ -2859,9 +2857,7 @@ otp_5878(Config) when is_list(Config) -> t() -> {#r1{},#r2{},#r3{},#r4{}}. ">>, [warn_unused_record], - {errors,[{{2,44},erl_lint,{variable_in_record_def,'A'}}, - {{3,44},erl_lint,{variable_in_record_def,'A'}}], - []}}, + []}, {otp_5878_40, <<"-record(r1, {foo = A}). % A unbound @@ -2898,9 +2894,7 @@ otp_5878(Config) when is_list(Config) -> ">>, [warn_unused_record], {error,[{{1,39},erl_lint,{unbound_var,'A'}}, - {{2,33},erl_lint,{unbound_var,'A'}}, - {{4,42},erl_lint,{variable_in_record_def,'A'}}, - {{17,44},erl_lint,{variable_in_record_def,'A'}}], + {{2,33},erl_lint,{unbound_var,'A'}}], [{{8,36},erl_lint,{unused_var,'X'}}]}}, {otp_5878_60, @@ -2922,8 +2916,7 @@ otp_5878(Config) when is_list(Config) -> t() -> #r1{}. ">>, [warn_unused_record], - {errors,[{{3,40},erl_lint,{unbound_var,'Y'}}, - {{4,38},erl_lint,{variable_in_record_def,'Y'}}], + {errors,[{{3,40},erl_lint,{unbound_var,'Y'}}], []}}, {otp_5878_80, @@ -3042,8 +3035,7 @@ otp_5878(Config) when is_list(Config) -> t() -> {#u2{}}. ">>, - {warnings,[{{5,18},erl_lint,{unused_record,u3}}, - {{6,18},erl_lint,{unused_record,u4}}]} = + {warnings,[{{6,18},erl_lint,{unused_record,u4}}]} = run_test2(Config, Usage1, [warn_unused_record]), Usage2 = <<"-module(lint_test). diff --git a/lib/stdlib/test/shell_SUITE.erl b/lib/stdlib/test/shell_SUITE.erl index c4c329ad2b9e..65b76b364e2b 100644 --- a/lib/stdlib/test/shell_SUITE.erl +++ b/lib/stdlib/test/shell_SUITE.erl @@ -520,6 +520,19 @@ records(Config) when is_list(Config) -> ok = file:write_file(Test, Contents), {ok, test} = compile:file(Test, [{outdir, BeamDir}]), + ErrorMod = """ + -module(error_record_init). + -export([t/0]). + -record(r_error, {a=case 1 of X -> X=2 end}). + t() -> + #r_error{}. + """, + ErrorModFile = filename:join(proplists:get_value(priv_dir, Config), "error_record_init.erl"), + ok = file:write_file(ErrorModFile, ErrorMod), + {ok, error_record_init} = compile:file(ErrorModFile, [outdir, BeamDir]), + "** exception error: no match of right hand side value 2\n in record default value (" ++ Rest1 = t("error_record_init:t()."), + true = (nomatch =/= string:find(Rest1, "error_record_init.erl, line 5).\n", trailing)), + RR5 = "rr(\"" ++ Test ++ "\", '_', {d,test1}), rl([test1,test2]).", A1 = erl_anno:new(1), [{attribute,A1,record,{test1,_}},ok] = scan(RR5), diff --git a/system/doc/reference_manual/ref_man_records.md b/system/doc/reference_manual/ref_man_records.md index 3e6536749a8c..8baa220151e4 100644 --- a/system/doc/reference_manual/ref_man_records.md +++ b/system/doc/reference_manual/ref_man_records.md @@ -39,8 +39,7 @@ used. FieldN [= ExprN]}). ``` -The default value for a field is an arbitrary expression, except that it must -not use any variables. +The default value for a field is an arbitrary expression. A record definition can be placed anywhere among the attributes and function declarations of a module, but the definition must come before any usage of the @@ -68,6 +67,12 @@ The fields can be in any order, not necessarily the same order as in the record definition, and fields can be omitted. Omitted fields get their respective default value instead. +> #### Change {: .info } +> +> In Erlang/OTP OTP-19464, variables are allowed in the record definition. +> If a record definition contains a variable, a function call will be made to +> initialize the records omitted fields. + If several fields are to be assigned the same value, the following construction can be used: