From e4b004fb9f76420a472139af1e5d7021195850cf Mon Sep 17 00:00:00 2001 From: Fredrik Frantzen Date: Thu, 30 Jan 2025 16:07:43 +0100 Subject: [PATCH] stdlib: create an init function for records with complex default values records that have field default values containing variables that are "free" was unsafe in functions that have variables with the same name. This commit creates init function for records to protect the variables in the default value. e.g. -record(r, {f = fun(X)->case X of {y, Y} -> Y; _ -> X end, g=..., h=abc}). foo(X)->\#r{}. --> foo(X)->(r_init()){}. r_init() will only initialize fields that will not be updated e.g. foo(X)->\#r{f=X} --> foo(X)->(r_init_f()){f=X}. r_init_f will only initialize g and h with its default value, f will be initialized to undefined. r_init() functions will not be generated if all fields of the record that contains "free variables" are initialized by the user. e.g. foo(X)->\#r{f=X,g=X}. --> foo(X)->{r,X,X,abc}. --- lib/stdlib/src/erl_expand_records.erl | 68 ++++++++++++++++++- lib/stdlib/src/erl_lint.erl | 25 ++----- lib/stdlib/test/erl_expand_records_SUITE.erl | 29 +++++++- .../doc/reference_manual/ref_man_records.md | 3 +- 4 files changed, 101 insertions(+), 24 deletions(-) diff --git a/lib/stdlib/src/erl_expand_records.erl b/lib/stdlib/src/erl_expand_records.erl index f5e79370ccb8..6629ae355c78 100644 --- a/lib/stdlib/src/erl_expand_records.erl +++ b/lib/stdlib/src/erl_expand_records.erl @@ -40,6 +40,7 @@ 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' + new_forms=#{}, % New forms strict_rec_tests=true :: boolean() }). @@ -95,6 +96,7 @@ 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) -> {maps:values(FsN),St}; forms([], St) -> {[],St}. clauses([{clause,Anno,H0,G0,B0} | Cs0], St0) -> @@ -262,6 +264,42 @@ not_a_tuple({op,_,_,_}) -> true; not_a_tuple({op,_,_,_,_}) -> true; not_a_tuple(_) -> false. +traverse_af(AF, Fun) -> + traverse_af(AF, Fun, []). +traverse_af(AF, Fun, Acc) when is_list(AF) -> + [ traverse_af(Ast, Fun, Fun(Ast,Acc)) || Ast <- AF]; +traverse_af(AF, Fun, Acc) when is_tuple(AF) -> + %% Iterate each tuple element, if the element is an AF, traverse it + [[(fun (List) when is_list(List) -> + traverse_af(List, Fun, Acc); + (Tuple) when is_tuple(Tuple)-> + case erl_anno:is_anno(Tuple) of + true -> []; + false -> traverse_af(Tuple, Fun, Fun(Tuple,Acc)) + end; + (_) -> [] + end)(Term) || Term <- tuple_to_list(AF)],Acc]; +traverse_af(_, _, Acc) -> Acc. +save_vars({var, _, Var}, _) -> Var; +save_vars(_, Acc) -> Acc. +free_variables(AF, Acc) -> + try + _=traverse_af(AF, fun free_variables1/2, Acc), + false + catch + throw:{error,unsafe_variable} -> true + end. +free_variables1({'fun',_anno,_}, Acc) -> + {function,Acc}; %% tag that we are in a 'fun' now that can define new variables +free_variables1({clause,_anno,Pattern,_guards,_body}, {function,Acc}) -> + lists:flatten(traverse_af(Pattern, fun save_vars/2, [])++Acc); +free_variables1({var, _, Var}, Acc) -> + case lists:member(Var, Acc) of + true -> Acc; + false -> throw({error, unsafe_variable}) + end; +free_variables1(_, Acc) -> Acc. + 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. @@ -335,9 +373,33 @@ expr({record_index,Anno,Name,F}, 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); + + IsUndefined = [{RF, AnnoRF, Field, {atom, AnnoRF, 'undefined'}} || {record_field=RF, AnnoRF, Field, _} <- Is], + Fields = lists:flatten(lists:sort([atom_to_list(FieldAtom) || {record_field, _, {atom, _, FieldAtom}, _} <- Is])), + R_default_init = [{atom,Anno,Name} | + record_inits(record_fields(Name, Anno0, St),IsUndefined)], + R_init = [{atom,Anno,Name} | + record_inits(record_fields(Name, Anno0, St), Is)], + Vars = lists:flatten(traverse_af(Is, fun save_vars/2)), + %% If R_init contains free variables that was not bound via Is + case free_variables(R_init, Vars) of + true -> + FName = list_to_atom("erl_expand_records_init_"++atom_to_list(Name)++"_"++Fields), + %% add a function to the module that returns the + %% initialized record, we generate different init functions + %% depending on which fields that will override the default value + {Tup, St1} = expr({tuple,Anno,R_default_init},St), + F = {'function', Anno, FName, 0, + [{'clause', Anno, [], [], [Tup]}]}, + %% replace the record expression with a call expression + %% to the newly added function and a record update + C = {call,Anno,{atom,Anno,FName},[]}, + expr({record, Anno0, C, Name, Is},St1#exprec{new_forms=(St#exprec.new_forms)#{FName=>F}}); + false -> + %% No free variables means that we can just + %% output the record as a tuple. + expr({tuple,Anno,R_init},St) + 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 41e5a949d705..42e495522b80 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 @@ -3090,17 +3088,15 @@ 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), + {_,St2} = expr(V, [], St), %% Warnings and errors found are kept, but %% updated calls, records, etc. are discarded. - St3 = St1#lint{warnings = St2#lint.warnings, + St3 = St#lint{warnings = St2#lint.warnings, errors = St2#lint.errors, - called = St2#lint.called, - recdef_top = false}, + called = St2#lint.called}, %% This is one way of avoiding a loop for %% "recursive" definitions. - NV = case St2#lint.errors =:= St1#lint.errors of + NV = case St2#lint.errors =:= St#lint.errors of true -> V; false -> {atom,Aa,undefined} end, @@ -4067,10 +4063,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 +4198,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 +4281,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/test/erl_expand_records_SUITE.erl b/lib/stdlib/test/erl_expand_records_SUITE.erl index e51044febf2d..2e4a0b4f98e7 100644 --- a/lib/stdlib/test/erl_expand_records_SUITE.erl +++ b/lib/stdlib/test/erl_expand_records_SUITE.erl @@ -272,7 +272,34 @@ 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 initialization is not done on fields to be initialized + %% with other than the default. + #r1{a=hello,b=[ok]}=#r1{a=hello}, + Ok1 = receive + {side_effect, b} -> ok; + {side_effect, a} -> nok + end, + Ok2 = receive + {side_effect, b} -> ok; + {side_effect, a} -> nok + after 100 -> ok + end, + Ok1 = Ok2 = ok. + """ ], run(Config, Ts), ok. diff --git a/system/doc/reference_manual/ref_man_records.md b/system/doc/reference_manual/ref_man_records.md index 3e6536749a8c..836f00fba661 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