diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 0988488..0f14271 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -7,14 +7,6 @@ jobs: runs-on: ubuntu-24.04 steps: - uses: actions/checkout@v4 - - name: Install OpenSSL 1.1.1 (for OTP23/24) - run: | - curl -O http://security.ubuntu.com/ubuntu/pool/main/o/openssl/libssl1.1_1.1.1f-1ubuntu2.24_amd64.deb - curl -O http://security.ubuntu.com/ubuntu/pool/main/o/openssl/libssl-dev_1.1.1f-1ubuntu2.24_amd64.deb - curl -O http://security.ubuntu.com/ubuntu/pool/main/o/openssl/openssl_1.1.1f-1ubuntu2.24_amd64.deb - sudo dpkg -i openssl_1.1.1f-1ubuntu2.24_amd64.deb \ - libssl1.1_1.1.1f-1ubuntu2.24_amd64.deb \ - libssl-dev_1.1.1f-1ubuntu2.24_amd64.deb - uses: actions/cache@v4 with: path: | diff --git a/build_utils.sh b/build_utils.sh index 64fbae0..85a10ae 100644 --- a/build_utils.sh +++ b/build_utils.sh @@ -1,6 +1,6 @@ #! /bin/bash -e -declare -A OTP_VSNS=( ["23"]="23.3.4.18" ["24"]="24.3.4.7" ["25"]="25.2" ) +declare -A OTP_VSNS=( ["25"]="25.3.2.21" ["26"]="26.2.5.12" ["27"]="27.3.3" ) build_project() { REBAR=$1 @@ -17,70 +17,7 @@ build_project() { ~/erlide_tools/${OTP_VSNS[$VSN]}/bin/escript $REBAR "$@" } -build_projects() { - build_project erlide_common 23 "$@" - build_project erlide_debugger_23 23 "$@" - build_project erlide_debugger_24 24 "$@" - build_project erlide_debugger_25 25 "$@" - build_project erlide_debugger 23 "$@" - build_project erlide_tools 23 "$@" - - build_project erlide_ide 23 "$@" -} - -assemble_eclipse_plugin() { - echo "Assemble eclipse plugin" - mkdir -p org.erlide.kernel/common - cp erlide_common/_build/default/lib/*/ebin/*.* org.erlide.kernel/common - cp erlide_tools/_build/default/lib/*/ebin/*.* org.erlide.kernel/common - - mkdir -p org.erlide.kernel/ide - cp erlide_ide/_build/default/lib/*/ebin/*.* org.erlide.kernel/ide - - mkdir -p org.erlide.kernel/debugger - cp erlide_debugger/_build/default/lib/*/ebin/*.* org.erlide.kernel/debugger - - mkdir -p org.erlide.kernel/debugger/23 - cp erlide_debugger_23/_build/default/lib/*/ebin/*.* org.erlide.kernel/debugger/23 - mkdir -p org.erlide.kernel/debugger/24 - cp erlide_debugger_24/_build/default/lib/*/ebin/*.* org.erlide.kernel/debugger/24 - mkdir -p org.erlide.kernel/debugger/25 - cp erlide_debugger_25/_build/default/lib/*/ebin/*.* org.erlide.kernel/debugger/25 - - cd org.erlide.kernel - rm -f org.erlide.kernel_*.zip - VSN=`get_plugin_vsn .` - zip -r org.erlide.kernel_$VSN.zip * > /dev/null - cd .. - - mkdir -p _build - rm -f _build/org.erlide.kernel_*.zip - mv org.erlide.kernel/org.erlide.kernel_*.zip _build - echo "Created _build/org.erlide.kernel_$VSN.zip" -} - -get_plugin_vsn() { - x=`cat $1/META-INF/MANIFEST.MF | grep "Bundle-Version:" | cut -d " " -f 2` - echo "${x%.qualifier}" -} - get_feature_vsn() { x=`cat $1/feature.xml | grep "version=" | head -n 2 | tail -n 1 | cut -d '"' -f 2` echo "${x%.qualifier}" } - -assemble_language_server() { - echo "Assemble language_server" - #cd - VSN=`get_server_vsn` - - #echo "Created _build/erlide_server_$VSN.zip" -} - -get_server_vsn() { - # FIXME - #x=`cat META-INF/MANIFEST.MF | grep "Bundle-Version:" | cut -d " " -f 2` - #echo "${x%.qualifier}" - echo "x.x.x" -} - diff --git a/common/apps/erlide_builder/src/erlide_builder.app.src b/common/apps/erlide_builder/src/erlide_builder.app.src index 4a3004f..bb01b4e 100644 --- a/common/apps/erlide_builder/src/erlide_builder.app.src +++ b/common/apps/erlide_builder/src/erlide_builder.app.src @@ -1,7 +1,7 @@ {application, erlide_builder, [ {description,"erlide_builder"}, - {vsn, "0.117.0"}, + {vsn, "0.118.0"}, {erlide_context, builder}, {registered, []}, {applications, [kernel, stdlib, erlide_common]}, diff --git a/common/apps/erlide_common/src/erlide_common.app.src b/common/apps/erlide_common/src/erlide_common.app.src index 7d5c667..7a61445 100644 --- a/common/apps/erlide_common/src/erlide_common.app.src +++ b/common/apps/erlide_common/src/erlide_common.app.src @@ -1,7 +1,7 @@ {application, erlide_common, [ {description,"erlide_common"}, - {vsn, "0.117.0"}, + {vsn, "0.118.0"}, {erlide_context, common}, {registered, []}, {applications, [kernel, stdlib]}, diff --git a/common/apps/erlide_tools/src/erlide_tools.app.src b/common/apps/erlide_tools/src/erlide_tools.app.src index c70d8cf..f2d06a9 100644 --- a/common/apps/erlide_tools/src/erlide_tools.app.src +++ b/common/apps/erlide_tools/src/erlide_tools.app.src @@ -1,7 +1,7 @@ {application, erlide_tools, [ {description,"erlide_tools"}, - {vsn, "0.117.0"}, + {vsn, "0.118.0"}, {erlide_context, common}, {registered, []}, {applications, [kernel, stdlib, erlide_common]}, diff --git a/common/build b/common/build index 2aebcee..8013922 100755 --- a/common/build +++ b/common/build @@ -5,4 +5,4 @@ source ../build_utils.sh dir=`pwd` prj=`basename $dir` -build_project ../rebar3 $prj 23 "$@" +build_project ../rebar3 $prj 25 "$@" diff --git a/common/rebar.config b/common/rebar.config index 59fcaa7..5cc5a38 100644 --- a/common/rebar.config +++ b/common/rebar.config @@ -1,4 +1,4 @@ -{require_otp_vsn, "23.*"}. +{require_otp_vsn, "25.*"}. {plugins, [ covertool diff --git a/debugger/build b/debugger/build index aef77d7..d8ef21b 100755 --- a/debugger/build +++ b/debugger/build @@ -1,10 +1,10 @@ #! /bin/bash -e -cd erlide_debugger_23 +cd erlide_debugger_25 ./build "$@" -cd ../erlide_debugger_24 +cd ../erlide_debugger_26 ./build "$@" -cd ../erlide_debugger_25 +cd ../erlide_debugger_27 ./build "$@" cd ../erlide_debugger ./build "$@" diff --git a/debugger/erlide_debugger/build b/debugger/erlide_debugger/build index 54d7e91..aeeede3 100755 --- a/debugger/erlide_debugger/build +++ b/debugger/erlide_debugger/build @@ -5,4 +5,4 @@ source ../../build_utils.sh dir=`pwd` prj=`basename $dir` -build_project ../../rebar3 $prj 23 do clean,compile +build_project ../../rebar3 $prj 25 do clean,compile diff --git a/debugger/erlide_debugger/rebar.config b/debugger/erlide_debugger/rebar.config index 6df14b4..184d765 100644 --- a/debugger/erlide_debugger/rebar.config +++ b/debugger/erlide_debugger/rebar.config @@ -1,4 +1,4 @@ -{require_otp_vsn, "23.*"}. +{require_otp_vsn, "25.*"}. {plugins, [ {rebar_localdep, {git, "https://github.com/alinpopa/rebar3-localdep-plugin.git", {branch, "master"}}} @@ -6,7 +6,7 @@ {deps, [ {erlide_common, {localdep, "common/apps/erlide_common"}}, - {erlide_debugger_23, {localdep, "debugger/erlide_debugger_23"}} + {erlide_debugger_25, {localdep, "debugger/erlide_debugger_25"}} ]}. diff --git a/debugger/erlide_debugger/rebar.lock b/debugger/erlide_debugger/rebar.lock index 88d695a..d36fad2 100644 --- a/debugger/erlide_debugger/rebar.lock +++ b/debugger/erlide_debugger/rebar.lock @@ -1,2 +1,2 @@ [{<<"erlide_common">>,{localdep,"common/apps/erlide_common"},0}, - {<<"erlide_debugger_23">>,{localdep,"debugger/erlide_debugger_23"},0}]. + {<<"erlide_debugger_25">>,{localdep,"debugger/erlide_debugger_25"},0}]. diff --git a/debugger/erlide_debugger/src/erlide_debugger.app.src b/debugger/erlide_debugger/src/erlide_debugger.app.src index 70a27c5..ab9ee44 100644 --- a/debugger/erlide_debugger/src/erlide_debugger.app.src +++ b/debugger/erlide_debugger/src/erlide_debugger.app.src @@ -1,7 +1,7 @@ {application, erlide_debugger, [ {description,"erlide_debugger"}, - {vsn, "0.117.0"}, + {vsn, "0.118.0"}, {erlide_context, debugger}, {registered, []}, {applications, [kernel, stdlib]}, diff --git a/debugger/erlide_debugger_23/src/dbg_iload.erl b/debugger/erlide_debugger_23/src/dbg_iload.erl deleted file mode 100644 index d15292d..0000000 --- a/debugger/erlide_debugger_23/src/dbg_iload.erl +++ /dev/null @@ -1,693 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-2017. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(dbg_iload). - --export([load_mod/4]). - -%%==================================================================== -%% External exports -%%==================================================================== - -%%-------------------------------------------------------------------- -%% load_mod(Mod, File, Binary, Db) -> {ok, Mod} -%% Mod = module() -%% File = string() Source file (including path) -%% Binary = binary() -%% Db = ETS identifier -%% Load a new module into the database. -%% -%% We want the loading of a module to be synchronous so that no other -%% process tries to interpret code in a module not being completely -%% loaded. This is achieved as this function is called from -%% dbg_iserver. We are suspended until the module has been loaded. -%%-------------------------------------------------------------------- --spec load_mod(Mod, file:filename(), binary(), ets:tid()) -> - {'ok', Mod} when Mod :: atom(). - -load_mod(Mod, File, Binary, Db) -> - Flag = process_flag(trap_exit, true), - Pid = spawn_link(load_mod1(Mod, File, Binary, Db)), - receive - {'EXIT', Pid, What} -> - process_flag(trap_exit, Flag), - What - end. - --spec load_mod1(atom(), file:filename(), binary(), ets:tid()) -> - fun(() -> no_return()). - -load_mod1(Mod, File, Binary, Db) -> - fun() -> - store_module(Mod, File, Binary, Db), - exit({ok, Mod}) - end. - -%%==================================================================== -%% Internal functions -%%==================================================================== - -store_module(Mod, File, Binary, Db) -> - {interpreter_module, Exp, Abst, Src, MD5} = binary_to_term(Binary), - Forms = case abstr(Abst) of - {abstract_v1,_} -> - exit({Mod,too_old_beam_file}); - {abstract_v2,_} -> - exit({Mod,too_old_beam_file}); - {raw_abstract_v1,Code0} -> - Code = interpret_file_attribute(Code0), - standard_transforms(Code) - end, - dbg_idb:insert(Db, mod_file, File), - dbg_idb:insert(Db, defs, []), - - put(vcount, 0), - put(fun_count, 0), - put(funs, []), - put(mod_md5, MD5), - store_forms(Forms, Mod, Db, Exp), - erase(mod_md5), - erase(current_function), - %% store_funs(Db, Mod), - erase(vcount), - erase(funs), - erase(fun_count), - - NewBinary = store_mod_line_no(Mod, Db, binary_to_list(Src)), - dbg_idb:insert(Db, mod_bin, NewBinary), - dbg_idb:insert(Db, mod_raw, <>). %% Add eos - -standard_transforms(Forms0) -> - Forms = erl_expand_records:module(Forms0, []), - erl_internal:add_predefined_functions(Forms). - - -%% Adjust line numbers using the file/2 attribute. -%% Also take the absolute value of line numbers. -%% This simple fix will make the marker point at the correct line -%% (assuming the file attributes are correct) in the source; it will -%% not point at code in included files. -interpret_file_attribute(Code) -> - epp:interpret_file_attribute(Code). - -abstr(Bin) when is_binary(Bin) -> binary_to_term(Bin); -abstr(Term) -> Term. - -% store_funs(Db, Mod) -> -% store_funs_1(get(funs), Db, Mod). - -% store_funs_1([{Name,Index,Uniq,_,_,Arity,Cs}|Fs], Db, Mod) -> -% dbg_idb:insert(Db, {Mod,Name,Arity,false}, Cs), -% dbg_idb:insert(Db, {'fun',Mod,Index,Uniq}, {Name,Arity,Cs}), -% store_funs_1(Fs, Db, Mod); -% store_funs_1([], _, _) -> ok. - -store_forms([{function,_,Name,Arity,Cs0}|Fs], Mod, Db, Exp) -> - FA = {Name,Arity}, - put(current_function, FA), - Cs = clauses(Cs0), - Exported = lists:member(FA, Exp), - dbg_idb:insert(Db, {Mod,Name,Arity,Exported}, Cs), - store_forms(Fs, Mod, Db, Exp); -store_forms([{attribute,_,_Name,_Val}|Fs], Mod, Db, Exp) -> - store_forms(Fs, Mod, Db, Exp); -store_forms([_|Fs], Mod, Db, Exp) -> - %% Ignore other forms such as {eof,_} or {warning,_}. - store_forms(Fs, Mod, Db, Exp); -store_forms([], _, _, _) -> - ok. - -store_mod_line_no(Mod, Db, Contents) -> - store_mod_line_no(Mod, Db, Contents, 1, 0, []). - -store_mod_line_no(_, _, [], _, _, NewCont) -> - list_to_binary(lists:reverse(NewCont)); -store_mod_line_no(Mod, Db, Contents, LineNo, Pos, NewCont) when is_integer(LineNo) -> - {ContTail,Pos1,NewCont1} = store_line(Mod, Db, Contents, LineNo, Pos, NewCont), - store_mod_line_no(Mod, Db, ContTail, LineNo+1, Pos1, NewCont1). - -store_line(_, Db, Contents, LineNo, Pos, NewCont) -> - {ContHead,ContTail,PosNL} = get_nl(Contents,Pos+8,[]), - dbg_idb:insert(Db,LineNo,{Pos+8,PosNL}), - {ContTail,PosNL+1,[make_lineno(LineNo, 8, ContHead)|NewCont]}. - -make_lineno(N, P, Acc) -> - S = integer_to_list(N), - S ++ [$:|spaces(P-length(S)-1, Acc)]. - -spaces(P, Acc) when P > 0 -> - spaces(P-1, [$\s|Acc]); -spaces(_, Acc) -> Acc. - -get_nl([10|T],Pos,Head) -> {lists:reverse([10|Head]),T,Pos}; -get_nl([H|T],Pos,Head) -> - get_nl(T,Pos+1,[H|Head]); -get_nl([],Pos,Head) -> {lists:reverse(Head),[],Pos}. - -%%% Rewrite the abstract syntax tree to that it will be easier (== faster) -%%% to interpret. - -clauses([C0|Cs]) -> - C1 = clause(C0, true), - [C1|clauses(Cs)]; -clauses([]) -> []. - -clause({clause,Anno,H0,G0,B0}, Lc) -> - H1 = head(H0), - G1 = guard(G0), - B1 = exprs(B0, Lc), - {clause,ln(Anno),H1,G1,B1}. - -head(Ps) -> patterns(Ps). - -%% These patterns are processed "sequentially" for purposes of variable -%% definition etc. - -patterns([P0|Ps]) -> - P1 = pattern(P0), - [P1|patterns(Ps)]; -patterns([]) -> []. - -%% N.B. Only valid patterns are included here. - -pattern({var,Anno,V}) -> {var,ln(Anno),V}; -pattern({char,Anno,I}) -> {value,ln(Anno),I}; -pattern({integer,Anno,I}) -> {value,ln(Anno),I}; -pattern({match,Anno,Pat1,Pat2}) -> - {match,ln(Anno),pattern(Pat1),pattern(Pat2)}; -pattern({float,Anno,F}) -> {value,ln(Anno),F}; -pattern({atom,Anno,A}) -> {value,ln(Anno),A}; -pattern({string,Anno,S}) -> {value,ln(Anno),S}; -pattern({nil,Anno}) -> {value,ln(Anno),[]}; -pattern({cons,Anno,H0,T0}) -> - H1 = pattern(H0), - T1 = pattern(T0), - {cons,ln(Anno),H1,T1}; -pattern({tuple,Anno,Ps0}) -> - Ps1 = pattern_list(Ps0), - {tuple,ln(Anno),Ps1}; -pattern({map,Anno,Fs0}) -> - Fs1 = lists:map(fun ({map_field_exact,L,K,V}) -> - {map_field_exact,L,gexpr(K),pattern(V)} - end, Fs0), - {map,ln(Anno),Fs1}; -pattern({op,_,'-',{integer,Anno,I}}) -> - {value,ln(Anno),-I}; -pattern({op,_,'+',{integer,Anno,I}}) -> - {value,ln(Anno),I}; -pattern({op,_,'-',{char,Anno,I}}) -> - {value,ln(Anno),-I}; -pattern({op,_,'+',{char,Anno,I}}) -> - {value,ln(Anno),I}; -pattern({op,_,'-',{float,Anno,I}}) -> - {value,ln(Anno),-I}; -pattern({op,_,'+',{float,Anno,I}}) -> - {value,ln(Anno),I}; -pattern({bin,Anno,Grp}) -> - Grp1 = pattern_list(bin_expand_strings(Grp)), - {bin,ln(Anno),Grp1}; -pattern({bin_element,Anno,Expr0,Size0,Type0}) -> - {Size1,Type} = make_bit_type(Anno, Size0, Type0), - Expr1 = pattern(Expr0), - Expr = coerce_to_float(Expr1, Type0), - Size = expr(Size1, false), - {bin_element,ln(Anno),Expr,Size,Type}; -%% Evaluate compile-time expressions. -pattern({op,_,'++',{nil,_},R}) -> - pattern(R); -pattern({op,_,'++',{cons,Li,H,T},R}) -> - pattern({cons,Li,H,{op,Li,'++',T,R}}); -pattern({op,_,'++',{string,Li,L},R}) -> - pattern(string_to_conses(Li, L, R)); -pattern({op,_Line,_Op,_A}=Op) -> - pattern(erl_eval:partial_eval(Op)); -pattern({op,_Line,_Op,_L,_R}=Op) -> - pattern(erl_eval:partial_eval(Op)). - -string_to_conses(Anno, Cs, Tail) -> - lists:foldr(fun (C, T) -> {cons,Anno,{char,Anno,C},T} end, Tail, Cs). - -coerce_to_float({value,Anno,Int}=E, [float|_]) when is_integer(Int) -> - try - {value,Anno,float(Int)} - catch - error:badarg -> E - end; -coerce_to_float(E, _) -> E. - -%% These patterns are processed "in parallel" for purposes of variable -%% definition etc. - -pattern_list([P0|Ps]) -> - P1 = pattern(P0), - [P1|pattern_list(Ps)]; -pattern_list([]) -> []. - -guard([G0|Gs]) -> - G1 = and_guard(G0), - [G1|guard(Gs)]; -guard([]) -> []. - -and_guard([G0|Gs]) -> - G1 = guard_test(G0), - [G1|and_guard(Gs)]; -and_guard([]) -> []. - -guard_test({call,Anno,{remote,_,{atom,_,erlang},{atom,_,F}},As0}) -> - As = gexpr_list(As0), - {safe_bif,ln(Anno),erlang,F,As}; -guard_test({op,Anno,Op,L0}) -> - true = erl_internal:arith_op(Op, 1) orelse %Assertion. - erl_internal:bool_op(Op, 1), - L1 = gexpr(L0), - {safe_bif,ln(Anno),erlang,Op,[L1]}; -guard_test({op,Anno,Op,L0,R0}) when Op =:= 'andalso'; Op =:= 'orelse' -> - L1 = gexpr(L0), - R1 = gexpr(R0), %They see the same variables - {Op,ln(Anno),L1,R1}; -guard_test({op,Anno,Op,L0,R0}) -> - true = erl_internal:comp_op(Op, 2) orelse %Assertion. - erl_internal:bool_op(Op, 2) orelse - erl_internal:arith_op(Op, 2), - L1 = gexpr(L0), - R1 = gexpr(R0), %They see the same variables - {safe_bif,ln(Anno),erlang,Op,[L1,R1]}; -guard_test({var,_,_}=V) ->V; % Boolean var -guard_test({atom,Anno,true}) -> {value,ln(Anno),true}; -%% All other constants at this level means false. -guard_test({atom,Anno,_}) -> {value,ln(Anno),false}; -guard_test({integer,Anno,_}) -> {value,ln(Anno),false}; -guard_test({char,Anno,_}) -> {value,ln(Anno),false}; -guard_test({float,Anno,_}) -> {value,ln(Anno),false}; -guard_test({string,Anno,_}) -> {value,ln(Anno),false}; -guard_test({nil,Anno}) -> {value,ln(Anno),false}; -guard_test({cons,Anno,_,_}) -> {value,ln(Anno),false}; -guard_test({tuple,Anno,_}) -> {value,ln(Anno),false}; -guard_test({map,Anno,_}) -> {value,ln(Anno),false}; -guard_test({map,Anno,_,_}) -> {value,ln(Anno),false}; -guard_test({bin,Anno,_}) -> {value,ln(Anno),false}. - -gexpr({var,Anno,V}) -> {var,ln(Anno),V}; -gexpr({integer,Anno,I}) -> {value,ln(Anno),I}; -gexpr({char,Anno,I}) -> {value,ln(Anno),I}; -gexpr({float,Anno,F}) -> {value,ln(Anno),F}; -gexpr({atom,Anno,A}) -> {value,ln(Anno),A}; -gexpr({string,Anno,S}) -> {value,ln(Anno),S}; -gexpr({nil,Anno}) -> {value,ln(Anno),[]}; -gexpr({cons,Anno,H0,T0}) -> - case {gexpr(H0),gexpr(T0)} of - {{value,Line,H1},{value,Line,T1}} -> {value,Line,[H1|T1]}; - {H1,T1} -> {cons,ln(Anno),H1,T1} - end; -gexpr({tuple,Anno,Es0}) -> - Es1 = gexpr_list(Es0), - {tuple,ln(Anno),Es1}; -gexpr({map,Anno,Fs0}) -> - new_map(Fs0, Anno, fun gexpr/1); -gexpr({map,Anno,E0,Fs0}) -> - E1 = gexpr(E0), - Fs1 = map_fields(Fs0, fun gexpr/1), - {map,ln(Anno),E1,Fs1}; -gexpr({bin,Anno,Flds0}) -> - Flds = gexpr_list(bin_expand_strings(Flds0)), - {bin,ln(Anno),Flds}; -gexpr({bin_element,Anno,Expr0,Size0,Type0}) -> - {Size1,Type} = make_bit_type(Anno, Size0, Type0), - Expr = gexpr(Expr0), - Size = gexpr(Size1), - {bin_element,ln(Anno),Expr,Size,Type}; -%%% The erl_expand_records pass has added the module name 'erlang' to -%%% all BIF calls, even in guards. -gexpr({call,Anno,{remote,_,{atom,_,erlang},{atom,_,self}},[]}) -> - {dbg,ln(Anno),self,[]}; -gexpr({call,Anno,{remote,_,{atom,_,erlang},{atom,_,F}},As0}) -> - As = gexpr_list(As0), - {safe_bif,ln(Anno),erlang,F,As}; -gexpr({op,Anno,Op,A0}) -> - erl_internal:arith_op(Op, 1), - A1 = gexpr(A0), - {safe_bif,ln(Anno),erlang,Op,[A1]}; -gexpr({op,Anno,Op,L0,R0}) when Op =:= 'andalso'; Op =:= 'orelse' -> - L1 = gexpr(L0), - R1 = gexpr(R0), %They see the same variables - {Op,ln(Anno),L1,R1}; -gexpr({op,Anno,Op,L0,R0}) -> - true = erl_internal:arith_op(Op, 2) orelse erl_internal:comp_op(Op, 2) - orelse erl_internal:bool_op(Op, 2), - L1 = gexpr(L0), - R1 = gexpr(R0), %They see the same variables - {safe_bif,ln(Anno),erlang,Op,[L1,R1]}. - -%% These expressions are processed "in parallel" for purposes of variable -%% definition etc. - -gexpr_list([E0|Es]) -> - E1 = gexpr(E0), - [E1|gexpr_list(Es)]; -gexpr_list([]) -> []. - -%% These expressions are processed "sequentially" for purposes of variable -%% definition etc. - -exprs([E], Lc) -> - [expr(E, Lc)]; -exprs([E0|Es], Lc) -> - E1 = expr(E0, false), - [E1|exprs(Es, Lc)]; -exprs([], _Lc) -> []. - -expr({var,Anno,V}, _Lc) -> {var,ln(Anno),V}; -expr({integer,Anno,I}, _Lc) -> {value,ln(Anno),I}; -expr({char,Anno,I}, _Lc) -> {value,ln(Anno),I}; -expr({float,Anno,F}, _Lc) -> {value,ln(Anno),F}; -expr({atom,Anno,A}, _Lc) -> {value,ln(Anno),A}; -expr({string,Anno,S}, _Lc) -> {value,ln(Anno),S}; -expr({nil,Anno}, _Lc) -> {value,ln(Anno),[]}; -expr({cons,Anno,H0,T0}, _Lc) -> - case {expr(H0, false),expr(T0, false)} of - {{value,Line,H1},{value,Line,T1}} -> {value,Line,[H1|T1]}; - {H1,T1} -> {cons,ln(Anno),H1,T1} - end; -expr({tuple,Anno,Es0}, _Lc) -> - Es1 = expr_list(Es0), - {tuple,ln(Anno),Es1}; -expr({map,Anno,Fs}, _Lc) -> - new_map(Fs, Anno, fun (E) -> expr(E, false) end); -expr({map,Anno,E0,Fs0}, _Lc) -> - E1 = expr(E0, false), - Fs1 = map_fields(Fs0), - {map,ln(Anno),E1,Fs1}; -expr({block,Anno,Es0}, Lc) -> - %% Unfold block into a sequence. - Es1 = exprs(Es0, Lc), - {block,ln(Anno),Es1}; -expr({'if',Anno,Cs0}, Lc) -> - Cs1 = icr_clauses(Cs0, Lc), - {'if',ln(Anno),Cs1}; -expr({'case',Anno,E0,Cs0}, Lc) -> - E1 = expr(E0, false), - Cs1 = icr_clauses(Cs0, Lc), - {'case',ln(Anno),E1,Cs1}; -expr({'receive',Anno,Cs0}, Lc) -> - Cs1 = icr_clauses(Cs0, Lc), - {'receive',ln(Anno),Cs1}; -expr({'receive',Anno,Cs0,To0,ToEs0}, Lc) -> - To1 = expr(To0, false), - ToEs1 = exprs(ToEs0, Lc), - Cs1 = icr_clauses(Cs0, Lc), - {'receive',ln(Anno),Cs1,To1,ToEs1}; -expr({'fun',Anno,{clauses,Cs0}}, _Lc) -> - %% New R10B-2 format (abstract_v2). - Cs = fun_clauses(Cs0), - Name = new_fun_name(), - {make_fun,ln(Anno),Name,Cs}; -expr({'fun',Anno,{function,F,A}}, _Lc) -> - %% New R8 format (abstract_v2). - Line = ln(Anno), - As = new_vars(A, Line), - Name = new_fun_name(), - Cs = [{clause,Line,As,[],[{local_call,Line,F,As,true}]}], - {make_fun,Line,Name,Cs}; -expr({named_fun,Anno,FName,Cs0}, _Lc) -> - Cs = fun_clauses(Cs0), - Name = new_fun_name(), - {make_named_fun,ln(Anno),Name,FName,Cs}; -expr({'fun',Anno,{function,{atom,_,M},{atom,_,F},{integer,_,A}}}, _Lc) - when 0 =< A, A =< 255 -> - %% New format in R15 for fun M:F/A (literal values). - {value,ln(Anno),erlang:make_fun(M, F, A)}; -expr({'fun',Anno,{function,M,F,A}}, _Lc) -> - %% New format in R15 for fun M:F/A (one or more variables). - MFA = expr_list([M,F,A]), - {make_ext_fun,ln(Anno),MFA}; -expr({call,Anno,{remote,_,{atom,_,erlang},{atom,_,self}},[]}, _Lc) -> - {dbg,ln(Anno),self,[]}; -expr({call,Anno,{remote,_,{atom,_,erlang},{atom,_,throw}},[_]=As}, _Lc) -> - {dbg,ln(Anno),throw,expr_list(As)}; -expr({call,Anno,{remote,_,{atom,_,erlang},{atom,_,error}},[_]=As}, _Lc) -> - {dbg,ln(Anno),error,expr_list(As)}; -expr({call,Anno,{remote,_,{atom,_,erlang},{atom,_,exit}},[_]=As}, _Lc) -> - {dbg,ln(Anno),exit,expr_list(As)}; -expr({call,Anno,{remote,_,{atom,_,erlang},{atom,_,raise}},[_,_,_]=As}, _Lc) -> - {dbg,ln(Anno),raise,expr_list(As)}; -expr({call,Anno,{remote,_,{atom,_,erlang},{atom,_,apply}},[_,_,_]=As0}, Lc) -> - As = expr_list(As0), - {apply,ln(Anno),As,Lc}; -expr({call,Anno,{remote,_,{atom,_,Mod},{atom,_,Func}},As0}, Lc) -> - As = expr_list(As0), - case erlang:is_builtin(Mod, Func, length(As)) of - false -> - {call_remote,ln(Anno),Mod,Func,As,Lc}; - true -> - case bif_type(Mod, Func, length(As0)) of - safe -> {safe_bif,ln(Anno),Mod,Func,As}; - unsafe ->{bif,ln(Anno),Mod,Func,As} - end - end; -expr({call,Anno,{remote,_,Mod0,Func0},As0}, Lc) -> - %% New R8 format (abstract_v2). - Mod = expr(Mod0, false), - Func = expr(Func0, false), - As = consify(expr_list(As0)), - {apply,ln(Anno),[Mod,Func,As],Lc}; -expr({call,Anno,{atom,_,Func},As0}, Lc) -> - As = expr_list(As0), - {local_call,ln(Anno),Func,As,Lc}; -expr({call,Anno,Fun0,As0}, Lc) -> - Fun = expr(Fun0, false), - As = expr_list(As0), - {apply_fun,ln(Anno),Fun,As,Lc}; -expr({'catch',Anno,E0}, _Lc) -> - %% No new variables added. - E1 = expr(E0, false), - {'catch',ln(Anno),E1}; -expr({'try',Anno,Es0,CaseCs0,CatchCs0,As0}, Lc) -> - %% No new variables added. - Es = expr_list(Es0), - CaseCs = icr_clauses(CaseCs0, Lc), - CatchCs = icr_clauses(CatchCs0, Lc), - As = expr_list(As0), - {'try',ln(Anno),Es,CaseCs,CatchCs,As}; -expr({lc,_,_,_}=Compr, _Lc) -> - expr_lc_bc(Compr); -expr({bc,_,_,_}=Compr, _Lc) -> - expr_lc_bc(Compr); -expr({match,Anno,P0,E0}, _Lc) -> - E1 = expr(E0, false), - P1 = pattern(P0), - {match,ln(Anno),P1,E1}; -expr({op,Anno,Op,A0}, _Lc) -> - A1 = expr(A0, false), - {op,ln(Anno),Op,[A1]}; -expr({op,Anno,'++',L0,R0}, _Lc) -> - L1 = expr(L0, false), - R1 = expr(R0, false), %They see the same variables - {op,ln(Anno),append,[L1,R1]}; -expr({op,Anno,'--',L0,R0}, _Lc) -> - L1 = expr(L0, false), - R1 = expr(R0, false), %They see the same variables - {op,ln(Anno),subtract,[L1,R1]}; -expr({op,Anno,'!',L0,R0}, _Lc) -> - L1 = expr(L0, false), - R1 = expr(R0, false), %They see the same variables - {send,ln(Anno),L1,R1}; -expr({op,Anno,Op,L0,R0}, _Lc) when Op =:= 'andalso'; Op =:= 'orelse' -> - L1 = expr(L0, false), - R1 = expr(R0, false), %They see the same variables - {Op,ln(Anno),L1,R1}; -expr({op,Anno,Op,L0,R0}, _Lc) -> - L1 = expr(L0, false), - R1 = expr(R0, false), %They see the same variables - {op,ln(Anno),Op,[L1,R1]}; -expr({bin,Anno,Grp}, _Lc) -> - Grp1 = expr_list(bin_expand_strings(Grp)), - {bin,ln(Anno),Grp1}; -expr({bin_element,Anno,Expr0,Size0,Type0}, _Lc) -> - {Size1,Type} = make_bit_type(Anno, Size0, Type0), - Expr = expr(Expr0, false), - Size = expr(Size1, false), - {bin_element,ln(Anno),Expr,Size,Type}. - -consify([A|As]) -> - {cons,0,A,consify(As)}; -consify([]) -> {value,0,[]}. - -make_bit_type(Line, default, Type0) -> - case erl_bits:set_bit_type(default, Type0) of - {ok,all,Bt} -> {{atom,Line,all},erl_bits:as_list(Bt)}; - {ok,undefined,Bt} -> {{atom,Line,undefined},erl_bits:as_list(Bt)}; - {ok,Size,Bt} -> {{integer,Line,Size},erl_bits:as_list(Bt)} - end; -make_bit_type(_Line, Size, Type0) -> %Integer or 'all' - {ok,Size,Bt} = erl_bits:set_bit_type(Size, Type0), - {Size,erl_bits:as_list(Bt)}. - -expr_lc_bc({Tag,Anno,E0,Gs0}) -> - Gs = lists:map(fun ({generate,L,P0,Qs}) -> - {generate,L,pattern(P0),expr(Qs, false)}; - ({b_generate,L,P0,Qs}) -> %R12. - {b_generate,L,pattern(P0),expr(Qs, false)}; - (Expr) -> - case is_guard_test(Expr) of - true -> {guard,guard([[Expr]])}; - false -> expr(Expr, false) - end - end, Gs0), - {Tag,ln(Anno),expr(E0, false),Gs}. - -is_guard_test(Expr) -> - IsOverridden = fun({_,_}) -> true end, - erl_lint:is_guard_test(Expr, [], IsOverridden). - -%% The debugger converts both strings "abc" and lists [67, 68, 69] -%% into {value, Line, [67, 68, 69]}, making it impossible to later -%% distingish one or the other inside binaries when evaluating. To -%% avoid <<[67, 68, 69]>> from evaluating, we convert strings into -%% chars to avoid the ambiguity. -bin_expand_strings(Es) -> - lists:foldr(fun ({bin_element,Line,{string,_,S},Sz,Ts}, Es1) -> - lists:foldr(fun (C, Es2) -> - [{bin_element,Line,{char,Line,C},Sz,Ts}|Es2] - end, Es1, S); - (E, Es1) -> [E|Es1] - end, [], Es). - -%% -type expr_list([Expression]) -> [Expression]. -%% These expressions are processed "in parallel" for purposes of variable -%% definition etc. - -expr_list([E0|Es]) -> - E1 = expr(E0, false), - [E1|expr_list(Es)]; -expr_list([]) -> []. - -icr_clauses([C0|Cs], Lc) -> - C1 = clause(C0, Lc), - [C1|icr_clauses(Cs, Lc)]; -icr_clauses([], _) -> []. - -fun_clauses([{clause,A,H,G,B}|Cs]) -> - [{clause,ln(A),head(H),guard(G),exprs(B, true)}|fun_clauses(Cs)]; -fun_clauses([]) -> []. - - -new_map(Fs0, Anno, F) -> - Line = ln(Anno), - Fs1 = map_fields(Fs0, F), - Fs2 = [{L,K,V} || {map_field_assoc,L,K,V} <- Fs1], - try - {value,Line,map_literal(Fs2, #{})} - catch - throw:not_literal -> - {map,Line,Fs2} - end. - -map_literal([{_,{value,_,K},{value,_,V}}|T], M) -> - map_literal(T, maps:put(K, V, M)); -map_literal([_|_], _) -> - throw(not_literal); -map_literal([], M) -> M. - -map_fields(Fs) -> - map_fields(Fs, fun (E) -> expr(E, false) end). - -map_fields([{map_field_assoc,A,N,V}|Fs], F) -> - [{map_field_assoc,ln(A),F(N),F(V)}|map_fields(Fs)]; -map_fields([{map_field_exact,A,N,V}|Fs], F) -> - [{map_field_exact,ln(A),F(N),F(V)}|map_fields(Fs)]; -map_fields([], _) -> []. - -%% new_var_name() -> VarName. - -new_var_name() -> - C = get(vcount), - put(vcount, C+1), - list_to_atom("%" ++ integer_to_list(C)). - -%% new_vars(Count, Line) -> [Var]. -%% Make Count new variables. - -new_vars(N, L) -> new_vars(N, L, []). - -new_vars(N, L, Vs) when N > 0 -> - V = {var,L,new_var_name()}, - new_vars(N-1, L, [V|Vs]); -new_vars(0, _, Vs) -> Vs. - -new_fun_name() -> - {F,A} = get(current_function), - I = get(fun_count), - put(fun_count, I+1), - Name = "-" ++ atom_to_list(F) ++ "/" ++ integer_to_list(A) ++ - "-fun-" ++ integer_to_list(I) ++ "-", - list_to_atom(Name). - -ln(Anno) -> - erl_anno:line(Anno). - -bif_type(erlang, Name, Arity) -> - case erl_internal:guard_bif(Name, Arity) of - true -> - %% Guard BIFs are safe (except for self/0, but it is - %% handled with a special instruction anyway). - safe; - false -> - bif_type(Name) - end; -bif_type(_, _, _) -> unsafe. - -bif_type(register) -> safe; -bif_type(unregister) -> safe; -bif_type(whereis) -> safe; -bif_type(registered) -> safe; -bif_type(setelement) -> safe; -bif_type(atom_to_list) -> safe; -bif_type(list_to_atom) -> safe; -bif_type(integer_to_list) -> safe; -bif_type(list_to_integer) -> safe; -bif_type(float_to_list) -> safe; -bif_type(list_to_float) -> safe; -bif_type(tuple_to_list) -> safe; -bif_type(list_to_tuple) -> safe; -bif_type(make_ref) -> safe; -bif_type(time) -> safe; -bif_type(date) -> safe; -bif_type(processes) -> safe; -bif_type(process_info) -> safe; -bif_type(load_module) -> safe; -bif_type(delete_module) -> safe; -bif_type(halt) -> safe; -bif_type(check_process_code) -> safe; -bif_type(purge_module) -> safe; -bif_type(pid_to_list) -> safe; -bif_type(list_to_pid) -> safe; -bif_type(module_loaded) -> safe; -bif_type(binary_to_term) -> safe; -bif_type(term_to_binary) -> safe; -bif_type(nodes) -> safe; -bif_type(is_alive) -> safe; -bif_type(disconnect_node) -> safe; -bif_type(binary_to_list) -> safe; -bif_type(list_to_binary) -> safe; -bif_type(split_binary) -> safe; -bif_type(hash) -> safe; -bif_type(pre_loaded) -> safe; -bif_type(set_cookie) -> safe; -bif_type(get_cookie) -> safe; -bif_type(_) -> unsafe. diff --git a/debugger/erlide_debugger_25/src/erlide_debugger_25.app.src b/debugger/erlide_debugger_25/src/erlide_debugger_25.app.src index fbca149..42c82f5 100644 --- a/debugger/erlide_debugger_25/src/erlide_debugger_25.app.src +++ b/debugger/erlide_debugger_25/src/erlide_debugger_25.app.src @@ -1,7 +1,7 @@ {application, erlide_debugger_25, [ {description, "erlide_debugger_25"}, - {vsn, "5.3"}, + {vsn, "0.118.0"}, {erlide_context, debugger}, {registered, []}, {applications, [kernel, stdlib]}, diff --git a/debugger/erlide_debugger_23/build b/debugger/erlide_debugger_26/build similarity index 64% rename from debugger/erlide_debugger_23/build rename to debugger/erlide_debugger_26/build index 370027c..3c78842 100755 --- a/debugger/erlide_debugger_23/build +++ b/debugger/erlide_debugger_26/build @@ -5,4 +5,4 @@ source ../../build_utils.sh dir=`pwd` prj=`basename $dir` -build_project ../../rebar3 $prj 23 "$@" +build_project ../../rebar3 $prj 26 "$@" diff --git a/debugger/erlide_debugger_23/include/.keep b/debugger/erlide_debugger_26/include/.keep similarity index 100% rename from debugger/erlide_debugger_23/include/.keep rename to debugger/erlide_debugger_26/include/.keep diff --git a/debugger/erlide_debugger_23/priv/.keep b/debugger/erlide_debugger_26/priv/.keep similarity index 100% rename from debugger/erlide_debugger_23/priv/.keep rename to debugger/erlide_debugger_26/priv/.keep diff --git a/debugger/erlide_debugger_24/rebar.config b/debugger/erlide_debugger_26/rebar.config similarity index 94% rename from debugger/erlide_debugger_24/rebar.config rename to debugger/erlide_debugger_26/rebar.config index a5d5fcc..b21cbca 100644 --- a/debugger/erlide_debugger_24/rebar.config +++ b/debugger/erlide_debugger_26/rebar.config @@ -1,4 +1,4 @@ -{require_otp_vsn, "24.*"}. +{require_otp_vsn, "26.*"}. {plugins, []}. diff --git a/debugger/erlide_debugger_23/rebar.lock b/debugger/erlide_debugger_26/rebar.lock similarity index 100% rename from debugger/erlide_debugger_23/rebar.lock rename to debugger/erlide_debugger_26/rebar.lock diff --git a/debugger/erlide_debugger_23/src/dbg_debugged.erl b/debugger/erlide_debugger_26/src/dbg_debugged.erl similarity index 100% rename from debugger/erlide_debugger_23/src/dbg_debugged.erl rename to debugger/erlide_debugger_26/src/dbg_debugged.erl diff --git a/debugger/erlide_debugger_23/src/dbg_icmd.erl b/debugger/erlide_debugger_26/src/dbg_icmd.erl similarity index 93% rename from debugger/erlide_debugger_23/src/dbg_icmd.erl rename to debugger/erlide_debugger_26/src/dbg_icmd.erl index b3e06c4..8f9e991 100644 --- a/debugger/erlide_debugger_23/src/dbg_icmd.erl +++ b/debugger/erlide_debugger_26/src/dbg_icmd.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2018. All Rights Reserved. +%% Copyright Ericsson AB 1998-2023. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -26,10 +26,13 @@ -export([step/1, next/1, continue/1, finish/1, skip/1, timeout/1, stop/1]). -export([eval/2]). --export([set_variable_value/4]). -export([set/3, get/3]). -export([handle_msg/4]). +%% erlide patch ------------------------------------------------------ +-export([set_variable_value/4]). +%% erlide patch ------------------------------------------------------ + %% Library functions for attached process handling -export([tell_attached/1]). @@ -51,9 +54,11 @@ %% specifies if the process should break. %%-------------------------------------------------------------------- +%% erlide patch ------------------------------------------------------ %% Common Test adaptation cmd({call_remote,0,ct_line,line,_As}, Bs, _Ieval) -> Bs; +%% erlide patch ------------------------------------------------------ cmd(Expr, Bs, Ieval) -> cmd(Expr, Bs, get(next_break), Ieval). @@ -186,6 +191,7 @@ timeout(Meta) -> Meta ! {user, timeout}. stop(Meta) -> Meta ! {user, {cmd, stop}}. +%% erlide patch ------------------------------------------------------ set_variable_value(Meta, Variable, Value, SP) -> eval(Meta, {no_module, Variable++"="++Value, SP}), receive @@ -194,7 +200,7 @@ set_variable_value(Meta, Variable, Value, SP) -> after 5000 -> {error, timeout} end. - +%% erlide patch ------------------------------------------------------ eval(Meta, {Mod, Cmd}) -> eval(Meta, {Mod, Cmd, nostack}); @@ -306,7 +312,8 @@ handle_int_msg({break_options, Break}, _Status, _Bs, _Ieval) -> handle_int_msg(no_break, _Status, _Bs, _Ieval) -> put(breakpoints, []); handle_int_msg({no_break,M}, _Status, _Bs, _Ieval) -> - put(breakpoints, [ML || {Mod,_L}=ML <- get(breakpoints), Mod=/=M]); + put(breakpoints, [B || {{Mod,_L},_Flags}=B <- get(breakpoints), + Mod =/= M]); handle_int_msg(stop, exit_at, _Bs, _Ieval) -> erlang:exit(normal). @@ -351,10 +358,12 @@ handle_user_msg({set,trace,Bool}, _Status, _Bs, _Ieval) -> tell_attached({trace, Bool}); handle_user_msg({set,stack_trace,Flag}, _Status, _Bs, _Ieval) -> set_stack_trace(Flag); -handle_user_msg({get, all_stack_frames, From, _}, _Status, Bs, _Ieval) -> +%% erlide patch ------------------------------------------------------ +handle_user_msg({get,all_stack_frames,From,_}, _Status, Bs, _Ieval) -> reply(From, all_stack_frames, {all_frames(), Bs}); -handle_user_msg({get, all_modules_on_stack, From, _}, _Status, _Bs, _Ieval) -> +handle_user_msg({get,all_modules_on_stack,From,_}, _Status, _Bs, _Ieval) -> reply(From, all_modules_on_stack, all_modules_on_stack()); +%% erlide patch ------------------------------------------------------ handle_user_msg({get,bindings,From,SP}, _Status, Bs, _Ieval) -> reply(From, bindings, bindings(Bs, SP)); handle_user_msg({get,stack_frame,From,{Dir,SP}}, _Status, _Bs,_Ieval) -> @@ -364,11 +373,13 @@ handle_user_msg({get,messages,From,_}, _Status, _Bs, _Ieval) -> handle_user_msg({get,backtrace,From,N}, _Status, _Bs, Ieval) -> reply(From, backtrace, dbg_istk:backtrace(N, Ieval)). +%% erlide patch ------------------------------------------------------ all_modules_on_stack() -> dbg_istk:all_modules_on_stack(). all_frames() -> dbg_ieval:all_frames(). +%% erlide patch ------------------------------------------------------ set_stack_trace(true) -> set_stack_trace(all); @@ -407,19 +418,14 @@ eval_restricted({From,_Mod,Cmd,SP}, Bs) -> case catch parse_cmd(Cmd, 1) of {'EXIT', _Reason} -> From ! {self(), {eval_rsp, 'Parse error'}}; - {[{var,_,Var}], XBs} -> + [{var,_,Var}] -> Bs2 = bindings(Bs, SP), Res = case get_binding(Var, Bs2) of {value, Value} -> Value; - unbound -> - case get_binding(Var, XBs) of - {value, _} -> - 'Only possible to inspect variables'; - unbound -> unbound - end + unbound -> unbound end, From ! {self(), {eval_rsp, Res}}; - {_Forms, _XBs} -> + _Forms -> Rsp = 'Only possible to inspect variables', From ! {self(), {eval_rsp, Rsp}} end. @@ -434,18 +440,17 @@ eval_nonrestricted({From, _Mod, Cmd, _SP}, Bs, {'EXIT', _Reason} -> From ! {self(), {eval_rsp, 'Parse error'}}, Bs; - {Forms, XBs} -> + Forms -> mark_running(Line, Le), - Bs1 = merge_bindings(Bs, XBs), - {Res, Bs2} = + {Res, Bs1} = lists:foldl(fun(Expr, {_Res, Bs0}) -> eval_nonrestricted_1(Expr,Bs0,Ieval) end, - {null, Bs1}, + {null, Bs}, Forms), mark_break(M, Line, Le), From ! {self(), {eval_rsp, Res}}, - remove_binding_structs(Bs2, XBs) + Bs1 end. eval_nonrestricted_1({match,_,{var,_,Var},Expr}, Bs, Ieval) -> @@ -470,14 +475,6 @@ eval_expr(Expr, Bs, Ieval) -> dbg_ieval:eval_expr(Expr, Bs, Ieval#ieval{top=false}), {Res,Bs2}. -%% XBs have unique keys. -merge_bindings(Bs1, XBs) -> - Bs1 ++ erl_eval:bindings(XBs). - -remove_binding_structs(Bs1, XBs) -> - lists:foldl(fun({N, _V}, Bs) -> lists:keydelete(N, 1, Bs) - end, Bs1, erl_eval:bindings(XBs)). - mark_running(LineNo, Le) -> put(next_break, running), put(user_eval, [{LineNo, Le} | get(user_eval)]), @@ -492,8 +489,8 @@ mark_break(Cm, LineNo, Le) -> parse_cmd(Cmd, LineNo) -> {ok,Tokens,_} = erl_scan:string(Cmd, LineNo, [text]), - {ok,Forms,Bs} = erl_eval:extended_parse_exprs(Tokens), - {Forms, Bs}. + {ok,Forms} = erl_eval:extended_parse_exprs(Tokens), + Forms. %%==================================================================== %% Library functions for attached process handling diff --git a/debugger/erlide_debugger_23/src/dbg_idb.erl b/debugger/erlide_debugger_26/src/dbg_idb.erl similarity index 100% rename from debugger/erlide_debugger_23/src/dbg_idb.erl rename to debugger/erlide_debugger_26/src/dbg_idb.erl diff --git a/debugger/erlide_debugger_24/src/dbg_ieval.erl b/debugger/erlide_debugger_26/src/dbg_ieval.erl similarity index 91% rename from debugger/erlide_debugger_24/src/dbg_ieval.erl rename to debugger/erlide_debugger_26/src/dbg_ieval.erl index bb76c52..fed8d72 100644 --- a/debugger/erlide_debugger_24/src/dbg_ieval.erl +++ b/debugger/erlide_debugger_26/src/dbg_ieval.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2021. All Rights Reserved. +%% Copyright Ericsson AB 1998-2024. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -22,7 +22,10 @@ -export([eval/3,exit_info/5]). -export([eval_expr/3]). -export([check_exit_msg/3,exception/4]). + +%% erlide patch ------------------------------------------------------ -export([all_frames/0]). +%% erlide patch ------------------------------------------------------ -include("dbg_ieval.hrl"). @@ -74,21 +77,29 @@ exit_info(Int, AttPid, OrigPid, Reason, ExitInfo) -> {{Mod,Line},Bs,S} -> dbg_istk:from_external(S), Le = dbg_istk:stack_level(), +%% erlide patch ------------------------------------------------------ + %% dbg_icmd:tell_attached({exit_at, {Mod, Line}, Reason, Le}), dbg_icmd:tell_attached({exit_at, {Mod, Line}, Reason, Le, OrigPid, dbg_istk:all_frames(S), Bs}), +%% erlide patch ------------------------------------------------------ exit_loop(OrigPid, Reason, Bs,#ieval{module=Mod,line=Line}); {} -> dbg_istk:init(), +%% erlide patch ------------------------------------------------------ + %% dbg_icmd:tell_attached({exit_at, null, Reason, 1}), dbg_icmd:tell_attached({exit_at, null, Reason, 1, OrigPid}), +%% erlide patch ------------------------------------------------------ exit_loop(OrigPid, Reason, erl_eval:new_bindings(),#ieval{}) end. +%% erlide patch ------------------------------------------------------ all_frames() -> {dbg_istk:all_frames(), []}. +%% erlide patch ------------------------------------------------------ %%-------------------------------------------------------------------- %% eval_expr(Expr, Bs, Ieval) -> {value, Value, Bs} %% -%% Evalute a shell expression in the real process. +%% Evaluate a shell expression in the real process. %% Called (dbg_icmd) in response to a user request. %%-------------------------------------------------------------------- eval_expr(Expr0, Bs, Ieval) -> @@ -270,7 +281,7 @@ meta_loop(Debugged, Bs, #ieval{level=Le} = Ieval) -> end, do_exception(Class, Reason, MakeStk, Bs, Ieval); - %% Error must have occured within a re-entry to + %% Error must have occurred within a re-entry to %% interpreted code, simply raise the exception _ -> erlang:Class(Reason) @@ -464,10 +475,12 @@ do_eval_function(Mod, Fun, As0, Bs0, _, Ieval0) when is_function(Fun); exception(error, Reason, Bs0, Ieval0) end; +%% erlide patch ------------------------------------------------------ %% Common Test adaptation do_eval_function(ct_line, line, As, Bs, extern, #ieval{level=Le}=Ieval) -> debugged_cmd({apply,ct_line,line,As}, Bs, Ieval#ieval{level=Le+1}), {value, ignore, Bs}; +%% erlide patch ------------------------------------------------------ do_eval_function(Mod, Name, As0, Bs0, Called, Ieval0) -> #ieval{level=Le,line=Li,top=Top} = Ieval0, @@ -629,8 +642,12 @@ seq([E|Es], Bs0, Ieval) -> {skip,Bs} -> seq(Es, Bs, Ieval); Bs1 -> - {value,_,Bs} = expr(E, Bs1, Ieval#ieval{top=false}), - seq(Es, Bs, Ieval) + case expr(E, Bs1, Ieval#ieval{top=false}) of + {value,_,Bs} -> + seq(Es, Bs, Ieval); + {bad_maybe_match,_}=Bad -> + Bad + end end; seq([], Bs, _) -> {value,true,Bs}. @@ -678,7 +695,7 @@ expr({map,Line,E0,Fs0}, Bs0, Ieval0) -> %% Record update expr({record_update,Line,Es},Bs,#ieval{level=Le}=Ieval0) -> - %% Incr Level, we don't need to step (next) trough temp + %% Incr Level, we don't need to step (next) through temp %% variables creation and matching Ieval = Ieval0#ieval{top=false, line=Line, level=Le+1}, Seq = fun(E, {_, _, Bs1}) -> expr(E, Bs1, Ieval) end, @@ -764,6 +781,24 @@ expr({'orelse',Line,E1,E2}, Bs0, Ieval) -> exception(error, {badarg,Val}, Bs, Ieval) end; +%% Maybe statement without else +expr({'maybe',Line,Es}, Bs, Ieval) -> + case seq(Es, Bs, Ieval#ieval{line=Line}) of + {bad_maybe_match,Val} -> + {value,Val,Bs}; + {value,_,_}=Other -> + Other + end; + +%% Maybe statement with else +expr({'maybe',Line,Es,Cs}, Bs, Ieval) -> + case seq(Es, Bs, Ieval#ieval{line=Line}) of + {bad_maybe_match,Val} -> + case_clauses(Val, Cs, Bs, else_clause, Ieval#ieval{line=Line}); + {value,_,_}=Other -> + Other + end; + %% Matching expression expr({match,Line,Lhs,Rhs0}, Bs0, Ieval0) -> Ieval = Ieval0#ieval{line=Line}, @@ -775,6 +810,17 @@ expr({match,Line,Lhs,Rhs0}, Bs0, Ieval0) -> exception(error, {badmatch,Rhs}, Bs1, Ieval) end; +%% Conditional match expression (?=) +expr({maybe_match,Line,Lhs,Rhs0}, Bs0, Ieval0) -> + Ieval = Ieval0#ieval{line=Line}, + {value,Rhs,Bs1} = expr(Rhs0, Bs0, Ieval#ieval{top=false}), + case match(Lhs, Rhs, Bs1) of + {match,Bs} -> + {value,Rhs,Bs}; + nomatch -> + {bad_maybe_match,Rhs} + end; + %% Construct a fun expr({make_fun,Line,Name,Cs}, Bs, #ieval{module=Module}=Ieval) -> Arity = length(element(3,hd(Cs))), @@ -908,10 +954,12 @@ expr({make_ext_fun,Line,MFA0}, Bs0, Ieval0) -> exception(error, badarg, Bs, Ieval, true) end; +%% erlide patch ------------------------------------------------------ %% Common test adaptation expr({call_remote,0,ct_line,line,As0,Lc}, Bs0, Ieval0) -> {As,_Bs} = eval_list(As0, Bs0, Ieval0), eval_function(ct_line, line, As, Bs0, extern, Ieval0, Lc); +%% erlide patch ------------------------------------------------------ %% Local function call expr({local_call,Line,F,As0,Lc}, Bs0, #ieval{module=M} = Ieval0) -> @@ -1057,9 +1105,7 @@ expr({bin,Line,Fs}, Bs0, Ieval0) -> Ieval = Ieval0#ieval{line=Line,top=false}, try eval_bits:expr_grp(Fs, Bs0, - fun (E, B) -> expr(E, B, Ieval) end, - [], - false) + fun (E, B) -> expr(E, B, Ieval) end) catch Class:Reason -> exception(Class, Reason, Bs0, Ieval) @@ -1070,6 +1116,8 @@ expr({lc,_Line,E,Qs}, Bs, Ieval) -> eval_lc(E, Qs, Bs, Ieval); expr({bc,_Line,E,Qs}, Bs, Ieval) -> eval_bc(E, Qs, Bs, Ieval); +expr({mc,_Line,E,Qs}, Bs, Ieval) -> + eval_mc(E, Qs, Bs, Ieval); %% Brutal exit on unknown expressions/clauses/values/etc. expr(E, _Bs, _Ieval) -> @@ -1090,16 +1138,9 @@ eval_named_fun(As, RF, {Info,Bs,Cs,FName}) -> eval_lc(E, Qs, Bs, Ieval) -> {value,eval_lc1(E, Qs, Bs, Ieval),Bs}. -eval_lc1(E, [{generate,Line,P,L0}|Qs], Bs0, Ieval0) -> - Ieval = Ieval0#ieval{line=Line}, - {value,L1,Bs1} = expr(L0, Bs0, Ieval#ieval{top=false}), +eval_lc1(E, [{generator,G}|Qs], Bs, Ieval) -> CompFun = fun(NewBs) -> eval_lc1(E, Qs, NewBs, Ieval) end, - eval_generate(L1, P, Bs1, CompFun, Ieval); -eval_lc1(E, [{b_generate,Line,P,L0}|Qs], Bs0, Ieval0) -> - Ieval = Ieval0#ieval{line=Line}, - {value,Bin,_} = expr(L0, Bs0, Ieval#ieval{top=false}), - CompFun = fun(NewBs) -> eval_lc1(E, Qs, NewBs, Ieval) end, - eval_b_generate(Bin, P, Bs0, CompFun, Ieval); + eval_generator(G, Bs, CompFun, Ieval); eval_lc1(E, [{guard,Q}|Qs], Bs0, Ieval) -> case guard(Q, Bs0) of true -> eval_lc1(E, Qs, Bs0, Ieval); @@ -1123,16 +1164,9 @@ eval_bc(E, Qs, Bs, Ieval) -> Val = erlang:list_to_bitstring(eval_bc1(E, Qs, Bs, Ieval)), {value,Val,Bs}. -eval_bc1(E, [{generate,Line,P,L0}|Qs], Bs0, Ieval0) -> - Ieval = Ieval0#ieval{line=Line}, - {value,L1,Bs1} = expr(L0, Bs0, Ieval#ieval{top=false}), - CompFun = fun(NewBs) -> eval_bc1(E, Qs, NewBs, Ieval) end, - eval_generate(L1, P, Bs1, CompFun, Ieval); -eval_bc1(E, [{b_generate,Line,P,L0}|Qs], Bs0, Ieval0) -> - Ieval = Ieval0#ieval{line=Line}, - {value,Bin,_} = expr(L0, Bs0, Ieval#ieval{top=false}), +eval_bc1(E, [{generator,G}|Qs], Bs, Ieval) -> CompFun = fun(NewBs) -> eval_bc1(E, Qs, NewBs, Ieval) end, - eval_b_generate(Bin, P, Bs0, CompFun, Ieval); + eval_generator(G, Bs, CompFun, Ieval); eval_bc1(E, [{guard,Q}|Qs], Bs0, Ieval) -> case guard(Q, Bs0) of true -> eval_bc1(E, Qs, Bs0, Ieval); @@ -1148,6 +1182,56 @@ eval_bc1(E, [], Bs, Ieval) -> {value,V,_} = expr(E, Bs, Ieval#ieval{top=false}), [V]. +eval_mc(E, Qs, Bs, Ieval) -> + Map = eval_mc1(E, Qs, Bs, Ieval), + {value,maps:from_list(Map),Bs}. + +eval_mc1(E, [{generator,G}|Qs], Bs, Ieval) -> + CompFun = fun(NewBs) -> eval_mc1(E, Qs, NewBs, Ieval) end, + eval_generator(G, Bs, CompFun, Ieval); +eval_mc1(E, [{guard,Q}|Qs], Bs0, Ieval) -> + case guard(Q, Bs0) of + true -> eval_mc1(E, Qs, Bs0, Ieval); + false -> [] + end; +eval_mc1(E, [Q|Qs], Bs0, Ieval) -> + case expr(Q, Bs0, Ieval#ieval{top=false}) of + {value,true,Bs} -> eval_mc1(E, Qs, Bs, Ieval); + {value,false,_Bs} -> []; + {value,V,Bs} -> exception(error, {bad_filter,V}, Bs, Ieval) + end; +eval_mc1({map_field_assoc,_,K0,V0}, [], Bs, Ieval) -> + {value,K,_} = expr(K0, Bs, Ieval#ieval{top=false}), + {value,V,_} = expr(V0, Bs, Ieval#ieval{top=false}), + [{K,V}]. + +eval_generator({generate,Line,P,L0}, Bs0, CompFun, Ieval0) -> + Ieval = Ieval0#ieval{line=Line}, + {value,L1,Bs1} = expr(L0, Bs0, Ieval#ieval{top=false}), + eval_generate(L1, P, Bs1, CompFun, Ieval); +eval_generator({b_generate,Line,P,Bin0}, Bs0, CompFun, Ieval0) -> + Ieval = Ieval0#ieval{line=Line}, + {value,Bin,Bs1} = expr(Bin0, Bs0, Ieval#ieval{top=false}), + eval_b_generate(Bin, P, Bs1, CompFun, Ieval); +eval_generator({m_generate,Line,P,Map0}, Bs0, CompFun, Ieval0) -> + Ieval = Ieval0#ieval{line=Line}, + {map_field_exact,_,K,V} = P, + {value,Map,_Bs1} = expr(Map0, Bs0, Ieval), + Iter = case is_map(Map) of + true -> + maps:iterator(Map); + false -> + %% Validate iterator. + try maps:foreach(fun(_, _) -> ok end, Map) of + _ -> + Map + catch + _:_ -> + exception(error, {bad_generator,Map}, Bs0, Ieval) + end + end, + eval_m_generate(Iter, {tuple,Line,[K,V]}, Bs0, CompFun, Ieval). + eval_generate([V|Rest], P, Bs0, CompFun, Ieval) -> case catch match1(P, V, erl_eval:new_bindings(), Bs0) of {match,Bsn} -> @@ -1176,6 +1260,20 @@ eval_b_generate(<<_/bitstring>>=Bin, P, Bs0, CompFun, Ieval) -> eval_b_generate(Term, _P, Bs, _CompFun, Ieval) -> exception(error, {bad_generator,Term}, Bs, Ieval). +eval_m_generate(Iter0, P, Bs0, CompFun, Ieval) -> + case maps:next(Iter0) of + {K,V,Iter} -> + case catch match1(P, {K,V}, erl_eval:new_bindings(), Bs0) of + {match,Bsn} -> + Bs2 = add_bindings(Bsn, Bs0), + CompFun(Bs2) ++ eval_m_generate(Iter, P, Bs0, CompFun, Ieval); + nomatch -> + eval_m_generate(Iter, P, Bs0, CompFun, Ieval) + end; + none -> + [] + end. + safe_bif(M, F, As, Bs, Ieval0) -> try apply(M, F, As) of Value -> @@ -1479,6 +1577,9 @@ guard_expr({'orelse',_,E1,E2}, Bs) -> {value,_Val}=Res -> Res end end; +guard_expr({'case',_,E0,Cs}, Bs) -> + {value,E} = guard_expr(E0, Bs), + guard_case_clauses(E, Cs, Bs); guard_expr({dbg,_,self,[]}, _) -> {value,get(self)}; guard_expr({safe_bif,_,erlang,'not',As0}, Bs) -> @@ -1518,9 +1619,23 @@ guard_expr({bin,_,Flds}, Bs) -> fun(E,B) -> {value,V} = guard_expr(E,B), {value,V,B} - end, [], false), + end), {value,V}. +%% guard_case_clauses(Value, Clauses, Bindings, Error, Ieval) +%% Error = try_clause | case_clause +guard_case_clauses(Val, [{clause,_,[P],G,B}|Cs], Bs0) -> + case match(P, Val, Bs0) of + {match,Bs} -> + case guard(G, Bs) of + true -> + guard_expr(hd(B), Bs); + false -> + guard_case_clauses(Val, Cs, Bs0) + end; + nomatch -> + guard_case_clauses(Val, Cs, Bs0) + end. %% eval_map_fields([Field], Bindings, IEvalState) -> %% {[{map_assoc | map_exact,Key,Value}],Bindings} @@ -1597,8 +1712,7 @@ match1({map,_,Fields}, Map, Bs, BBs) when is_map(Map) -> match1({bin,_,Fs}, B, Bs0, BBs) when is_bitstring(B) -> try eval_bits:match_bits(Fs, B, Bs0, BBs, match_fun(BBs), - fun(E, Bs) -> expr(E, Bs, #ieval{}) end, - false) + fun(E, Bs) -> expr(E, Bs, #ieval{}) end) catch _:_ -> throw(nomatch) end; diff --git a/debugger/erlide_debugger_24/src/dbg_ieval.hrl b/debugger/erlide_debugger_26/src/dbg_ieval.hrl similarity index 100% rename from debugger/erlide_debugger_24/src/dbg_ieval.hrl rename to debugger/erlide_debugger_26/src/dbg_ieval.hrl diff --git a/debugger/erlide_debugger_24/src/dbg_iload.erl b/debugger/erlide_debugger_26/src/dbg_iload.erl similarity index 95% rename from debugger/erlide_debugger_24/src/dbg_iload.erl rename to debugger/erlide_debugger_26/src/dbg_iload.erl index 888de26..d185d6b 100644 --- a/debugger/erlide_debugger_24/src/dbg_iload.erl +++ b/debugger/erlide_debugger_26/src/dbg_iload.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2022. All Rights Reserved. +%% Copyright Ericsson AB 1998-2023. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -512,6 +512,13 @@ expr({'receive',Anno,Cs0,To0,ToEs0}, Lc, St) -> ToEs1 = exprs(ToEs0, Lc, St), Cs1 = icr_clauses(Cs0, Lc, St), {'receive',ln(Anno),Cs1,To1,ToEs1}; +expr({'maybe',Anno,Es0}, Lc, St) -> + Es1 = exprs(Es0, Lc, St), + {'maybe',ln(Anno),Es1}; +expr({'maybe',Anno,Es0,{'else',_ElseAnno,Cs0}}, Lc, St) -> + Es1 = exprs(Es0, Lc, St), + Cs1 = icr_clauses(Cs0, Lc, St), + {'maybe',ln(Anno),Es1,Cs1}; expr({'fun',Anno,{clauses,Cs0}}, _Lc, St) -> %% New R10B-2 format (abstract_v2). Cs = fun_clauses(Cs0, St), @@ -612,13 +619,19 @@ expr({'try',Anno,Es0,CaseCs0,CatchCs0,As0}, Lc, St) -> As = expr_list(As0, St), {'try',ln(Anno),Es,CaseCs,CatchCs,As}; expr({lc,_,_,_}=Compr, _Lc, St) -> - expr_lc_bc(Compr, St); + expr_comprehension(Compr, St); expr({bc,_,_,_}=Compr, _Lc, St) -> - expr_lc_bc(Compr, St); + expr_comprehension(Compr, St); +expr({mc,_,_,_}=Compr, _Lc, St) -> + expr_comprehension(Compr, St); expr({match,Anno,P0,E0}, _Lc, St) -> E1 = expr(E0, false, St), P1 = pattern(P0, St), {match,ln(Anno),P1,E1}; +expr({maybe_match,Anno,P0,E0}, _Lc, St) -> + E1 = expr(E0, false, St), + P1 = pattern(P0, St), + {maybe_match,ln(Anno),P1,E1}; expr({op,Anno,Op,A0}, _Lc, St) -> A1 = expr(A0, false, St), {op,ln(Anno),Op,[A1]}; @@ -649,7 +662,11 @@ expr({bin_element,Anno,Expr0,Size0,Type0}, _Lc, St) -> {Size1,Type} = make_bit_type(Anno, Size0, Type0), Expr = expr(Expr0, false, St), Size = expr(Size1, false, St), - {bin_element,ln(Anno),Expr,Size,Type}. + {bin_element,ln(Anno),Expr,Size,Type}; +expr({map_field_assoc,L,K0,V0}, _Lc, St) -> + K = expr(K0, false, St), + V = expr(V0, false, St), + {map_field_assoc,L,K,V}. consify([A|As]) -> {cons,0,A,consify(As)}; @@ -665,19 +682,27 @@ make_bit_type(_Line, Size, Type0) -> %Integer or 'all' {ok,Size,Bt} = erl_bits:set_bit_type(Size, Type0), {Size,erl_bits:as_list(Bt)}. -expr_lc_bc({Tag,Anno,E0,Gs0}, St) -> - Gs = lists:map(fun ({generate,L,P0,Qs}) -> - {generate,L,pattern(P0, St),expr(Qs, false, St)}; - ({b_generate,L,P0,Qs}) -> %R12. - {b_generate,L,pattern(P0, St),expr(Qs, false, St)}; - (Expr) -> - case is_guard_test(Expr, St) of - true -> {guard,guard([[Expr]], St)}; - false -> expr(Expr, false, St) - end - end, Gs0), +expr_comprehension({Tag,Anno,E0,Gs0}, St) -> + Gs = [case G of + ({generate,L,P0,Qs}) -> + {generator,{generate,L,pattern(P0, St),expr(Qs, false, St)}}; + ({b_generate,L,P0,Qs}) -> %R12. + {generator,{b_generate,L,pattern(P0, St),expr(Qs, false, St)}}; + ({m_generate,L,P0,Qs}) -> %OTP 26 + {generator,{m_generate,L,mc_pattern(P0, St),expr(Qs, false, St)}}; + (Expr) -> + case is_guard_test(Expr, St) of + true -> {guard,guard([[Expr]], St)}; + false -> expr(Expr, false, St) + end + end || G <- Gs0], {Tag,ln(Anno),expr(E0, false, St),Gs}. +mc_pattern({map_field_exact,L,KeyP0,ValP0}, St) -> + KeyP1 = pattern(KeyP0, St), + ValP1 = pattern(ValP0, St), + {map_field_exact,L,KeyP1,ValP1}. + is_guard_test(Expr, #{ctype:=Ctypes}) -> IsOverridden = fun(NA) -> case maps:get(NA, Ctypes, undefined) of @@ -901,7 +926,7 @@ record_pattern(_, _, _, _, _, Acc) -> lists:reverse(Acc). %% The debugger converts both strings "abc" and lists [67, 68, 69] %% into {value, Line, [67, 68, 69]}, making it impossible to later -%% distingish one or the other inside binaries when evaluating. To +%% distinguish one or the other inside binaries when evaluating. To %% avoid <<[67, 68, 69]>> from evaluating, we convert strings into %% chars to avoid the ambiguity. bin_expand_strings(Es) -> diff --git a/debugger/erlide_debugger_24/src/dbg_iserver.erl b/debugger/erlide_debugger_26/src/dbg_iserver.erl similarity index 100% rename from debugger/erlide_debugger_24/src/dbg_iserver.erl rename to debugger/erlide_debugger_26/src/dbg_iserver.erl diff --git a/debugger/erlide_debugger_24/src/dbg_istk.erl b/debugger/erlide_debugger_26/src/dbg_istk.erl similarity index 96% rename from debugger/erlide_debugger_24/src/dbg_istk.erl rename to debugger/erlide_debugger_26/src/dbg_istk.erl index 49283fe..67bf537 100644 --- a/debugger/erlide_debugger_24/src/dbg_istk.erl +++ b/debugger/erlide_debugger_26/src/dbg_istk.erl @@ -24,7 +24,9 @@ bindings/1,stack_frame/2,backtrace/2, in_use_p/2]). +%% erlide patch ------------------------------------------------------ -export([all_frames/0, all_frames/1, all_modules_on_stack/0]). +%% erlide patch ------------------------------------------------------ -include("dbg_ieval.hrl"). @@ -52,6 +54,7 @@ from_external({stack,Stk}) -> init(Stack) -> put(?STACK, Stack). +%% erlide patch ------------------------------------------------------ all_frames() -> all_frames(get(?STACK)). @@ -73,6 +76,7 @@ all_modules_on_stack(Stack) -> args2arity(As) when is_list(As) -> length(As). +%% erlide patch ------------------------------------------------------ %% We keep track of a call stack that is used for %% 1) saving stack frames that can be inspected from an Attached diff --git a/debugger/erlide_debugger_23/src/erlide_debugger_23.app.src b/debugger/erlide_debugger_26/src/erlide_debugger_26.app.src similarity index 54% rename from debugger/erlide_debugger_23/src/erlide_debugger_23.app.src rename to debugger/erlide_debugger_26/src/erlide_debugger_26.app.src index f8e8f31..a5be471 100644 --- a/debugger/erlide_debugger_23/src/erlide_debugger_23.app.src +++ b/debugger/erlide_debugger_26/src/erlide_debugger_26.app.src @@ -1,7 +1,7 @@ -{application, erlide_debugger_23, +{application, erlide_debugger_26, [ - {description, "erlide_debugger_23"}, - {vsn, "5.0"}, + {description, "erlide_debugger_26"}, + {vsn, "0.118.0"}, {erlide_context, debugger}, {registered, []}, {applications, [kernel, stdlib]}, diff --git a/debugger/erlide_debugger_24/src/int.erl b/debugger/erlide_debugger_26/src/int.erl similarity index 99% rename from debugger/erlide_debugger_24/src/int.erl rename to debugger/erlide_debugger_26/src/int.erl index bb39d5f..ed56212 100644 --- a/debugger/erlide_debugger_24/src/int.erl +++ b/debugger/erlide_debugger_26/src/int.erl @@ -266,9 +266,11 @@ first_lines(Clauses) -> first_line({clause,_L,_Vars,_,Exprs}) -> first_line(Exprs); +%% erlide patch ------------------------------------------------------ %% Common Test adaptation first_line([{call_remote,0,ct_line,line,_As}|Exprs]) -> first_line(Exprs); +%% erlide patch ------------------------------------------------------ first_line([Expr|_Exprs]) -> % Expr = {Op, Line, ..varying no of args..} element(2, Expr). diff --git a/debugger/erlide_debugger_24/build b/debugger/erlide_debugger_27/build similarity index 64% rename from debugger/erlide_debugger_24/build rename to debugger/erlide_debugger_27/build index 3ad6e9e..c363823 100755 --- a/debugger/erlide_debugger_24/build +++ b/debugger/erlide_debugger_27/build @@ -5,4 +5,4 @@ source ../../build_utils.sh dir=`pwd` prj=`basename $dir` -build_project ../../rebar3 $prj 24 "$@" +build_project ../../rebar3 $prj 27 "$@" diff --git a/debugger/erlide_debugger_24/include/.keep b/debugger/erlide_debugger_27/include/.keep similarity index 100% rename from debugger/erlide_debugger_24/include/.keep rename to debugger/erlide_debugger_27/include/.keep diff --git a/debugger/erlide_debugger_24/priv/.keep b/debugger/erlide_debugger_27/priv/.keep similarity index 100% rename from debugger/erlide_debugger_24/priv/.keep rename to debugger/erlide_debugger_27/priv/.keep diff --git a/debugger/erlide_debugger_23/rebar.config b/debugger/erlide_debugger_27/rebar.config similarity index 94% rename from debugger/erlide_debugger_23/rebar.config rename to debugger/erlide_debugger_27/rebar.config index ca51233..2684deb 100644 --- a/debugger/erlide_debugger_23/rebar.config +++ b/debugger/erlide_debugger_27/rebar.config @@ -1,4 +1,4 @@ -{require_otp_vsn, "23.*"}. +{require_otp_vsn, "27.*"}. {plugins, []}. diff --git a/debugger/erlide_debugger_24/rebar.lock b/debugger/erlide_debugger_27/rebar.lock similarity index 100% rename from debugger/erlide_debugger_24/rebar.lock rename to debugger/erlide_debugger_27/rebar.lock diff --git a/debugger/erlide_debugger_24/src/dbg_debugged.erl b/debugger/erlide_debugger_27/src/dbg_debugged.erl similarity index 97% rename from debugger/erlide_debugger_24/src/dbg_debugged.erl rename to debugger/erlide_debugger_27/src/dbg_debugged.erl index 5296b8d..d48a235 100644 --- a/debugger/erlide_debugger_24/src/dbg_debugged.erl +++ b/debugger/erlide_debugger_27/src/dbg_debugged.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2018. All Rights Reserved. +%% Copyright Ericsson AB 1998-2024. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -17,6 +17,7 @@ %% %% %CopyrightEnd% -module(dbg_debugged). +-moduledoc false. %% External exports -export([eval/3]). diff --git a/debugger/erlide_debugger_24/src/dbg_icmd.erl b/debugger/erlide_debugger_27/src/dbg_icmd.erl similarity index 92% rename from debugger/erlide_debugger_24/src/dbg_icmd.erl rename to debugger/erlide_debugger_27/src/dbg_icmd.erl index b3e06c4..984a7d7 100644 --- a/debugger/erlide_debugger_24/src/dbg_icmd.erl +++ b/debugger/erlide_debugger_27/src/dbg_icmd.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2018. All Rights Reserved. +%% Copyright Ericsson AB 1998-2024. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -18,6 +18,7 @@ %% %CopyrightEnd% %% -module(dbg_icmd). +-moduledoc false. %% Internal command receiver/handler -export([cmd/3]). @@ -26,10 +27,13 @@ -export([step/1, next/1, continue/1, finish/1, skip/1, timeout/1, stop/1]). -export([eval/2]). --export([set_variable_value/4]). -export([set/3, get/3]). -export([handle_msg/4]). +%% erlide patch ------------------------------------------------------ +-export([set_variable_value/4]). +%% erlide patch ------------------------------------------------------ + %% Library functions for attached process handling -export([tell_attached/1]). @@ -51,9 +55,11 @@ %% specifies if the process should break. %%-------------------------------------------------------------------- +%% erlide patch ------------------------------------------------------ %% Common Test adaptation cmd({call_remote,0,ct_line,line,_As}, Bs, _Ieval) -> Bs; +%% erlide patch ------------------------------------------------------ cmd(Expr, Bs, Ieval) -> cmd(Expr, Bs, get(next_break), Ieval). @@ -186,6 +192,7 @@ timeout(Meta) -> Meta ! {user, timeout}. stop(Meta) -> Meta ! {user, {cmd, stop}}. +%% erlide patch ------------------------------------------------------ set_variable_value(Meta, Variable, Value, SP) -> eval(Meta, {no_module, Variable++"="++Value, SP}), receive @@ -194,7 +201,7 @@ set_variable_value(Meta, Variable, Value, SP) -> after 5000 -> {error, timeout} end. - +%% erlide patch ------------------------------------------------------ eval(Meta, {Mod, Cmd}) -> eval(Meta, {Mod, Cmd, nostack}); @@ -306,7 +313,8 @@ handle_int_msg({break_options, Break}, _Status, _Bs, _Ieval) -> handle_int_msg(no_break, _Status, _Bs, _Ieval) -> put(breakpoints, []); handle_int_msg({no_break,M}, _Status, _Bs, _Ieval) -> - put(breakpoints, [ML || {Mod,_L}=ML <- get(breakpoints), Mod=/=M]); + put(breakpoints, [B || {{Mod,_L},_Flags}=B <- get(breakpoints), + Mod =/= M]); handle_int_msg(stop, exit_at, _Bs, _Ieval) -> erlang:exit(normal). @@ -351,10 +359,12 @@ handle_user_msg({set,trace,Bool}, _Status, _Bs, _Ieval) -> tell_attached({trace, Bool}); handle_user_msg({set,stack_trace,Flag}, _Status, _Bs, _Ieval) -> set_stack_trace(Flag); -handle_user_msg({get, all_stack_frames, From, _}, _Status, Bs, _Ieval) -> +%% erlide patch ------------------------------------------------------ +handle_user_msg({get,all_stack_frames,From,_}, _Status, Bs, _Ieval) -> reply(From, all_stack_frames, {all_frames(), Bs}); -handle_user_msg({get, all_modules_on_stack, From, _}, _Status, _Bs, _Ieval) -> +handle_user_msg({get,all_modules_on_stack,From,_}, _Status, _Bs, _Ieval) -> reply(From, all_modules_on_stack, all_modules_on_stack()); +%% erlide patch ------------------------------------------------------ handle_user_msg({get,bindings,From,SP}, _Status, Bs, _Ieval) -> reply(From, bindings, bindings(Bs, SP)); handle_user_msg({get,stack_frame,From,{Dir,SP}}, _Status, _Bs,_Ieval) -> @@ -364,11 +374,13 @@ handle_user_msg({get,messages,From,_}, _Status, _Bs, _Ieval) -> handle_user_msg({get,backtrace,From,N}, _Status, _Bs, Ieval) -> reply(From, backtrace, dbg_istk:backtrace(N, Ieval)). +%% erlide patch ------------------------------------------------------ all_modules_on_stack() -> dbg_istk:all_modules_on_stack(). all_frames() -> dbg_ieval:all_frames(). +%% erlide patch ------------------------------------------------------ set_stack_trace(true) -> set_stack_trace(all); @@ -407,19 +419,14 @@ eval_restricted({From,_Mod,Cmd,SP}, Bs) -> case catch parse_cmd(Cmd, 1) of {'EXIT', _Reason} -> From ! {self(), {eval_rsp, 'Parse error'}}; - {[{var,_,Var}], XBs} -> + [{var,_,Var}] -> Bs2 = bindings(Bs, SP), Res = case get_binding(Var, Bs2) of {value, Value} -> Value; - unbound -> - case get_binding(Var, XBs) of - {value, _} -> - 'Only possible to inspect variables'; - unbound -> unbound - end + unbound -> unbound end, From ! {self(), {eval_rsp, Res}}; - {_Forms, _XBs} -> + _Forms -> Rsp = 'Only possible to inspect variables', From ! {self(), {eval_rsp, Rsp}} end. @@ -434,18 +441,17 @@ eval_nonrestricted({From, _Mod, Cmd, _SP}, Bs, {'EXIT', _Reason} -> From ! {self(), {eval_rsp, 'Parse error'}}, Bs; - {Forms, XBs} -> + Forms -> mark_running(Line, Le), - Bs1 = merge_bindings(Bs, XBs), - {Res, Bs2} = + {Res, Bs1} = lists:foldl(fun(Expr, {_Res, Bs0}) -> eval_nonrestricted_1(Expr,Bs0,Ieval) end, - {null, Bs1}, + {null, Bs}, Forms), mark_break(M, Line, Le), From ! {self(), {eval_rsp, Res}}, - remove_binding_structs(Bs2, XBs) + Bs1 end. eval_nonrestricted_1({match,_,{var,_,Var},Expr}, Bs, Ieval) -> @@ -470,14 +476,6 @@ eval_expr(Expr, Bs, Ieval) -> dbg_ieval:eval_expr(Expr, Bs, Ieval#ieval{top=false}), {Res,Bs2}. -%% XBs have unique keys. -merge_bindings(Bs1, XBs) -> - Bs1 ++ erl_eval:bindings(XBs). - -remove_binding_structs(Bs1, XBs) -> - lists:foldl(fun({N, _V}, Bs) -> lists:keydelete(N, 1, Bs) - end, Bs1, erl_eval:bindings(XBs)). - mark_running(LineNo, Le) -> put(next_break, running), put(user_eval, [{LineNo, Le} | get(user_eval)]), @@ -492,8 +490,8 @@ mark_break(Cm, LineNo, Le) -> parse_cmd(Cmd, LineNo) -> {ok,Tokens,_} = erl_scan:string(Cmd, LineNo, [text]), - {ok,Forms,Bs} = erl_eval:extended_parse_exprs(Tokens), - {Forms, Bs}. + {ok,Forms} = erl_eval:extended_parse_exprs(Tokens), + Forms. %%==================================================================== %% Library functions for attached process handling diff --git a/debugger/erlide_debugger_24/src/dbg_idb.erl b/debugger/erlide_debugger_27/src/dbg_idb.erl similarity index 95% rename from debugger/erlide_debugger_24/src/dbg_idb.erl rename to debugger/erlide_debugger_27/src/dbg_idb.erl index 55177bb..7afaebf 100644 --- a/debugger/erlide_debugger_24/src/dbg_idb.erl +++ b/debugger/erlide_debugger_27/src/dbg_idb.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2016. All Rights Reserved. +%% Copyright Ericsson AB 1998-2024. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -18,6 +18,7 @@ %% %CopyrightEnd% %% -module(dbg_idb). +-moduledoc false. %% External exports -export([insert/3, lookup/2, match_object/2]). diff --git a/debugger/erlide_debugger_23/src/dbg_ieval.erl b/debugger/erlide_debugger_27/src/dbg_ieval.erl similarity index 85% rename from debugger/erlide_debugger_23/src/dbg_ieval.erl rename to debugger/erlide_debugger_27/src/dbg_ieval.erl index 121a2e7..388819b 100644 --- a/debugger/erlide_debugger_23/src/dbg_ieval.erl +++ b/debugger/erlide_debugger_27/src/dbg_ieval.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2018. All Rights Reserved. +%% Copyright Ericsson AB 1998-2024. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -18,11 +18,15 @@ %% %CopyrightEnd% %% -module(dbg_ieval). +-moduledoc false. -export([eval/3,exit_info/5]). -export([eval_expr/3]). -export([check_exit_msg/3,exception/4]). + +%% erlide patch ------------------------------------------------------ -export([all_frames/0]). +%% erlide patch ------------------------------------------------------ -include("dbg_ieval.hrl"). @@ -74,29 +78,39 @@ exit_info(Int, AttPid, OrigPid, Reason, ExitInfo) -> {{Mod,Line},Bs,S} -> dbg_istk:from_external(S), Le = dbg_istk:stack_level(), +%% erlide patch ------------------------------------------------------ + %% dbg_icmd:tell_attached({exit_at, {Mod, Line}, Reason, Le}), dbg_icmd:tell_attached({exit_at, {Mod, Line}, Reason, Le, OrigPid, dbg_istk:all_frames(S), Bs}), +%% erlide patch ------------------------------------------------------ exit_loop(OrigPid, Reason, Bs,#ieval{module=Mod,line=Line}); {} -> dbg_istk:init(), +%% erlide patch ------------------------------------------------------ + %% dbg_icmd:tell_attached({exit_at, null, Reason, 1}), dbg_icmd:tell_attached({exit_at, null, Reason, 1, OrigPid}), +%% erlide patch ------------------------------------------------------ exit_loop(OrigPid, Reason, erl_eval:new_bindings(),#ieval{}) end. +%% erlide patch ------------------------------------------------------ all_frames() -> {dbg_istk:all_frames(), []}. +%% erlide patch ------------------------------------------------------ %%-------------------------------------------------------------------- %% eval_expr(Expr, Bs, Ieval) -> {value, Value, Bs} %% -%% Evalute a shell expression in the real process. +%% Evaluate a shell expression in the real process. %% Called (dbg_icmd) in response to a user request. %%-------------------------------------------------------------------- -eval_expr(Expr, Bs, Ieval) -> +eval_expr(Expr0, Bs, Ieval) -> %% Save current exit info ExitInfo = get(exit_info), Stacktrace = get(stacktrace), + Expr = expand_records(Expr0, Ieval#ieval.module), + %% Emulate a surrounding catch try debugged_cmd({eval,Expr,Bs}, Bs, Ieval) catch @@ -231,6 +245,8 @@ meta(Int, Debugged, M, F, As) -> put(trace, false), % bool() Trace on/off put(user_eval, []), + Session = trace:session_create(debugger, self(), []), + put(trace_session, Session), %% Send the result of the meta process Ieval = #ieval{}, @@ -268,7 +284,7 @@ meta_loop(Debugged, Bs, #ieval{level=Le} = Ieval) -> end, do_exception(Class, Reason, MakeStk, Bs, Ieval); - %% Error must have occured within a re-entry to + %% Error must have occurred within a re-entry to %% interpreted code, simply raise the exception _ -> erlang:Class(Reason) @@ -462,10 +478,12 @@ do_eval_function(Mod, Fun, As0, Bs0, _, Ieval0) when is_function(Fun); exception(error, Reason, Bs0, Ieval0) end; +%% erlide patch ------------------------------------------------------ %% Common Test adaptation do_eval_function(ct_line, line, As, Bs, extern, #ieval{level=Le}=Ieval) -> debugged_cmd({apply,ct_line,line,As}, Bs, Ieval#ieval{level=Le+1}), {value, ignore, Bs}; +%% erlide patch ------------------------------------------------------ do_eval_function(Mod, Name, As0, Bs0, Called, Ieval0) -> #ieval{level=Le,line=Li,top=Top} = Ieval0, @@ -627,8 +645,12 @@ seq([E|Es], Bs0, Ieval) -> {skip,Bs} -> seq(Es, Bs, Ieval); Bs1 -> - {value,_,Bs} = expr(E, Bs1, Ieval#ieval{top=false}), - seq(Es, Bs, Ieval) + case expr(E, Bs1, Ieval#ieval{top=false}) of + {value,_,Bs} -> + seq(Es, Bs, Ieval); + {bad_maybe_match,_}=Bad -> + Bad + end end; seq([], Bs, _) -> {value,true,Bs}. @@ -673,6 +695,16 @@ expr({map,Line,E0,Fs0}, Bs0, Ieval0) -> ({map_exact,K,V}, Mi) -> maps:update(K,V,Mi) end, E, Fs), {value,Value,merge_bindings(Bs2, Bs1, Ieval)}; + +%% Record update +expr({record_update,Line,Es},Bs,#ieval{level=Le}=Ieval0) -> + %% Incr Level, we don't need to step (next) through temp + %% variables creation and matching + Ieval = Ieval0#ieval{top=false, line=Line, level=Le+1}, + Seq = fun(E, {_, _, Bs1}) -> expr(E, Bs1, Ieval) end, + {value,Value,Bs1} = lists:foldl(Seq, {value, true, Bs}, Es), + {value,Value,remove_temporary_bindings(Bs1)}; + %% A block of statements expr({block,Line,Es},Bs,Ieval) -> seq(Es, Bs, Ieval#ieval{line=Line}); @@ -752,6 +784,24 @@ expr({'orelse',Line,E1,E2}, Bs0, Ieval) -> exception(error, {badarg,Val}, Bs, Ieval) end; +%% Maybe statement without else +expr({'maybe',Line,Es}, Bs, Ieval) -> + case seq(Es, Bs, Ieval#ieval{line=Line}) of + {bad_maybe_match,Val} -> + {value,Val,Bs}; + {value,_,_}=Other -> + Other + end; + +%% Maybe statement with else +expr({'maybe',Line,Es,Cs}, Bs, Ieval) -> + case seq(Es, Bs, Ieval#ieval{line=Line}) of + {bad_maybe_match,Val} -> + case_clauses(Val, Cs, Bs, else_clause, Ieval#ieval{line=Line}); + {value,_,_}=Other -> + Other + end; + %% Matching expression expr({match,Line,Lhs,Rhs0}, Bs0, Ieval0) -> Ieval = Ieval0#ieval{line=Line}, @@ -763,6 +813,17 @@ expr({match,Line,Lhs,Rhs0}, Bs0, Ieval0) -> exception(error, {badmatch,Rhs}, Bs1, Ieval) end; +%% Conditional match expression (?=) +expr({maybe_match,Line,Lhs,Rhs0}, Bs0, Ieval0) -> + Ieval = Ieval0#ieval{line=Line}, + {value,Rhs,Bs1} = expr(Rhs0, Bs0, Ieval#ieval{top=false}), + case match(Lhs, Rhs, Bs1) of + {match,Bs} -> + {value,Rhs,Bs}; + nomatch -> + {bad_maybe_match,Rhs} + end; + %% Construct a fun expr({make_fun,Line,Name,Cs}, Bs, #ieval{module=Module}=Ieval) -> Arity = length(element(3,hd(Cs))), @@ -896,10 +957,12 @@ expr({make_ext_fun,Line,MFA0}, Bs0, Ieval0) -> exception(error, badarg, Bs, Ieval, true) end; +%% erlide patch ------------------------------------------------------ %% Common test adaptation expr({call_remote,0,ct_line,line,As0,Lc}, Bs0, Ieval0) -> {As,_Bs} = eval_list(As0, Bs0, Ieval0), eval_function(ct_line, line, As, Bs0, extern, Ieval0, Lc); +%% erlide patch ------------------------------------------------------ %% Local function call expr({local_call,Line,F,As0,Lc}, Bs0, #ieval{module=M} = Ieval0) -> @@ -1045,9 +1108,7 @@ expr({bin,Line,Fs}, Bs0, Ieval0) -> Ieval = Ieval0#ieval{line=Line,top=false}, try eval_bits:expr_grp(Fs, Bs0, - fun (E, B) -> expr(E, B, Ieval) end, - [], - false) + fun (E, B) -> expr(E, B, Ieval) end) catch Class:Reason -> exception(Class, Reason, Bs0, Ieval) @@ -1058,6 +1119,8 @@ expr({lc,_Line,E,Qs}, Bs, Ieval) -> eval_lc(E, Qs, Bs, Ieval); expr({bc,_Line,E,Qs}, Bs, Ieval) -> eval_bc(E, Qs, Bs, Ieval); +expr({mc,_Line,E,Qs}, Bs, Ieval) -> + eval_mc(E, Qs, Bs, Ieval); %% Brutal exit on unknown expressions/clauses/values/etc. expr(E, _Bs, _Ieval) -> @@ -1078,16 +1141,9 @@ eval_named_fun(As, RF, {Info,Bs,Cs,FName}) -> eval_lc(E, Qs, Bs, Ieval) -> {value,eval_lc1(E, Qs, Bs, Ieval),Bs}. -eval_lc1(E, [{generate,Line,P,L0}|Qs], Bs0, Ieval0) -> - Ieval = Ieval0#ieval{line=Line}, - {value,L1,Bs1} = expr(L0, Bs0, Ieval#ieval{top=false}), - CompFun = fun(NewBs) -> eval_lc1(E, Qs, NewBs, Ieval) end, - eval_generate(L1, P, Bs1, CompFun, Ieval); -eval_lc1(E, [{b_generate,Line,P,L0}|Qs], Bs0, Ieval0) -> - Ieval = Ieval0#ieval{line=Line}, - {value,Bin,_} = expr(L0, Bs0, Ieval#ieval{top=false}), +eval_lc1(E, [{generator,G}|Qs], Bs, Ieval) -> CompFun = fun(NewBs) -> eval_lc1(E, Qs, NewBs, Ieval) end, - eval_b_generate(Bin, P, Bs0, CompFun, Ieval); + eval_generator(G, Bs, CompFun, Ieval); eval_lc1(E, [{guard,Q}|Qs], Bs0, Ieval) -> case guard(Q, Bs0) of true -> eval_lc1(E, Qs, Bs0, Ieval); @@ -1111,16 +1167,9 @@ eval_bc(E, Qs, Bs, Ieval) -> Val = erlang:list_to_bitstring(eval_bc1(E, Qs, Bs, Ieval)), {value,Val,Bs}. -eval_bc1(E, [{generate,Line,P,L0}|Qs], Bs0, Ieval0) -> - Ieval = Ieval0#ieval{line=Line}, - {value,L1,Bs1} = expr(L0, Bs0, Ieval#ieval{top=false}), - CompFun = fun(NewBs) -> eval_bc1(E, Qs, NewBs, Ieval) end, - eval_generate(L1, P, Bs1, CompFun, Ieval); -eval_bc1(E, [{b_generate,Line,P,L0}|Qs], Bs0, Ieval0) -> - Ieval = Ieval0#ieval{line=Line}, - {value,Bin,_} = expr(L0, Bs0, Ieval#ieval{top=false}), +eval_bc1(E, [{generator,G}|Qs], Bs, Ieval) -> CompFun = fun(NewBs) -> eval_bc1(E, Qs, NewBs, Ieval) end, - eval_b_generate(Bin, P, Bs0, CompFun, Ieval); + eval_generator(G, Bs, CompFun, Ieval); eval_bc1(E, [{guard,Q}|Qs], Bs0, Ieval) -> case guard(Q, Bs0) of true -> eval_bc1(E, Qs, Bs0, Ieval); @@ -1136,6 +1185,56 @@ eval_bc1(E, [], Bs, Ieval) -> {value,V,_} = expr(E, Bs, Ieval#ieval{top=false}), [V]. +eval_mc(E, Qs, Bs, Ieval) -> + Map = eval_mc1(E, Qs, Bs, Ieval), + {value,maps:from_list(Map),Bs}. + +eval_mc1(E, [{generator,G}|Qs], Bs, Ieval) -> + CompFun = fun(NewBs) -> eval_mc1(E, Qs, NewBs, Ieval) end, + eval_generator(G, Bs, CompFun, Ieval); +eval_mc1(E, [{guard,Q}|Qs], Bs0, Ieval) -> + case guard(Q, Bs0) of + true -> eval_mc1(E, Qs, Bs0, Ieval); + false -> [] + end; +eval_mc1(E, [Q|Qs], Bs0, Ieval) -> + case expr(Q, Bs0, Ieval#ieval{top=false}) of + {value,true,Bs} -> eval_mc1(E, Qs, Bs, Ieval); + {value,false,_Bs} -> []; + {value,V,Bs} -> exception(error, {bad_filter,V}, Bs, Ieval) + end; +eval_mc1({map_field_assoc,_,K0,V0}, [], Bs, Ieval) -> + {value,K,_} = expr(K0, Bs, Ieval#ieval{top=false}), + {value,V,_} = expr(V0, Bs, Ieval#ieval{top=false}), + [{K,V}]. + +eval_generator({generate,Line,P,L0}, Bs0, CompFun, Ieval0) -> + Ieval = Ieval0#ieval{line=Line}, + {value,L1,Bs1} = expr(L0, Bs0, Ieval#ieval{top=false}), + eval_generate(L1, P, Bs1, CompFun, Ieval); +eval_generator({b_generate,Line,P,Bin0}, Bs0, CompFun, Ieval0) -> + Ieval = Ieval0#ieval{line=Line}, + {value,Bin,Bs1} = expr(Bin0, Bs0, Ieval#ieval{top=false}), + eval_b_generate(Bin, P, Bs1, CompFun, Ieval); +eval_generator({m_generate,Line,P,Map0}, Bs0, CompFun, Ieval0) -> + Ieval = Ieval0#ieval{line=Line}, + {map_field_exact,_,K,V} = P, + {value,Map,_Bs1} = expr(Map0, Bs0, Ieval), + Iter = case is_map(Map) of + true -> + maps:iterator(Map); + false -> + %% Validate iterator. + try maps:foreach(fun(_, _) -> ok end, Map) of + _ -> + Map + catch + _:_ -> + exception(error, {bad_generator,Map}, Bs0, Ieval) + end + end, + eval_m_generate(Iter, {tuple,Line,[K,V]}, Bs0, CompFun, Ieval). + eval_generate([V|Rest], P, Bs0, CompFun, Ieval) -> case catch match1(P, V, erl_eval:new_bindings(), Bs0) of {match,Bsn} -> @@ -1164,12 +1263,31 @@ eval_b_generate(<<_/bitstring>>=Bin, P, Bs0, CompFun, Ieval) -> eval_b_generate(Term, _P, Bs, _CompFun, Ieval) -> exception(error, {bad_generator,Term}, Bs, Ieval). -safe_bif(M, F, As, Bs, Ieval) -> +eval_m_generate(Iter0, P, Bs0, CompFun, Ieval) -> + case maps:next(Iter0) of + {K,V,Iter} -> + case catch match1(P, {K,V}, erl_eval:new_bindings(), Bs0) of + {match,Bsn} -> + Bs2 = add_bindings(Bsn, Bs0), + CompFun(Bs2) ++ eval_m_generate(Iter, P, Bs0, CompFun, Ieval); + nomatch -> + eval_m_generate(Iter, P, Bs0, CompFun, Ieval) + end; + none -> + [] + end. + +safe_bif(M, F, As, Bs, Ieval0) -> try apply(M, F, As) of Value -> {value,Value,Bs} catch - Class:Reason -> + Class:Reason:Stk -> + [{_,_,_,Info}|_] = Stk, + Ieval = case lists:keyfind(error_info, 1, Info) of + false -> Ieval0#ieval{error_info=[]}; + ErrorInfo -> Ieval0#ieval{error_info=[ErrorInfo]} + end, exception(Class, Reason, Bs, Ieval, true) end. @@ -1189,8 +1307,8 @@ eval_receive(Debugged, Cs, Bs0, #ieval{module=M,line=Line,level=Le}=Ieval) -> %% To avoid private message passing protocol between META %% and interpreted process. - erlang:trace(Debugged,true,['receive']), - {_,Msgs} = erlang:process_info(Debugged,messages), + session_recv_trace(Debugged, true), + {_,Msgs} = erlang:process_info(Debugged, messages), case receive_clauses(Cs, Bs0, Msgs) of nomatch -> dbg_iserver:cast(get(int), {set_status, self(),waiting,{}}), @@ -1231,8 +1349,8 @@ eval_receive(Debugged, Cs, 0, ToExprs, ToBs, Bs0, 0, _Stamp, Ieval) -> end; eval_receive(Debugged, Cs, ToVal, ToExprs, ToBs, Bs0, 0, Stamp, #ieval{module=M,line=Line,level=Le}=Ieval)-> - erlang:trace(Debugged,true,['receive']), - {_,Msgs} = erlang:process_info(Debugged,messages), + session_recv_trace(Debugged, true), + {_,Msgs} = erlang:process_info(Debugged, messages), case receive_clauses(Cs, Bs0, Msgs) of nomatch -> {Stamp1,Time1} = newtime(Stamp,ToVal), @@ -1305,13 +1423,13 @@ newtime(Stamp,Time) -> end. rec_mess(Debugged, Msg, Bs, Ieval) -> - erlang:trace(Debugged, false, ['receive']), + session_recv_trace(Debugged, false), flush_traces(Debugged), Debugged ! {sys,self(),{'receive',Msg}}, rec_ack(Debugged, Bs, Ieval). rec_mess(Debugged) -> - erlang:trace(Debugged, false, ['receive']), + session_recv_trace(Debugged, false), flush_traces(Debugged). rec_mess_no_trace(Debugged, Msg, Bs, Ieval) -> @@ -1462,6 +1580,9 @@ guard_expr({'orelse',_,E1,E2}, Bs) -> {value,_Val}=Res -> Res end end; +guard_expr({'case',_,E0,Cs}, Bs) -> + {value,E} = guard_expr(E0, Bs), + guard_case_clauses(E, Cs, Bs); guard_expr({dbg,_,self,[]}, _) -> {value,get(self)}; guard_expr({safe_bif,_,erlang,'not',As0}, Bs) -> @@ -1501,9 +1622,23 @@ guard_expr({bin,_,Flds}, Bs) -> fun(E,B) -> {value,V} = guard_expr(E,B), {value,V,B} - end, [], false), + end), {value,V}. +%% guard_case_clauses(Value, Clauses, Bindings, Error, Ieval) +%% Error = try_clause | case_clause +guard_case_clauses(Val, [{clause,_,[P],G,B}|Cs], Bs0) -> + case match(P, Val, Bs0) of + {match,Bs} -> + case guard(G, Bs) of + true -> + guard_expr(hd(B), Bs); + false -> + guard_case_clauses(Val, Cs, Bs0) + end; + nomatch -> + guard_case_clauses(Val, Cs, Bs0) + end. %% eval_map_fields([Field], Bindings, IEvalState) -> %% {[{map_assoc | map_exact,Key,Value}],Bindings} @@ -1580,8 +1715,7 @@ match1({map,_,Fields}, Map, Bs, BBs) when is_map(Map) -> match1({bin,_,Fs}, B, Bs0, BBs) when is_bitstring(B) -> try eval_bits:match_bits(Fs, B, Bs0, BBs, match_fun(BBs), - fun(E, Bs) -> expr(E, Bs, #ieval{}) end, - false) + fun(E, Bs) -> expr(E, Bs, #ieval{}) end) catch _:_ -> throw(nomatch) end; @@ -1741,6 +1875,9 @@ add_binding(N,Val,[B1|Bs]) -> add_binding(N,Val,[]) -> [{N,Val}]. +remove_temporary_bindings(Bs0) -> + [{Var,Val} || {Var, Val} <- Bs0, hd(atom_to_list(Var)) =/= $%]. + %% get_stacktrace() -> Stacktrace %% Return the latest stacktrace for the process. get_stacktrace() -> @@ -1756,3 +1893,97 @@ get_stacktrace() -> Stk when is_list(Stk) -> Stk end. + +%%% eval record exprs +%%% copied from stdlib/src/shell.erl + +expand_records(Expr, Mod) -> + try + expand_records_1(used_record_defs(Expr, Mod), Expr) + catch _:_Err:_ST -> + Expr + end. + +expand_records_1([], Expr) -> + Expr; +expand_records_1(UsedRecords, Expr) -> + A = erl_anno:new(1), + RecordDefs = [{attribute, A, record, + {Name, [{record_field,A,{atom,A,F}} || F <- Fields]} + } || {Name,Fields} <- UsedRecords], + Forms0 = RecordDefs ++ [{function,A,foo,0,[{clause,A,[],[],[Expr]}]}], + Forms = erl_expand_records:module(Forms0, [strict_record_tests]), + {function,A,foo,0,[{clause,A,[],[],[NE]}]} = lists:last(Forms), + NE. + +used_record_defs(E, Mod) -> + case mod_recs(Mod) of + [] -> []; + Recs0 -> + Recs = [{Name, Fields} || {{_,_,Name,_}, Fields} <- Recs0], + L0 = used_record_defs(E, maps:from_list(Recs), [], []), + L1 = lists:zip(L0, lists:seq(1, length(L0))), + L2 = lists:keysort(2, lists:ukeysort(1, L1)), + [R || {R, _} <- L2] + end. + +used_record_defs(E, Recs, Skip, Used) -> + case used_records(E) of + {name,Name,E1} -> + case lists:member(Name, Skip) of + true -> + used_record_defs(E1, Recs, Skip, Used); + false -> + case maps:get(Name, Recs, undefined) of + undefined -> + used_record_defs(E1, Recs, [Name|Skip], Used); + Fields -> + used_record_defs(E1, Recs, [Name|Skip], [{Name, Fields}|Used]) + end + end; + {expr,[E1 | Es]} -> + used_record_defs(Es, Recs, Skip, used_record_defs(E1, Recs, Skip, Used)); + _ -> + Used + end. + +mod_recs(Mod) -> + case db_ref(Mod) of + not_found -> + []; + ModDb -> + dbg_idb:match_object(ModDb, {{record, Mod, '_', '_'}, '_'}) + end. + +used_records({record_index,_,Name,F}) -> + {name, Name, F}; +used_records({record,_,Name,Is}) -> + {name, Name, Is}; +used_records({record_field,_,R,Name,F}) -> + {name, Name, [R | F]}; +used_records({record,_,R,Name,Ups}) -> + {name, Name, [R | Ups]}; +used_records({record_field,_,R,F}) -> % illegal + {expr, [R | F]}; +used_records({call,_,{atom,_,record},[A,{atom,_,Name}]}) -> + {name, Name, A}; +used_records({call,_,{atom,_,is_record},[A,{atom,_,Name}]}) -> + {name, Name, A}; +used_records({call,_,{remote,_,{atom,_,erlang},{atom,_,is_record}}, + [A,{atom,_,Name}]}) -> + {name, Name, A}; +used_records({call,_,{atom,_,record_info},[A,{atom,_,Name}]}) -> + {name, Name, A}; +used_records({call,A,{tuple,_,[M,F]},As}) -> + used_records({call,A,{remote,A,M,F},As}); +used_records({type,_,record,[{atom,_,Name}|Fs]}) -> + {name, Name, Fs}; +used_records(T) when is_tuple(T) -> + {expr, tuple_to_list(T)}; +used_records(E) -> + {expr, E}. + +session_recv_trace(Subject, How) -> + Session = get(trace_session), + _ = trace:process(Session, Subject, How, ['receive']), + ok. diff --git a/debugger/erlide_debugger_23/src/dbg_ieval.hrl b/debugger/erlide_debugger_27/src/dbg_ieval.hrl similarity index 89% rename from debugger/erlide_debugger_23/src/dbg_ieval.hrl rename to debugger/erlide_debugger_27/src/dbg_ieval.hrl index ad422a9..990692c 100644 --- a/debugger/erlide_debugger_23/src/dbg_ieval.hrl +++ b/debugger/erlide_debugger_27/src/dbg_ieval.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2016. All Rights Reserved. +%% Copyright Ericsson AB 2005-2021. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -22,6 +22,7 @@ module, % MFA which called the currently function, % interpreted function arguments, % + error_info = [], % [{error_info,Map}] | [] %% True if the current expression is at the top level %% (i.e. the next call will leave interpreted code). diff --git a/debugger/erlide_debugger_27/src/dbg_iload.erl b/debugger/erlide_debugger_27/src/dbg_iload.erl new file mode 100644 index 0000000..aba270a --- /dev/null +++ b/debugger/erlide_debugger_27/src/dbg_iload.erl @@ -0,0 +1,1069 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2024. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(dbg_iload). +-moduledoc false. + +-export([load_mod/4]). + +%%==================================================================== +%% External exports +%%==================================================================== + +%%-------------------------------------------------------------------- +%% load_mod(Mod, File, Binary, Db) -> {ok, Mod} +%% Mod = module() +%% File = string() Source file (including path) +%% Binary = binary() +%% Db = ETS identifier +%% Load a new module into the database. +%% +%% We want the loading of a module to be synchronous so that no other +%% process tries to interpret code in a module not being completely +%% loaded. This is achieved as this function is called from +%% dbg_iserver. We are suspended until the module has been loaded. +%%-------------------------------------------------------------------- +-spec load_mod(Mod, file:filename(), binary(), ets:tid()) -> + {'ok', Mod} when Mod :: atom(). + +load_mod(Mod, File, Binary, Db) -> + Flag = process_flag(trap_exit, true), + Pid = spawn_link(load_mod1(Mod, File, Binary, Db)), + receive + {'EXIT', Pid, What} -> + process_flag(trap_exit, Flag), + What + end. + +-spec load_mod1(atom(), file:filename(), binary(), ets:tid()) -> + fun(() -> no_return()). + +load_mod1(Mod, File, Binary, Db) -> + fun() -> + store_module(Mod, File, Binary, Db), + exit({ok, Mod}) + end. + +%%==================================================================== +%% Internal functions +%%==================================================================== + +store_module(Mod, File, Binary, Db) -> + {interpreter_module, Exp, Abst, Src, MD5} = binary_to_term(Binary), + Forms0 = case abstr(Abst) of + {abstract_v1,_} -> + exit({Mod,too_old_beam_file}); + {abstract_v2,_} -> + exit({Mod,too_old_beam_file}); + {raw_abstract_v1,Code} -> + Code + end, + dbg_idb:insert(Db, mod_file, File), + dbg_idb:insert(Db, defs, []), + + put(vcount, 0), + put(fun_count, 0), + put(funs, []), + put(mod_md5, MD5), + + Forms1 = interpret_file_attribute(Forms0), + {Forms,Ctype} = standard_transforms(Forms1), + store_forms(Forms, Mod, Db, #{exp=>Exp, ctype => Ctype}), + + erase(mod_md5), + erase(current_function), + %% store_funs(Db, Mod), + erase(vcount), + erase(funs), + erase(fun_count), + + NewBinary = store_mod_line_no(Mod, Db, binary_to_list(Src)), + dbg_idb:insert(Db, mod_bin, NewBinary), + dbg_idb:insert(Db, mod_raw, <>). %% Add eos + +standard_transforms(Forms0) -> + Forms = erl_internal:add_predefined_functions(Forms0), + Ctype = init_calltype(Forms), + {Forms, Ctype}. + +init_calltype(Forms) -> + Locals = [{{Name,Arity},local} || {function,_,Name,Arity,_} <- Forms], + Ctype = maps:from_list(Locals), + init_calltype_imports(Forms, Ctype). + +init_calltype_imports([{attribute,_,import,{Mod,Fs}}|T], Ctype0) -> + true = is_atom(Mod), + Ctype = lists:foldl(fun(FA, Acc) -> + Acc#{FA=>{imported,Mod}} + end, Ctype0, Fs), + init_calltype_imports(T, Ctype); +init_calltype_imports([_|T], Ctype) -> + init_calltype_imports(T, Ctype); +init_calltype_imports([], Ctype) -> Ctype. + +%% Adjust line numbers using the file/2 attribute. +%% Also take the absolute value of line numbers. +%% This simple fix will make the marker point at the correct line +%% (assuming the file attributes are correct) in the source; it will +%% not point at code in included files. +interpret_file_attribute(Code) -> + epp:interpret_file_attribute(Code). + +abstr(Bin) when is_binary(Bin) -> binary_to_term(Bin); +abstr(Term) -> Term. + +% store_funs(Db, Mod) -> +% store_funs_1(get(funs), Db, Mod). + +% store_funs_1([{Name,Index,Uniq,_,_,Arity,Cs}|Fs], Db, Mod) -> +% dbg_idb:insert(Db, {Mod,Name,Arity,false}, Cs), +% dbg_idb:insert(Db, {'fun',Mod,Index,Uniq}, {Name,Arity,Cs}), +% store_funs_1(Fs, Db, Mod); +% store_funs_1([], _, _) -> ok. + +store_forms([{function,_,Name,Arity,Cs0}|Fs], Mod, Db, #{exp:=Exp} = St) -> + FA = {Name,Arity}, + put(current_function, FA), + Cs = clauses(Cs0,St), + Exported = lists:member(FA, Exp), + dbg_idb:insert(Db, {Mod,Name,Arity,Exported}, Cs), + store_forms(Fs, Mod, Db, St); +store_forms([{attribute,_,record,{Name,Defs}}|Fs], Mod, Db, St) -> + NDefs = normalise_rec_fields(Defs), + Fields = [F || {record_field, _, {atom, _, F}, _} <- NDefs], + dbg_idb:insert(Db, {record,Mod,Name,length(Fields)}, Fields), + Recs = maps:get(recs, St, #{}), + store_forms(Fs, Mod, Db, St#{recs => Recs#{Name => NDefs}}); +store_forms([{attribute,_,_Name,_Val}|Fs], Mod, Db, St) -> + store_forms(Fs, Mod, Db, St); +store_forms([_|Fs], Mod, Db, St) -> + %% Ignore other forms such as {eof,_} or {warning,_}. + store_forms(Fs, Mod, Db, St); +store_forms([], _, _, _) -> + ok. + +store_mod_line_no(Mod, Db, Contents) -> + store_mod_line_no(Mod, Db, Contents, 1, 0, []). + +store_mod_line_no(_, _, [], _, _, NewCont) -> + list_to_binary(lists:reverse(NewCont)); +store_mod_line_no(Mod, Db, Contents, LineNo, Pos, NewCont) when is_integer(LineNo) -> + {ContTail,Pos1,NewCont1} = store_line(Mod, Db, Contents, LineNo, Pos, NewCont), + store_mod_line_no(Mod, Db, ContTail, LineNo+1, Pos1, NewCont1). + +store_line(_, Db, Contents, LineNo, Pos, NewCont) -> + {ContHead,ContTail,PosNL} = get_nl(Contents,Pos+8,[]), + dbg_idb:insert(Db,LineNo,{Pos+8,PosNL}), + {ContTail,PosNL+1,[make_lineno(LineNo, 8, ContHead)|NewCont]}. + +make_lineno(N, P, Acc) -> + S = integer_to_list(N), + S ++ [$:|spaces(P-length(S)-1, Acc)]. + +spaces(P, Acc) when P > 0 -> + spaces(P-1, [$\s|Acc]); +spaces(_, Acc) -> Acc. + + +%% normalise_rec_fields([RecDef]) -> [Field]. +%% Normalise the field definitions to always have a default value. If +%% none has been given then use 'undefined'. + +normalise_rec_fields(Fs) -> + lists:map(fun ({record_field,Anno,Field}) -> + {record_field,Anno,Field,{atom,Anno,undefined}}; + ({typed_record_field,{record_field,Anno,Field},_Type}) -> + {record_field,Anno,Field,{atom,Anno,undefined}}; + ({typed_record_field,Field,_Type}) -> + Field; + (F) -> F + end, Fs). + +get_nl([10|T],Pos,Head) -> {lists:reverse([10|Head]),T,Pos}; +get_nl([H|T],Pos,Head) -> + get_nl(T,Pos+1,[H|Head]); +get_nl([],Pos,Head) -> {lists:reverse(Head),[],Pos}. + +%%% Rewrite the abstract syntax tree to that it will be easier (== faster) +%%% to interpret. + +clauses([C0|Cs],St) -> + C1 = clause(C0, true, St), + [C1|clauses(Cs, St)]; +clauses([], _St) -> []. + +clause({clause,Anno,H0,G0,B0}, Lc, St) -> + H1 = head(H0, St), + G1 = guard(G0, St), + B1 = exprs(B0, Lc, St), + {clause,ln(Anno),H1,G1,B1}. + +head(Ps, St) -> patterns(Ps, St). + +%% These patterns are processed "sequentially" for purposes of variable +%% definition etc. + +patterns([P0|Ps], St) -> + P1 = pattern(P0, St), + [P1|patterns(Ps, St)]; +patterns([], _St) -> []. + +%% N.B. Only valid patterns are included here. + +pattern({var,Anno,V}, _St) -> {var,ln(Anno),V}; +pattern({char,Anno,I}, _St) -> {value,ln(Anno),I}; +pattern({integer,Anno,I}, _St) -> {value,ln(Anno),I}; +pattern({match,Anno,Pat1,Pat2}, St) -> + {match,ln(Anno),pattern(Pat1, St),pattern(Pat2, St)}; +pattern({float,Anno,F}, _St) -> {value,ln(Anno),F}; +pattern({atom,Anno,A}, _St) -> {value,ln(Anno),A}; +pattern({string,Anno,S}, _St) -> {value,ln(Anno),S}; +pattern({nil,Anno}, _St) -> {value,ln(Anno),[]}; +pattern({cons,Anno,H0,T0}, St) -> + H1 = pattern(H0, St), + T1 = pattern(T0, St), + {cons,ln(Anno),H1,T1}; +pattern({tuple,Anno,Ps0}, St) -> + Ps1 = pattern_list(Ps0, St), + {tuple,ln(Anno),Ps1}; +pattern({record_index,Anno,Name,Field} = _DBG, St) -> + Expr = index_expr(Anno, Field, Name, record_fields(Name, Anno, St)), + pattern(Expr, St); +pattern({record,Anno,Name,Pfs}, St0) -> + Fs = record_fields(Name, Anno, St0), + TMs = pattern_list(pattern_fields(Fs, Pfs), St0), + {tuple,ln(Anno),[{value,ln(Anno),Name} | TMs]}; +pattern({map,Anno,Fs0}, St) -> + Fs1 = lists:map(fun ({map_field_exact,L,K,V}) -> + {map_field_exact,L,gexpr(K, St),pattern(V, St)} + end, Fs0), + {map,ln(Anno),Fs1}; +pattern({op,_,'-',{integer,Anno,I}}, _St) -> + {value,ln(Anno),-I}; +pattern({op,_,'+',{integer,Anno,I}}, _St) -> + {value,ln(Anno),I}; +pattern({op,_,'-',{char,Anno,I}}, _St) -> + {value,ln(Anno),-I}; +pattern({op,_,'+',{char,Anno,I}}, _St) -> + {value,ln(Anno),I}; +pattern({op,_,'-',{float,Anno,I}}, _St) -> + {value,ln(Anno),-I}; +pattern({op,_,'+',{float,Anno,I}}, _St) -> + {value,ln(Anno),I}; +pattern({bin,Anno,Grp}, St) -> + Grp1 = pattern_list(bin_expand_strings(Grp), St), + {bin,ln(Anno),Grp1}; +pattern({bin_element,Anno,Expr0,Size0,Type0}, St) -> + {Size1,Type} = make_bit_type(Anno, Size0, Type0), + Expr1 = pattern(Expr0,St), + Expr = coerce_to_float(Expr1, Type0), + Size = expr(Size1, false, St), + {bin_element,ln(Anno),Expr,Size,Type}; +%% Evaluate compile-time expressions. +pattern({op,_,'++',{nil,_},R}, St) -> + pattern(R, St); +pattern({op,_,'++',{cons,Li,H,T},R}, St) -> + pattern({cons,Li,H,{op,Li,'++',T,R}}, St); +pattern({op,_,'++',{string,Li,L},R}, St) -> + pattern(string_to_conses(Li, L, R), St); +pattern({op,_Line,_Op,_A}=Op, St) -> + pattern(erl_eval:partial_eval(Op), St); +pattern({op,_Line,_Op,_L,_R}=Op, St) -> + pattern(erl_eval:partial_eval(Op), St). + +string_to_conses(Anno, Cs, Tail) -> + lists:foldr(fun (C, T) -> {cons,Anno,{char,Anno,C},T} end, Tail, Cs). + +coerce_to_float({value,Anno,Int}=E, [float|_]) when is_integer(Int) -> + try + {value,Anno,float(Int)} + catch + error:badarg -> E + end; +coerce_to_float(E, _) -> E. + +%% These patterns are processed "in parallel" for purposes of variable +%% definition etc. + +pattern_list([P0|Ps], St) -> + P1 = pattern(P0, St), + [P1|pattern_list(Ps, St)]; +pattern_list([], _St) -> []. + +guard([G0|Gs], St) -> + G1 = and_guard(G0, St), + [G1|guard(Gs, St)]; +guard([], _St) -> []. + +and_guard([G0|Gs], St) -> + G1 = guard_test(G0, St), + [G1|and_guard(Gs, St)]; +and_guard([], _St) -> []. + + +guard_test({call,Anno,{atom,_,is_record},[A,{atom,_,Name}]}, St) -> + record_test_in_guard(Anno, A, Name, St); +guard_test({call,Anno,{remote,_,{atom,_,erlang},{atom,_,is_record}}, [A,{atom,_,Name}]}, + St) -> + record_test_in_guard(Anno, A, Name, St); +guard_test({call,Anno,{tuple,_,[{atom,_,erlang},{atom,_,is_record}]}, + [A,{atom,_,Name}]}, St) -> + record_test_in_guard(Anno, A, Name, St); +guard_test({call,Anno,{remote,_,{atom,_,erlang},{atom,_,F}},As0}, St) -> + As = gexpr_list(As0, St), + {safe_bif,ln(Anno),erlang,F,As}; +guard_test({call,Anno,{atom,_, F0},As0}, St) -> + F = normalise_test(F0, length(As0)), + true = erl_internal:bif(F,length(As0)), + As = gexpr_list(As0, St), + {safe_bif,ln(Anno),erlang,F,As}; +guard_test({op,Anno,Op,L0}, St) -> + true = erl_internal:arith_op(Op, 1) orelse %Assertion. + erl_internal:bool_op(Op, 1), + L1 = gexpr(L0, St), + {safe_bif,ln(Anno),erlang,Op,[L1]}; +guard_test({op,Anno,Op,L0,R0}, St) when Op =:= 'andalso'; Op =:= 'orelse' -> + L1 = gexpr(L0, St), + R1 = gexpr(R0, St), %They see the same variables + {Op,ln(Anno),L1,R1}; +guard_test({op,Anno,Op,L0,R0}, St) -> + true = erl_internal:comp_op(Op, 2) orelse %Assertion. + erl_internal:bool_op(Op, 2) orelse + erl_internal:arith_op(Op, 2), + L1 = gexpr(L0, St), + R1 = gexpr(R0, St), %They see the same variables + {safe_bif,ln(Anno),erlang,Op,[L1,R1]}; +guard_test({record_field,_A,R,Name,F}, St) -> + Anno = erl_parse:first_anno(R), + get_record_field_guard(Anno, R, F, Name, St); +guard_test({var,_,_}=V, _St) ->V; % Boolean var +guard_test({atom,Anno,true}, _St) -> {value,ln(Anno),true}; +%% All other constants at this level means false. +guard_test({atom,Anno,_}, _St) -> {value,ln(Anno),false}; +guard_test({integer,Anno,_}, _St) -> {value,ln(Anno),false}; +guard_test({char,Anno,_}, _St) -> {value,ln(Anno),false}; +guard_test({float,Anno,_}, _St) -> {value,ln(Anno),false}; +guard_test({string,Anno,_}, _St) -> {value,ln(Anno),false}; +guard_test({nil,Anno}, _St) -> {value,ln(Anno),false}; +guard_test({cons,Anno,_,_}, _St) -> {value,ln(Anno),false}; +guard_test({tuple,Anno,_}, _St) -> {value,ln(Anno),false}; +guard_test({map,Anno,_}, _St) -> {value,ln(Anno),false}; +guard_test({map,Anno,_,_}, _St) -> {value,ln(Anno),false}; +guard_test({bin,Anno,_}, _St) -> {value,ln(Anno),false}. + +gexpr({var,Anno,V}, _St) -> {var,ln(Anno),V}; +gexpr({integer,Anno,I}, _St) -> {value,ln(Anno),I}; +gexpr({char,Anno,I}, _St) -> {value,ln(Anno),I}; +gexpr({float,Anno,F}, _St) -> {value,ln(Anno),F}; +gexpr({atom,Anno,A}, _St) -> {value,ln(Anno),A}; +gexpr({string,Anno,S}, _St) -> {value,ln(Anno),S}; +gexpr({nil,Anno}, _St) -> {value,ln(Anno),[]}; +gexpr({cons,Anno,H0,T0}, St) -> + case {gexpr(H0, St),gexpr(T0, St)} of + {{value,Line,H1},{value,Line,T1}} -> {value,Line,[H1|T1]}; + {H1,T1} -> {cons,ln(Anno),H1,T1} + end; +gexpr({tuple,Anno,Es0}, St) -> + Es1 = gexpr_list(Es0, St), + {tuple,ln(Anno),Es1}; +gexpr({record, _, _, _}=Rec, St) -> + expr(Rec, false, St); +gexpr({map,Anno,Fs0}, St) -> + new_map(Fs0, Anno, St, fun(F) -> gexpr(F,St) end); +gexpr({map,Anno,E0,Fs0}, St) -> + E1 = gexpr(E0, St), + Fs1 = map_fields(Fs0, St, fun(F) -> gexpr(F,St) end), + {map,ln(Anno),E1,Fs1}; +gexpr({bin,Anno,Flds0}, St) -> + Flds = gexpr_list(bin_expand_strings(Flds0), St), + {bin,ln(Anno),Flds}; +gexpr({bin_element,Anno,Expr0,Size0,Type0}, St) -> + {Size1,Type} = make_bit_type(Anno, Size0, Type0), + Expr = gexpr(Expr0, St), + Size = gexpr(Size1, St), + {bin_element,ln(Anno),Expr,Size,Type}; +gexpr({call,Anno,{atom,_,is_record},[A,{atom,_,Name}]}, St) -> + record_test_in_guard(Anno, A, Name, St); +gexpr({call,Anno,{remote,_,{atom,_,erlang},{atom,_,is_record}}, [A,{atom,_,Name}]}, + St) -> + record_test_in_guard(Anno, A, Name, St); +gexpr({call,Anno,{tuple,_,[{atom,_,erlang},{atom,_,is_record}]}, + [A,{atom,_,Name}]}, St) -> + record_test_in_guard(Anno, A, Name, St); +gexpr({record_field,_A,R,Name,F}, St) -> + Anno = erl_parse:first_anno(R), + get_record_field_guard(Anno, R, F, Name, St); +gexpr({record_index,Anno,Name,F}, St) -> + I = index_expr(Anno, F, Name, record_fields(Name, Anno, St)), + gexpr(I, St); +gexpr({call,Anno,{remote,_,{atom,_,erlang},{atom,_,self}},[]}, _St) -> + {dbg,ln(Anno),self,[]}; +gexpr({call,Anno,{remote,_,{atom,_,erlang},{atom,_,F}},As0}, St) -> + As = gexpr_list(As0, St), + {safe_bif,ln(Anno),erlang,F,As}; +gexpr({call,Anno,{atom,_,self},[]}, _St) -> + {dbg,ln(Anno),self,[]}; +gexpr({call,Anno,{atom,_, F},As0}, St) -> + true = erl_internal:bif(F,length(As0)), + As = gexpr_list(As0, St), + {safe_bif,ln(Anno),erlang,F,As}; +gexpr({op,Anno,Op,A0}, St) -> + erl_internal:arith_op(Op, 1), + A1 = gexpr(A0, St), + {safe_bif,ln(Anno),erlang,Op,[A1]}; +gexpr({op,Anno,Op,L0,R0}, St) when Op =:= 'andalso'; Op =:= 'orelse' -> + L1 = gexpr(L0, St), + R1 = gexpr(R0, St), %They see the same variables + {Op,ln(Anno),L1,R1}; +gexpr({op,Anno,Op,L0,R0}, St) -> + true = erl_internal:arith_op(Op, 2) orelse erl_internal:comp_op(Op, 2) + orelse erl_internal:bool_op(Op, 2), + L1 = gexpr(L0, St), + R1 = gexpr(R0, St), %They see the same variables + {safe_bif,ln(Anno),erlang,Op,[L1,R1]}. + +%% These expressions are processed "in parallel" for purposes of variable +%% definition etc. + +gexpr_list([E0|Es], St) -> + E1 = gexpr(E0, St), + [E1|gexpr_list(Es, St)]; +gexpr_list([], _St) -> []. + +%% These expressions are processed "sequentially" for purposes of variable +%% definition etc. + +exprs([E], Lc, St) -> + [expr(E, Lc, St)]; +exprs([E0|Es], Lc, St) -> + E1 = expr(E0, false, St), + [E1|exprs(Es, Lc, St)]; +exprs([], _Lc, _St) -> []. + +expr({var,Anno,V}, _Lc, _St) -> {var,ln(Anno),V}; +expr({integer,Anno,I}, _Lc, _St) -> {value,ln(Anno),I}; +expr({char,Anno,I}, _Lc, _St) -> {value,ln(Anno),I}; +expr({float,Anno,F}, _Lc, _St) -> {value,ln(Anno),F}; +expr({atom,Anno,A}, _Lc, _St) -> {value,ln(Anno),A}; +expr({string,Anno,S}, _Lc, _St) -> {value,ln(Anno),S}; +expr({nil,Anno}, _Lc, _St) -> {value,ln(Anno),[]}; +expr({cons,Anno,H0,T0}, _Lc, St) -> + case {expr(H0, false, St),expr(T0, false, St)} of + {{value,Line,H1},{value,Line,T1}} -> {value,Line,[H1|T1]}; + {H1,T1} -> {cons,ln(Anno),H1,T1} + end; +expr({tuple,Anno,Es0}, _Lc, St) -> + Es1 = expr_list(Es0, St), + {tuple,ln(Anno),Es1}; +expr({record_index,Anno,Name,F}, Lc, St) -> + I = index_expr(Anno, F, Name, record_fields(Name, Anno, St)), + expr(I, Lc, St); +expr({record_field,_A,R,Name,F}, _Lc, St) -> + Anno = erl_parse:first_anno(R), + get_record_field_body(Anno, R, F, Name, St); +expr({record,Anno,R,Name,Us}, Lc, St) -> + Ue = record_update(R, Name, record_fields(Name, Anno, St), Us, St), + expr(Ue, Lc, St); +expr({record,Anno,Name,Is}, Lc, St) -> + expr({tuple,Anno,[{atom,Anno,Name} | + record_inits(record_fields(Name, Anno, St), Is)]}, + Lc, St); +expr({record_update, Anno, Es0}, Lc, St) -> + %% Unfold block into a sequence. + Es1 = exprs(Es0, Lc, St), + {record_update,ln(Anno),Es1}; +expr({map,Anno,Fs}, _Lc, St) -> + new_map(Fs, Anno, St, fun (E) -> expr(E, false, St) end); +expr({map,Anno,E0,Fs0}, _Lc, St) -> + E1 = expr(E0, false, St), + Fs1 = map_fields(Fs0, St), + {map,ln(Anno),E1,Fs1}; +expr({block,Anno,Es0}, Lc, St) -> + %% Unfold block into a sequence. + Es1 = exprs(Es0, Lc, St), + {block,ln(Anno),Es1}; +expr({'if',Anno,Cs0}, Lc, St) -> + Cs1 = icr_clauses(Cs0, Lc, St), + {'if',ln(Anno),Cs1}; +expr({'case',Anno,E0,Cs0}, Lc, St) -> + E1 = expr(E0, false, St), + Cs1 = icr_clauses(Cs0, Lc, St), + {'case',ln(Anno),E1,Cs1}; +expr({'receive',Anno,Cs0}, Lc, St) -> + Cs1 = icr_clauses(Cs0, Lc, St), + {'receive',ln(Anno),Cs1}; +expr({'receive',Anno,Cs0,To0,ToEs0}, Lc, St) -> + To1 = expr(To0, false, St), + ToEs1 = exprs(ToEs0, Lc, St), + Cs1 = icr_clauses(Cs0, Lc, St), + {'receive',ln(Anno),Cs1,To1,ToEs1}; +expr({'maybe',Anno,Es0}, Lc, St) -> + Es1 = exprs(Es0, Lc, St), + {'maybe',ln(Anno),Es1}; +expr({'maybe',Anno,Es0,{'else',_ElseAnno,Cs0}}, Lc, St) -> + Es1 = exprs(Es0, Lc, St), + Cs1 = icr_clauses(Cs0, Lc, St), + {'maybe',ln(Anno),Es1,Cs1}; +expr({'fun',Anno,{clauses,Cs0}}, _Lc, St) -> + %% New R10B-2 format (abstract_v2). + Cs = fun_clauses(Cs0, St), + Name = new_fun_name(), + {make_fun,ln(Anno),Name,Cs}; +expr({'fun',Anno,{function,F,A}}, _Lc, _St) -> + %% New R8 format (abstract_v2). + Line = ln(Anno), + case erl_internal:bif(F, A) of + true -> + %% Auto-imported BIF. Create an external fun. + {value,Line,fun erlang:F/A}; + false -> + %% A local function. + As = new_vars(A, Line), + Name = new_fun_name(), + Cs = [{clause,Line,As,[],[{local_call,Line,F,As,true}]}], + {make_fun,Line,Name,Cs} + end; +expr({named_fun,Anno,FName,Cs0}, _Lc, St) -> + Cs = fun_clauses(Cs0, St), + Name = new_fun_name(), + {make_named_fun,ln(Anno),Name,FName,Cs}; +expr({'fun',Anno,{function,{atom,_,M},{atom,_,F},{integer,_,A}}}, _Lc, _St) + when 0 =< A, A =< 255 -> + %% New format in R15 for fun M:F/A (literal values). + {value,ln(Anno),erlang:make_fun(M, F, A)}; +expr({'fun',Anno,{function,M,F,A}}, _Lc, St) -> + %% New format in R15 for fun M:F/A (one or more variables). + MFA = expr_list([M,F,A], St), + {make_ext_fun,ln(Anno),MFA}; +expr({call,Anno,{remote,_,{atom,_,erlang},{atom,_,self}},[]}, _Lc, _St) -> + {dbg,ln(Anno),self,[]}; +expr({call,Anno,{remote,_,{atom,_,erlang},{atom,_,throw}},[_]=As}, _Lc, St) -> + {dbg,ln(Anno),throw,expr_list(As, St)}; +expr({call,Anno,{remote,_,{atom,_,erlang},{atom,_,error}},[_]=As}, _Lc, St) -> + {dbg,ln(Anno),error,expr_list(As, St)}; +expr({call,Anno,{remote,_,{atom,_,erlang},{atom,_,exit}},[_]=As}, _Lc, St) -> + {dbg,ln(Anno),exit,expr_list(As, St)}; +expr({call,Anno,{remote,_,{atom,_,erlang},{atom,_,raise}},[_,_,_]=As}, _Lc, St) -> + {dbg,ln(Anno),raise,expr_list(As, St)}; +expr({call,Anno,{remote,_,{atom,_,erlang},{atom,_,apply}},[_,_,_]=As0}, Lc, St) -> + As = expr_list(As0, St), + {apply,ln(Anno),As,Lc}; +expr({call,Anno,{atom,_,is_record},[A,{atom,_,Name}]}, Lc, St) -> + record_test_in_body(Anno, A, Name, Lc, St); +expr({call,Anno,{remote,_,{atom,_,erlang},{atom,_,is_record}}, [A,{atom,_,Name}]}, + Lc, St) -> + record_test_in_body(Anno, A, Name, Lc, St); +expr({call,Anno,{tuple,_,[{atom,_,erlang},{atom,_,is_record}]}, + [A,{atom,_,Name}]}, Lc, St) -> + record_test_in_body(Anno, A, Name, Lc, St); +expr({call,Anno,{atom,_AnnoA,record_info},[_,_]=As0}, Lc, St) -> + As = expr_list(As0, St), + expr(record_info_call(Anno, As, St), Lc, St); +expr({call,Anno,{remote,_,{atom,_,Mod},{atom,_,Func}},As0}, Lc, St) -> + As = expr_list(As0, St), + case erlang:is_builtin(Mod, Func, length(As)) of + false -> + {call_remote,ln(Anno),Mod,Func,As,Lc}; + true -> + case bif_type(Mod, Func, length(As0)) of + safe -> {safe_bif,ln(Anno),Mod,Func,As}; + unsafe ->{bif,ln(Anno),Mod,Func,As} + end + end; +expr({call,Anno,{remote,_,Mod0,Func0},As0}, Lc, St) -> + %% New R8 format (abstract_v2). + Mod = expr(Mod0, false, St), + Func = expr(Func0, false, St), + As = consify(expr_list(As0, St)), + {apply,ln(Anno),[Mod,Func,As],Lc}; +expr({call,Anno,{atom,_,Func}=F,As0}, Lc, #{ctype:=Ctypes} = St) -> + As = expr_list(As0, St), + Ar = length(As), + NA = {Func,Ar}, + Special = lists:member(Func, [self,throw,error,exit,raise,apply]), + case maps:get(NA, Ctypes, undefined) of + local -> + {local_call,ln(Anno),Func,As,Lc}; + {imported, Mod} -> + {call_remote,ln(Anno),Mod,Func,As,Lc}; + undefined when Special -> + expr({call,Anno,{remote,Anno,{atom,Anno,erlang},F},As0}, Lc, St); + undefined -> + case erl_internal:bif(Func, Ar) andalso bif_type(erlang, Func, Ar) of + false -> {local_call,ln(Anno),Func,As,Lc}; + safe -> {safe_bif,ln(Anno),erlang,Func,As}; + unsafe -> {bif,ln(Anno),erlang,Func,As} + end + end; +expr({call,Anno,Fun0,As0}, Lc, St) -> + Fun = expr(Fun0, false, St), + As = expr_list(As0, St), + {apply_fun,ln(Anno),Fun,As,Lc}; +expr({'catch',Anno,E0}, _Lc, St) -> + %% No new variables added. + E1 = expr(E0, false, St), + {'catch',ln(Anno),E1}; +expr({'try',Anno,Es0,CaseCs0,CatchCs0,As0}, Lc, St) -> + %% No new variables added. + Es = expr_list(Es0, St), + CaseCs = icr_clauses(CaseCs0, Lc, St), + CatchCs = icr_clauses(CatchCs0, Lc, St), + As = expr_list(As0, St), + {'try',ln(Anno),Es,CaseCs,CatchCs,As}; +expr({lc,_,_,_}=Compr, _Lc, St) -> + expr_comprehension(Compr, St); +expr({bc,_,_,_}=Compr, _Lc, St) -> + expr_comprehension(Compr, St); +expr({mc,_,_,_}=Compr, _Lc, St) -> + expr_comprehension(Compr, St); +expr({match,Anno,P0,E0}, _Lc, St) -> + E1 = expr(E0, false, St), + P1 = pattern(P0, St), + {match,ln(Anno),P1,E1}; +expr({maybe_match,Anno,P0,E0}, _Lc, St) -> + E1 = expr(E0, false, St), + P1 = pattern(P0, St), + {maybe_match,ln(Anno),P1,E1}; +expr({op,Anno,Op,A0}, _Lc, St) -> + A1 = expr(A0, false, St), + {op,ln(Anno),Op,[A1]}; +expr({op,Anno,'++',L0,R0}, _Lc, St) -> + L1 = expr(L0, false, St), + R1 = expr(R0, false, St), %They see the same variables + {op,ln(Anno),append,[L1,R1]}; +expr({op,Anno,'--',L0,R0}, _Lc, St) -> + L1 = expr(L0, false, St), + R1 = expr(R0, false, St), %They see the same variables + {op,ln(Anno),subtract,[L1,R1]}; +expr({op,Anno,'!',L0,R0}, _Lc, St) -> + L1 = expr(L0, false, St), + R1 = expr(R0, false, St), %They see the same variables + {send,ln(Anno),L1,R1}; +expr({op,Anno,Op,L0,R0}, _Lc, St) when Op =:= 'andalso'; Op =:= 'orelse' -> + L1 = expr(L0, false, St), + R1 = expr(R0, false, St), %They see the same variables + {Op,ln(Anno),L1,R1}; +expr({op,Anno,Op,L0,R0}, _Lc, St) -> + L1 = expr(L0, false, St), + R1 = expr(R0, false, St), %They see the same variables + {op,ln(Anno),Op,[L1,R1]}; +expr({bin,Anno,Grp}, _Lc, St) -> + Grp1 = expr_list(bin_expand_strings(Grp), St), + {bin,ln(Anno),Grp1}; +expr({bin_element,Anno,Expr0,Size0,Type0}, _Lc, St) -> + {Size1,Type} = make_bit_type(Anno, Size0, Type0), + Expr = expr(Expr0, false, St), + Size = expr(Size1, false, St), + {bin_element,ln(Anno),Expr,Size,Type}; +expr({map_field_assoc,L,K0,V0}, _Lc, St) -> + K = expr(K0, false, St), + V = expr(V0, false, St), + {map_field_assoc,L,K,V}. + +consify([A|As]) -> + {cons,0,A,consify(As)}; +consify([]) -> {value,0,[]}. + +make_bit_type(Line, default, Type0) -> + case erl_bits:set_bit_type(default, Type0) of + {ok,all,Bt} -> {{atom,Line,all},erl_bits:as_list(Bt)}; + {ok,undefined,Bt} -> {{atom,Line,undefined},erl_bits:as_list(Bt)}; + {ok,Size,Bt} -> {{integer,Line,Size},erl_bits:as_list(Bt)} + end; +make_bit_type(_Line, Size, Type0) -> %Integer or 'all' + {ok,Size,Bt} = erl_bits:set_bit_type(Size, Type0), + {Size,erl_bits:as_list(Bt)}. + +expr_comprehension({Tag,Anno,E0,Gs0}, St) -> + Gs = [case G of + ({generate,L,P0,Qs}) -> + {generator,{generate,L,pattern(P0, St),expr(Qs, false, St)}}; + ({b_generate,L,P0,Qs}) -> %R12. + {generator,{b_generate,L,pattern(P0, St),expr(Qs, false, St)}}; + ({m_generate,L,P0,Qs}) -> %OTP 26 + {generator,{m_generate,L,mc_pattern(P0, St),expr(Qs, false, St)}}; + (Expr) -> + case is_guard_test(Expr, St) of + true -> {guard,guard([[Expr]], St)}; + false -> expr(Expr, false, St) + end + end || G <- Gs0], + {Tag,ln(Anno),expr(E0, false, St),Gs}. + +mc_pattern({map_field_exact,L,KeyP0,ValP0}, St) -> + KeyP1 = pattern(KeyP0, St), + ValP1 = pattern(ValP0, St), + {map_field_exact,L,KeyP1,ValP1}. + +is_guard_test(Expr, #{ctype:=Ctypes}) -> + IsOverridden = fun(NA) -> + case maps:get(NA, Ctypes, undefined) of + local -> true; + {imported,_} -> true; + undefined -> false + end + end, + erl_lint:is_guard_test(Expr, [], IsOverridden). + +normalise_test(atom, 1) -> is_atom; +normalise_test(binary, 1) -> is_binary; +normalise_test(float, 1) -> is_float; +normalise_test(function, 1) -> is_function; +normalise_test(integer, 1) -> is_integer; +normalise_test(list, 1) -> is_list; +normalise_test(number, 1) -> is_number; +normalise_test(pid, 1) -> is_pid; +normalise_test(port, 1) -> is_port; +normalise_test(record, 2) -> is_record; +normalise_test(reference, 1) -> is_reference; +normalise_test(tuple, 1) -> is_tuple; +normalise_test(Name, _) -> Name. + +%% As Expr may have side effects, we must evaluate it +%% first and bind the value to a new variable. +%% We must use also handle the case that Expr does not +%% evaluate to a tuple properly. + +record_test_in_body(Anno, Expr, Name, Lc, St) -> + Fs = record_fields(Name, Anno, St), + Var = {var, Anno, new_var_name()}, + expr({block,Anno, + [{match,Anno,Var,Expr}, + {call,Anno,{remote,Anno,{atom,Anno,erlang}, + {atom,Anno,is_record}}, + [Var,{atom,Anno,Name},{integer,Anno,length(Fs)+1}]}]}, Lc, St). + +record_test_in_guard(Anno, Term, Name, St) -> + Fs = record_fields(Name, Anno, St), + expr({call,Anno,{remote,Anno,{atom,Anno,erlang},{atom,Anno,is_record}}, + [Term,{atom,Anno,Name},{integer,Anno,length(Fs)+1}]}, false, St). + +%% Expand a call to record_info/2. We have checked that it is not +%% shadowed by an import. + +record_info_call(Anno, [{value,_AnnoI,Info},{value,_AnnoN,Name}], St) -> + case Info of + size -> + {integer,Anno,1+length(record_fields(Name, Anno, St))}; + fields -> + Fs = lists:map(fun({record_field,_,Field,_Val}) -> Field end, + record_fields(Name, Anno, St)), + lists:foldr(fun (H, T) -> {cons,Anno,H,T} end, {nil,Anno}, Fs) + end. + +record_fields(R, Anno, #{recs := Recs}) -> + Fields = maps:get(R, Recs), + [{record_field,Anno,{atom,Anno,F},copy_expr(Di, Anno)} || + {record_field,_Anno,{atom,_AnnoA,F},Di} <- Fields]. + + +%% record_inits([RecDefField], [Init]) -> [InitExpr]. +%% Build a list of initialisation expressions for the record tuple +%% elements. This expansion must be passed through expr +%% again. N.B. We are scanning the record definition field list! + +record_inits(Fs, Is) -> + WildcardInit = record_wildcard_init(Is), + lists:map(fun ({record_field,_,{atom,_,F},D}) -> + case find_field(F, Is) of + {ok,Init} -> Init; + error when WildcardInit =:= none -> D; + error -> WildcardInit + end + end, Fs). + +record_wildcard_init([{record_field,_,{var,_,'_'},D} | _]) -> D; +record_wildcard_init([_ | Is]) -> record_wildcard_init(Is); +record_wildcard_init([]) -> none. + +%% copy_expr(Expr, Anno) -> Expr. +%% Make a copy of Expr converting all annotations to Anno. +copy_expr(Expr, Anno) -> + erl_parse:map_anno(fun(_A) -> Anno end, Expr). + +find_field(F, [{record_field,_,{atom,_,F},Val} | _]) -> {ok,Val}; +find_field(F, [_ | Fs]) -> find_field(F, Fs); +find_field(_, []) -> error. + +%% record_update(Record, RecordName, [RecDefField], [Update], State) -> +%% {Expr,State'} +%% Build an expression to update fields in a record returning a new +%% record. Try to be smart and optimise this. This expansion must be +%% passed through expr again. + +record_update(R, Name, Fs, Us0, St) -> + Anno = element(2, R), + {Pre,Us} = record_exprs(Us0, St), + %% We need a new variable for the record expression + %% to guarantee that it is only evaluated once. + Var = {var, Anno, new_var_name()}, + Update = record_match(Var, Name, Anno, Fs, Us, St), + {record_update,Anno, Pre ++ [{match,Anno,Var,R},Update]}. + +%% record_match(Record, RecordName, Anno, [RecDefField], [Update], State) +%% Build a 'case' expression to modify record fields. + +record_match(R, Name, Anno, Fs, Us, St) -> + {Ps,News} = record_upd_fs(Fs, Us, St), + {'case',ln(Anno),R, + [{clause,ln(Anno),[{tuple,Anno,[{atom,Anno,Name} | Ps]}],[], + [{tuple,Anno,[{atom,Anno,Name} | News]}]}, + {clause,Anno,[{var,Anno,'_'}],[], + [call_error(Anno, {tuple,Anno,[{atom,Anno,badrecord},{atom,Anno,Name}]})]} + ]}. + +record_upd_fs([{record_field,Anno,{atom,_AnnoA,F},_Val} | Fs], Us, St) -> + P = {var, Anno, new_var_name()}, + {Ps,News} = record_upd_fs(Fs, Us, St), + case find_field(F, Us) of + {ok,New} -> {[P | Ps],[New | News]}; + error -> {[P | Ps],[P | News]} + end; +record_upd_fs([], _, _) -> {[],[]}. + +call_error(Anno, R) -> + {call,Anno,{remote,Anno,{atom,Anno,erlang},{atom,Anno,error}},[R]}. + +%% Break out expressions from an record update list and bind to new +%% variables. The idea is that we will evaluate all update expressions +%% before starting to update the record. + +record_exprs(Us, St) -> + record_exprs(Us, St, [], []). + +record_exprs([{record_field,Anno,{atom,_AnnoA,_F}=Name,Val}=Field0 | Us], St, Pre, Fs) -> + case is_simple_val(Val) of + true -> + record_exprs(Us, St, Pre, [Field0 | Fs]); + false -> + Var = {var, Anno, new_var_name()}, + Bind = {match,ln(Anno),Var,Val}, + Field = {record_field,ln(Anno),Name,Var}, + record_exprs(Us, St, [Bind | Pre], [Field | Fs]) + end; +record_exprs([], _St, Pre, Fs) -> + {lists:reverse(Pre),Fs}. + +is_simple_val({var,_,_}) -> true; +is_simple_val(Val) -> + try + erl_parse:normalise(Val), + true + catch error:_ -> + false + end. + +%% pattern_fields([RecDefField], [Match]) -> [Pattern]. +%% Build a list of match patterns for the record tuple elements. +%% This expansion must be passed through pattern again. N.B. We are +%% scanning the record definition field list! + +pattern_fields(Fs, Ms) -> + Wildcard = record_wildcard_init(Ms), + lists:map(fun ({record_field,Anno,{atom,_,F},_}) -> + case find_field(F, Ms) of + {ok,Match} -> Match; + error when Wildcard =:= none -> {var,Anno,'_'}; + error -> Wildcard + end + end, Fs). + +%% index_expr(Anno, FieldExpr, Name, Fields) -> IndexExpr. +%% Return an expression which evaluates to the index of a +%% field. Currently only handle the case where the field is an +%% atom. This expansion must be passed through expr again. + +index_expr(Anno, {atom,_,F}, _Name, Fs) -> + {integer,Anno,index_expr(F, Fs, 2)}. + +index_expr(F, [{record_field,_,{atom,_,F},_} | _], I) -> I; +index_expr(F, [_ | Fs], I) -> index_expr(F, Fs, I+1). + + +%% get_record_field(Anno, RecExpr, FieldExpr, Name, St) -> {Expr,St'}. +%% Return an expression which verifies that the type of record +%% is correct and then returns the value of the field. +%% This expansion must be passed through expr again. + +get_record_field_body(Anno, R, {atom,_,F}, Name, St) -> + Var = {var, Anno, new_var_name()}, + Fs = record_fields(Name, Anno, St), + I = index_expr(F, Fs, 2), + P = record_pattern(2, I, Var, length(Fs)+1, Anno, [{atom,Anno,Name}]), + E = {'case',Anno,R, + [{clause,Anno,[{tuple,Anno,P}],[],[Var]}, + {clause,Anno,[{var,Anno,'_'}],[], + [{call,Anno,{remote,Anno, + {atom,Anno,erlang}, + {atom,Anno,error}}, + [{tuple,Anno,[{atom,Anno,badrecord},{atom,Anno,Name}]}]}]}]}, + expr(E, false, St). + +get_record_field_guard(Anno, R, {atom,_,F}, Name, St) -> + Fs = record_fields(Name, Anno, St), + I = index_expr(F, Fs, 2), + ExpR = expr(R, false, St), + %% Just to make comparison simple: + %% A0 = erl_anno:new(0), + %% ExpRp = erl_parse:map_anno(fun(_A) -> A0 end, ExpR), + %% RA = {{Name,ExpRp},Anno,ExpR,length(Fs)+1}, + %% St2 = St1#exprec{strict_ra = [RA | St1#exprec.strict_ra]}, + {safe_bif,ln(Anno),erlang,element,[{value,ln(Anno),I},ExpR]}. + +record_pattern(I, I, Var, Sz, Anno, Acc) -> + record_pattern(I+1, I, Var, Sz, Anno, [Var | Acc]); +record_pattern(Cur, I, Var, Sz, Anno, Acc) when Cur =< Sz -> + record_pattern(Cur+1, I, Var, Sz, Anno, [{var,Anno,'_'} | Acc]); +record_pattern(_, _, _, _, _, Acc) -> lists:reverse(Acc). + +%% The debugger converts both strings "abc" and lists [67, 68, 69] +%% into {value, Line, [67, 68, 69]}, making it impossible to later +%% distinguish one or the other inside binaries when evaluating. To +%% avoid <<[67, 68, 69]>> from evaluating, we convert strings into +%% chars to avoid the ambiguity. +bin_expand_strings(Es) -> + lists:foldr(fun ({bin_element,Line,{string,_,S},Sz,Ts}, Es1) -> + lists:foldr(fun (C, Es2) -> + [{bin_element,Line,{char,Line,C},Sz,Ts}|Es2] + end, Es1, S); + (E, Es1) -> [E|Es1] + end, [], Es). + +%% -type expr_list([Expression]) -> [Expression]. +%% These expressions are processed "in parallel" for purposes of variable +%% definition etc. + +expr_list([E0|Es], St) -> + E1 = expr(E0, false, St), + [E1|expr_list(Es, St)]; +expr_list([], _St) -> []. + +icr_clauses([C0|Cs], Lc, St) -> + C1 = clause(C0, Lc, St), + [C1|icr_clauses(Cs, Lc, St)]; +icr_clauses([], _, _St) -> []. + +fun_clauses([{clause,A,H,G,B}|Cs], St) -> + [{clause,ln(A),head(H, St),guard(G, St),exprs(B, true, St)}|fun_clauses(Cs, St)]; +fun_clauses([], _St) -> []. + +new_map(Fs0, Anno, St, F) -> + Line = ln(Anno), + Fs1 = map_fields(Fs0, St, F), + Fs2 = [{L,K,V} || {map_field_assoc,L,K,V} <- Fs1], + try + {value,Line,map_literal(Fs2, #{})} + catch + throw:not_literal -> + {map,Line,Fs2} + end. + +map_literal([{_,{value,_,K},{value,_,V}}|T], M) -> + map_literal(T, maps:put(K, V, M)); +map_literal([_|_], _) -> + throw(not_literal); +map_literal([], M) -> M. + +map_fields(Fs, St) -> + map_fields(Fs, St, fun (E) -> expr(E, false, St) end). + +map_fields([{map_field_assoc,A,N,V}|Fs], St, F) -> + [{map_field_assoc,ln(A),F(N),F(V)}|map_fields(Fs, St, F)]; +map_fields([{map_field_exact,A,N,V}|Fs], St, F) -> + [{map_field_exact,ln(A),F(N),F(V)}|map_fields(Fs, St, F)]; +map_fields([], _St, _) -> []. + +%% new_var_name() -> VarName. + +new_var_name() -> + C = get(vcount), + put(vcount, C+1), + list_to_atom("%" ++ integer_to_list(C)). + +%% new_vars(Count, Line) -> [Var]. +%% Make Count new variables. + +new_vars(N, L) -> new_vars(N, L, []). + +new_vars(N, L, Vs) when N > 0 -> + V = {var,L,new_var_name()}, + new_vars(N-1, L, [V|Vs]); +new_vars(0, _, Vs) -> Vs. + +new_fun_name() -> + {F,A} = get(current_function), + I = get(fun_count), + put(fun_count, I+1), + Name = "-" ++ atom_to_list(F) ++ "/" ++ integer_to_list(A) ++ + "-fun-" ++ integer_to_list(I) ++ "-", + list_to_atom(Name). + +ln(Anno) -> + erl_anno:line(Anno). + +bif_type(erlang, Name, Arity) -> + case erl_internal:guard_bif(Name, Arity) of + true -> + %% Guard BIFs are safe (except for self/0, but it is + %% handled with a special instruction anyway). + safe; + false -> + bif_type(Name) + end; +bif_type(_, _, _) -> unsafe. + +bif_type(register) -> safe; +bif_type(unregister) -> safe; +bif_type(whereis) -> safe; +bif_type(registered) -> safe; +bif_type(setelement) -> safe; +bif_type(atom_to_list) -> safe; +bif_type(list_to_atom) -> safe; +bif_type(integer_to_list) -> safe; +bif_type(list_to_integer) -> safe; +bif_type(float_to_list) -> safe; +bif_type(list_to_float) -> safe; +bif_type(tuple_to_list) -> safe; +bif_type(list_to_tuple) -> safe; +bif_type(make_ref) -> safe; +bif_type(time) -> safe; +bif_type(date) -> safe; +bif_type(processes) -> safe; +bif_type(process_info) -> safe; +bif_type(load_module) -> safe; +bif_type(delete_module) -> safe; +bif_type(halt) -> safe; +bif_type(check_process_code) -> safe; +bif_type(purge_module) -> safe; +bif_type(pid_to_list) -> safe; +bif_type(list_to_pid) -> safe; +bif_type(module_loaded) -> safe; +bif_type(binary_to_term) -> safe; +bif_type(term_to_binary) -> safe; +bif_type(nodes) -> safe; +bif_type(is_alive) -> safe; +bif_type(disconnect_node) -> safe; +bif_type(binary_to_list) -> safe; +bif_type(list_to_binary) -> safe; +bif_type(split_binary) -> safe; +bif_type(hash) -> safe; +bif_type(pre_loaded) -> safe; +bif_type(set_cookie) -> safe; +bif_type(get_cookie) -> safe; +bif_type(_) -> unsafe. diff --git a/debugger/erlide_debugger_23/src/dbg_iserver.erl b/debugger/erlide_debugger_27/src/dbg_iserver.erl similarity index 98% rename from debugger/erlide_debugger_23/src/dbg_iserver.erl rename to debugger/erlide_debugger_27/src/dbg_iserver.erl index 3e959e8..5a0a41f 100644 --- a/debugger/erlide_debugger_23/src/dbg_iserver.erl +++ b/debugger/erlide_debugger_27/src/dbg_iserver.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2016. All Rights Reserved. +%% Copyright Ericsson AB 1998-2024. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -18,6 +18,7 @@ %% %CopyrightEnd% %% -module(dbg_iserver). +-moduledoc false. -behaviour(gen_server). %% External exports @@ -233,6 +234,14 @@ handle_call({load, Mod, Src, Bin}, _From, State) -> {reply, {module, Mod}, State}; %% Module database +handle_call({get_module_db, Mod}, _From, State) -> + Db = State#state.db, + Reply = case ets:lookup(Db, {Mod, refs}) of + [] -> not_found; + [{{Mod, refs}, [ModDb|_ModDbs]}] -> + ModDb + end, + {reply, Reply, State}; handle_call({get_module_db, Mod, Pid}, _From, State) -> Db = State#state.db, Reply = case ets:lookup(Db, {Mod, refs}) of diff --git a/debugger/erlide_debugger_23/src/dbg_istk.erl b/debugger/erlide_debugger_27/src/dbg_istk.erl similarity index 88% rename from debugger/erlide_debugger_23/src/dbg_istk.erl rename to debugger/erlide_debugger_27/src/dbg_istk.erl index e89f437..4b03db0 100644 --- a/debugger/erlide_debugger_23/src/dbg_istk.erl +++ b/debugger/erlide_debugger_27/src/dbg_istk.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2011-2016. All Rights Reserved. +%% Copyright Ericsson AB 2011-2024. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -18,13 +18,16 @@ %% %CopyrightEnd% %% -module(dbg_istk). +-moduledoc false. -export([init/0,delayed_to_external/0,from_external/1, push/3,pop/0,pop/1,stack_level/0, delayed_stacktrace/0,delayed_stacktrace/2, bindings/1,stack_frame/2,backtrace/2, in_use_p/2]). +%% erlide patch ------------------------------------------------------ -export([all_frames/0, all_frames/1, all_modules_on_stack/0]). +%% erlide patch ------------------------------------------------------ -include("dbg_ieval.hrl"). @@ -34,6 +37,7 @@ {level, %Level mfa, %{Mod,Func,Args|Arity}|{Fun,Args} line, %Line called from + error_info=[], %[{error_info,Map}] | [] bindings, lc %Last call (true|false) }). @@ -51,6 +55,7 @@ from_external({stack,Stk}) -> init(Stack) -> put(?STACK, Stack). +%% erlide patch ------------------------------------------------------ all_frames() -> all_frames(get(?STACK)). @@ -72,6 +77,7 @@ all_modules_on_stack(Stack) -> args2arity(As) when is_list(As) -> length(As). +%% erlide patch ------------------------------------------------------ %% We keep track of a call stack that is used for %% 1) saving stack frames that can be inspected from an Attached @@ -149,8 +155,9 @@ delayed_stacktrace() -> end. delayed_stacktrace(include_args, Ieval) -> - #ieval{module=Mod,function=Name,arguments=As,line=Li} = Ieval, - Stack0 = [#e{mfa={Mod,Name,As},line=Li}|get(?STACK)], + #ieval{module=Mod,function=Name,arguments=As, + line=Li,error_info=ErrorInfo} = Ieval, + Stack0 = [#e{mfa={Mod,Name,As},line=Li,error_info=ErrorInfo}|get(?STACK)], fun(NumEntries) -> case stacktrace(NumEntries, Stack0, []) of [] -> @@ -182,18 +189,22 @@ stacktrace(N, [E|T], [{P,_}|_]=Acc) when N > 0 -> stacktrace(_, _, Acc) -> lists:reverse(Acc). -normalize(#e{mfa={M,Fun,As},line=Li}) when is_function(Fun) -> - Loc = {M,Li}, +normalize(#e{mfa={M,Fun,As},line=Li,error_info=ErrorInfo}) when is_function(Fun) -> + Loc = {M,Li,ErrorInfo}, {{Fun,length(As),Loc},{Fun,As,Loc}}; -normalize(#e{mfa={M,F,As},line=Li}) -> - Loc = {M,Li}, +normalize(#e{mfa={M,F,As},line=Li,error_info=ErrorInfo}) -> + Loc = {M,Li,ErrorInfo}, {{M,F,length(As),Loc},{M,F,As,Loc}}. finalize({M,F,A,Loc}) -> {M,F,A,line(Loc)}; finalize({Fun,A,Loc}) -> {Fun,A,line(Loc)}. -line({Mod,Line}) when Line > 0 -> - [{file,atom_to_list(Mod)++".erl"},{line,Line}]; +line({Mod,Line,ErrorInfo}) -> + if Line > 0 -> + [{file,atom_to_list(Mod)++".erl"},{line,Line}|ErrorInfo]; + true -> + ErrorInfo + end; line(_) -> []. %% bindings(SP) -> Bs diff --git a/debugger/erlide_debugger_24/src/erlide_debugger_24.app.src b/debugger/erlide_debugger_27/src/erlide_debugger_27.app.src similarity index 54% rename from debugger/erlide_debugger_24/src/erlide_debugger_24.app.src rename to debugger/erlide_debugger_27/src/erlide_debugger_27.app.src index 84dc055..b36c2a8 100644 --- a/debugger/erlide_debugger_24/src/erlide_debugger_24.app.src +++ b/debugger/erlide_debugger_27/src/erlide_debugger_27.app.src @@ -1,7 +1,7 @@ -{application, erlide_debugger_24, +{application, erlide_debugger_27, [ - {description, "erlide_debugger_24"}, - {vsn, "5.2.1"}, + {description, "erlide_debugger_27"}, + {vsn, "0.118.0"}, {erlide_context, debugger}, {registered, []}, {applications, [kernel, stdlib]}, diff --git a/debugger/erlide_debugger_23/src/int.erl b/debugger/erlide_debugger_27/src/int.erl similarity index 55% rename from debugger/erlide_debugger_23/src/int.erl rename to debugger/erlide_debugger_27/src/int.erl index bb39d5f..5a009e5 100644 --- a/debugger/erlide_debugger_23/src/int.erl +++ b/debugger/erlide_debugger_27/src/int.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2017. All Rights Reserved. +%% Copyright Ericsson AB 1998-2024. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -18,6 +18,58 @@ %% %CopyrightEnd% %% -module(int). +-moduledoc """ +Interpreter Interface. + +The Erlang interpreter provides mechanisms for breakpoints and stepwise +execution of code. It is primarily intended to be used by Debugger; see the +[Users's Guide for Debugger](debugger_chapter.md) and module `m:debugger`. + +The following can be done from the shell: + +- Specify the modules to be interpreted. +- Specify breakpoints. +- Monitor the current status of all processes executing code in interpreted + modules, also processes at other Erlang nodes. + +By _attaching to_ a process executing interpreted code, it is possible to +examine variable bindings and order stepwise execution. This is done by sending +and receiving information to/from the process through a third process, called +the meta process. You can implement your own attached process. See `int.erl` for +available functions and `dbg_wx_trace.erl` for possible messages. + +The interpreter depends on the Kernel, STDLIB, and WX applications. This means +that modules belonging to any of these applications are not allowed to be +interpreted, as it could lead to a deadlock or emulator crash. This also applies +to modules belonging to the Debugger application. + +[](){: #int_breakpoints } + +## Breakpoints + +Breakpoints are specified on a line basis. When a process executing code in an +interpreted module reaches a breakpoint, it stops. This means that a breakpoint +must be set at an executable line, that is, a code line containing an executable +expression. + +A breakpoint has the following: + +- A status, which is _active_ or _inactive_. An inactive breakpoint is ignored. +- A trigger action. When a breakpoint is reached, the trigger action specifies + if the breakpoint is to continue as active (_enable_), or to become inactive + (_disable_), or to be removed (_delete_). +- Optionally an associated condition. A condition is a tuple `{Module,Name}`. + When the breakpoint is reached, `Module:Name(Bindings)` is called. If it + evaluates to `true`, execution stops. If it evaluates to `false`, the + breakpoint is ignored. `Bindings` contains the current variable bindings. To + retrieve the value for a specified variable use `get_binding/2`. + +By default, a breakpoint is active, has trigger action `enable`, and has no +associated condition. For details about breakpoints, see +[Breakpoints and Break Dialog +Windows](debugger_chapter.md#breakpoints-and-break-dialog-windows) +in the User's Guide for Debugger. +""". %% External exports -export([i/1, i/2, ni/1, ni/2, n/1, nn/1, interpreted/0, file/1, @@ -90,17 +142,84 @@ %% External exports %%==================================================================== -%%-------------------------------------------------------------------- -%% i(AbsMods) -> {module,Mod} | error | ok -%% ni(AbsMods) -> {module,Mod} | error | ok -%% AbsMods = AbsMod | [AbsMod] -%% AbsMod = atom() | string() -%% Mod = atom() -%% Options = term() ignored -%%-------------------------------------------------------------------- +-doc """ +Interprets the specified module(s) on the local node. + +A module can be specified by its module name (atom) or filename. + +If specified by its module name, the object code `Module.beam` is searched for +in the current path. The source code `Module.erl` is searched for first in the +same directory as the object code, then in an `src` directory next to it. + +If specified by its filename, the filename can include a path and the `.erl` +extension can be omitted. The object code `Module.beam` is searched for first in +the same directory as the source code, then in an `ebin` directory next to it, +and then in the current path. + +> #### Note {: .info } +> +> The interpreter requires both the source code and the object code. The object +> code _must_ include debug information, that is, only modules compiled with +> option `debug_info` can be interpreted. + +The functions returns `{module,Module}` if the module was interpreted, otherwise +`error` is returned. + +The argument can also be a list of modules or filenames, in which case the +function tries to interpret each module as specified earlier. The function then +always returns `ok`, but prints some information to `stdout` if a module cannot +be interpreted. +""". +-spec i(AbsModules | AbsModule) -> Result when + AbsModules :: [AbsModule,...], + AbsModule :: Module | File, + Module :: module(), + File :: file:name_all(), + Result :: AbsModuleResult | AbsModulesResult, + AbsModuleResult :: {module, Module} | error, + AbsModulesResult :: ok. i(AbsMods) -> i2(AbsMods, local, ok). +-doc false. i(AbsMods, _Options) -> i2(AbsMods, local, ok). + +-doc """ +Interprets the specified module(s) on all known nodes. + +A module can be specified by its module name (atom) or filename. + +If specified by its module name, the object code `Module.beam` is searched for +in the current path. The source code `Module.erl` is searched for first in the +same directory as the object code, then in an `src` directory next to it. + +If specified by its filename, the filename can include a path and the `.erl` +extension can be omitted. The object code `Module.beam` is searched for first in +the same directory as the source code, then in an `ebin` directory next to it, +and then in the current path. + +> #### Note {: .info } +> +> The interpreter requires both the source code and the object code. The object +> code _must_ include debug information, that is, only modules compiled with +> option `debug_info` can be interpreted. + +The functions returns `{module,Module}` if the module was interpreted, otherwise +`error` is returned. + +The argument can also be a list of modules or filenames, in which case the +function tries to interpret each module as specified earlier. The function then +always returns `ok`, but prints some information to `stdout` if a module cannot +be interpreted. +""". +-spec ni(AbsModules | AbsModule) -> Result when + AbsModules :: [AbsModule], + AbsModule :: Module | File, + Module :: module(), + File :: file:name_all(), + Result :: AbsModuleResult | AbsModulesResult, + AbsModuleResult :: {module, Module} | error, + AbsModulesResult :: ok. ni(AbsMods) -> i2(AbsMods, distributed, ok). +-doc false. ni(AbsMods, _Options) -> i2(AbsMods, distributed, ok). i2([AbsMod|AbsMods], Dist, Acc) @@ -117,11 +236,26 @@ i2([], _Dist, Acc) -> i2(AbsMod, Dist, _Acc) when is_atom(AbsMod); is_list(AbsMod); is_tuple(AbsMod) -> int_mod(AbsMod, Dist). -%%-------------------------------------------------------------------- -%% n(AbsMods) -> ok -%% nn(AbsMods) -> ok -%%-------------------------------------------------------------------- +-doc """ +Stops interpreting the specified module on the local node. + +Similar to [`i/1`](`i/1`) and [`ni/1`](`ni/1`), a module can be specified by its +module name or filename. +""". +-spec n(AbsModule) -> ok when AbsModule :: Module | File | [Module | File], + Module :: module(), + File :: file:name_all(). n(AbsMods) -> n2(AbsMods, local). +-doc """ +Stops interpreting the specified module on all known nodes. + +Similar to [`i/1`](`i/1`) and [`ni/1`](`ni/1`), a module can be specified by its +module name or filename. +""". +-spec nn(AbsModule) -> ok when + AbsModule :: Module | File | [Module | File], + Module :: module(), + File :: file:name_all(). nn(AbsMods) -> n2(AbsMods, distributed). n2([AbsMod|AbsMods], Dist) when is_atom(AbsMod); is_list(AbsMod) -> @@ -134,25 +268,66 @@ n2([], _Dist) -> n2(AbsMod, Dist) when is_atom(AbsMod); is_list(AbsMod) -> del_mod(AbsMod, Dist). -%%-------------------------------------------------------------------- -%% interpreted() -> [Mod] -%%-------------------------------------------------------------------- +-doc "Returns a list with all interpreted modules.". +-spec interpreted() -> [Module] when Module :: module(). interpreted() -> dbg_iserver:safe_call(all_interpreted). -%%-------------------------------------------------------------------- -%% file(Mod) -> File | {error, not_loaded} -%% Mod = atom() -%% File = string() -%%-------------------------------------------------------------------- +-doc """ +Returns the source code filename `File` for an interpreted module `Module`. +""". +-spec file(Module) -> File | {error,not_loaded} when Module :: module(), + File :: file:filename_all(). file(Mod) when is_atom(Mod) -> dbg_iserver:safe_call({file, Mod}). -%%-------------------------------------------------------------------- -%% interpretable(AbsMod) -> true | {error, Reason} -%% AbsMod = Mod | File -%% Reason = no_src | no_beam | no_debug_info | badarg | {app, App} -%%-------------------------------------------------------------------- +-doc """ +Checks if a module can be interpreted. + +The module can be specified by its module name `Module` or its source +filename `File`. If specified by a module name, the module is searched +for in the code path. + +The function returns `true` if all of the following apply: + +- Both source code and object code for the module is found. +- The module has been compiled with option `debug_info` set. +- The module does not belong to any of the applications Kernel, STDLIB, WX, or + Debugger. + +The function returns `{error,Reason}` if the module cannot be interpreted. +`Reason` can have the following values: + +- **`no_src`** - No source code is found. It is assumed that the source code and + object code are located either in the same directory, or in `src` and `ebin` + directories next to each other. + +- **`no_beam`** - No object code is found. It is assumed that the source code + and object code are located either in the same directory, or in `src` and + `ebin` directories next to each other. + +- **`no_debug_info`** - The module has not been compiled with option + `debug_info` set. + +- **`badarg`** - `AbsModule` is not found. This could be because the specified + file does not exist, or because `code:which/1` does not return a BEAM + filename, which is the case not only for non-existing modules but also for + modules that are preloaded or cover-compiled. + +- **`{app,App}`** - `App` is `kernel`, `stdlib`, `gs`, or `debugger` if + `AbsModule` belongs to one of these applications. + +Notice that the function can return `true` for a module that is not +interpretable the module is marked as sticky or resides in a directory +marked as sticky. The reason is that this is not discovered until the +interpreter tries to load the module. +""". +-spec interpretable(AbsModule) -> true | {error,Reason} when + AbsModule :: Module | File, + Module :: module(), + File :: file:name_all(), + Reason :: no_src | no_beam | no_debug_info | badarg | {app,App}, + App :: atom(). interpretable(AbsMod) -> case check(AbsMod) of {ok, _Res} -> true; @@ -160,22 +335,55 @@ interpretable(AbsMod) -> end. %%-------------------------------------------------------------------- -%% auto_attach() -> false | {Flags, Function} -%% auto_attach(false) -%% auto_attach(false|Flags, Function) -%% Flags = Flag | [Flag] -%% Flag = init | break | exit -%% Function = {Mod, Func} | {Mod, Func, Args} -%% Will result in calling: -%% spawn(Mod, Func, [Dist, Pid, Meta | Args]) (living process) or -%% spawn(Mod, Func, [Dist, Pid, Reason, Info | Args]) (dead process) -%%-------------------------------------------------------------------- +-doc """ +Gets how to attach automatically to a process executing code in +interpreted modules. + +See `auto_attach/2` for the meaning of the possible values in `Flags`. +""". +-spec auto_attach() -> false | {Flags,Function} when Flags :: [init | break | exit], + Function :: {Module,Name,Args}, + Module :: module(), + Name :: atom(), + Args :: [term()]. auto_attach() -> dbg_iserver:safe_call(get_auto_attach). +-doc "Disables auto attach.". +-spec auto_attach(false) -> term(). auto_attach(false) -> dbg_iserver:safe_cast({set_auto_attach, false}). +-doc """ +Sets when and how to attach automatically to a process executing code +in interpreted modules. + +By default when the interpreter is started, automatic attach is disabled. + +If `Flags` is an empty list, automatic attach is disabled. + +Otherwise `Flags` should be a list containing at least one of the following +flags: + +- `init` - Attach when a process for the first time calls an interpreted + function. +- `break` - Attach whenever a process reaches a breakpoint. +- `exit` - Attach when a process terminates. + +When the specified event occurs, the function `Function` is called as: + +```erlang +spawn(Module, Name, [Pid | Args]) +``` + +`Pid` is the pid of the process executing interpreted code. +""". +-spec auto_attach(Flags, Function) -> term() when + Flags :: [init | break | exit], + Function :: {Module,Name,Args}, + Module :: module(), + Name :: atom(), + Args :: [term()]. auto_attach([], _Function) -> auto_attach(false); auto_attach(Flags, {Mod, Func}) -> @@ -189,14 +397,34 @@ check_flags([break|Flags]) -> check_flags(Flags); check_flags([exit|Flags]) -> check_flags(Flags); check_flags([]) -> true. -%%-------------------------------------------------------------------- -%% stack_trace() -> Flag -%% stack_trace(Flag) -%% Flag = all | true | no_tail | false -%%-------------------------------------------------------------------- +-doc """ +Gets how to save call frames in the stack. + +See `stack_trace/1` for the meaning of `Flag`. +""". +-spec stack_trace() -> Flag when Flag :: all | no_tail | false. stack_trace() -> dbg_iserver:safe_call(get_stack_trace). +-doc """ +Sets how to save call frames in the stack. + +Saving call frames makes it possible to inspect the call chain of a +process, and is also used to emulate the stack trace if an error (an +exception of class error) occurs. The following flags can be +specified: + +- **`all`** - Save information about all current calls, that is, function calls + that have not yet returned a value. + +- **`no_tail`** - Save information about current calls, but discard previous + information when a tail-recursive call is made. This option consumes less + memory and can be necessary to use for processes with long lifetimes and many + tail-recursive calls. This is the default. + +- **`false`** - Save no information about current calls. +""". +-spec stack_trace(Flag) -> term() when Flag :: all | no_tail | false. stack_trace(true) -> stack_trace(all); stack_trace(Flag) -> @@ -207,41 +435,30 @@ check_flag(all) -> true; check_flag(no_tail) -> true; check_flag(false) -> true. -%%-------------------------------------------------------------------- -%% break(Mod, Line) -> ok | {error, break_exists} -%% delete_break(Mod, Line) -> ok -%% break_in(Mod, Func, Arity) -> ok | {error, function_not_found} -%% del_break_in(Mod, Function, Arity) -> ok | {error, function_not_found} -%% no_break() -%% no_break(Mod) -%% disable_break(Mod, Line) -> ok -%% enable_break(Mod, Line) -> ok -%% action_at_break(Mod, Line, Action) -> ok -%% test_at_break(Mod, Line, Function) -> ok -%% get_binding(Var, Bindings) -> {value, Value} | unbound -%% all_breaks() -> [Break] -%% all_breaks(Mod) -> [Break] -%% Mod = atom() -%% Line = integer() -%% Func = atom() function name -%% Arity = integer() -%% Action = enable | disable | delete -%% Function = {Mod, Func} must have arity 1 (Bindings) -%% Var = atom() -%% Bindings = Value = term() -%% Break = {Point, Options} -%% Point = {Mod, Line} -%% Options = [Status, Action, null, Cond] -%% Status = active | inactive -%% Cond = null | Function -%%-------------------------------------------------------------------- +-doc """ +Creates a breakpoint at `Line` in `Module`. +""". +-spec break(Module, Line) -> ok | {error, break_exists} + when Module :: module(), Line :: integer(). break(Mod, Line) when is_atom(Mod), is_integer(Line) -> dbg_iserver:safe_call({new_break, {Mod, Line}, [active, enable, null, null]}). +-doc """ +Deletes the breakpoint at `Line` in `Module`. +""". +-spec delete_break(Module, Line) -> ok + when Module :: module(), Line :: integer(). delete_break(Mod, Line) when is_atom(Mod), is_integer(Line) -> dbg_iserver:safe_cast({delete_break, {Mod, Line}}). +-doc """ +break_in(Module, Name, Arity) +Creates a breakpoint at the first line of every clause of function +`Module:Name/Arity`. +""". +-spec break_in(Module, Name, Arity) -> ok | {error, function_not_found} + when Module :: module(), Name :: atom(), Arity :: integer(). break_in(Mod, Func, Arity) when is_atom(Mod), is_atom(Func), is_integer(Arity) -> case dbg_iserver:safe_call({is_interpreted, Mod, Func, Arity}) of {true, Clauses} -> @@ -251,6 +468,16 @@ break_in(Mod, Func, Arity) when is_atom(Mod), is_atom(Func), is_integer(Arity) - {error, function_not_found} end. +-doc """ +Deletes the breakpoints at the first line of every clause of function +`Module:Name/Arity`. +""". +-spec del_break_in(Module, Name, Arity) -> + ok | {error, function_not_found} + when + Module :: module(), + Name :: atom(), + Arity :: integer(). del_break_in(Mod, Func, Arity) when is_atom(Mod), is_atom(Func), is_integer(Arity) -> case dbg_iserver:safe_call({is_interpreted, Mod, Func, Arity}) of {true, Clauses} -> @@ -266,24 +493,52 @@ first_lines(Clauses) -> first_line({clause,_L,_Vars,_,Exprs}) -> first_line(Exprs); +%% erlide patch ------------------------------------------------------ %% Common Test adaptation first_line([{call_remote,0,ct_line,line,_As}|Exprs]) -> first_line(Exprs); +%% erlide patch ------------------------------------------------------ first_line([Expr|_Exprs]) -> % Expr = {Op, Line, ..varying no of args..} element(2, Expr). +-doc """ +Deletes all breakpoints. +""". +-spec no_break() -> ok. no_break() -> dbg_iserver:safe_cast(no_break). +-doc """ +Deletes all breakpoints in `Module`. +""". +-spec no_break(Module :: term()) -> ok. no_break(Mod) when is_atom(Mod) -> dbg_iserver:safe_cast({no_break, Mod}). +-doc """ +Makes the breakpoint at `Line` in `Module` inactive. +""". +-spec disable_break(Module, Line) -> ok + when Module :: module(), Line :: integer(). disable_break(Mod, Line) when is_atom(Mod), is_integer(Line) -> dbg_iserver:safe_cast({break_option, {Mod, Line}, status, inactive}). - + +-doc """ +Makes the breakpoint at `Line` in `Module` active. +""". +-spec enable_break(Module, Line) -> ok + when Module :: module(), Line :: integer(). enable_break(Mod, Line) when is_atom(Mod), is_integer(Line) -> dbg_iserver:safe_cast({break_option, {Mod, Line}, status, active}). +-doc """ +Sets the trigger action of the breakpoint at `Line` in `Module` to `Action`. +""". +-spec action_at_break(Module, Line, Action) -> ok + when + Module :: module(), + Line :: integer(), + Action :: enable | disable | delete. action_at_break(Mod, Line, Action) when is_atom(Mod), is_integer(Line) -> check_action(Action), dbg_iserver:safe_cast({break_option, {Mod, Line}, action, Action}). @@ -292,43 +547,112 @@ check_action(enable) -> true; check_action(disable) -> true; check_action(delete) -> true. +-doc """ +Sets the conditional test of the breakpoint at `Line` in `Module` to `Function`. + +Function `Function` must fulfill the requirements specified in section +[Breakpoints](`m:int#int_breakpoints`). +""". +-spec test_at_break(Module, Line, Function) -> ok when + Module :: module(), + Line :: integer(), + Function :: {Module,Name}, + Name :: atom(). test_at_break(Mod, Line, Function) when is_atom(Mod), is_integer(Line) -> check_function(Function), dbg_iserver:safe_cast({break_option, {Mod, Line}, condition, Function}). check_function({Mod, Func}) when is_atom(Mod), is_atom(Func) -> true. +-doc """ +Retrieves the binding of `Var` from `Bindings`. + +This function is intended to be used by the conditional function of a breakpoint. +""". +-spec get_binding(Var, Bindings) -> {value,Value} | unbound when Var :: atom(), + Bindings :: term(), + Value :: term(). get_binding(Var, Bs) -> dbg_icmd:get_binding(Var, Bs). +-doc "Gets all breakpoints.". +-spec all_breaks() -> [Break] when + Break :: {Point,Options}, + Point :: {Module,Line}, + Module :: module(), + Line :: integer(), + Options :: [Status | Trigger | null | Cond], + Status :: active | inactive, + Trigger :: enable | disable | delete, + Cond :: null | Function, + Function :: {Module,Name}, + Name :: atom(). all_breaks() -> dbg_iserver:safe_call(all_breaks). + +-doc """ +Gets all breakpoints in module `Module`. +""". +-spec all_breaks(Module) -> [Break] when + Break :: {Point,Options}, + Point :: {Module,Line}, + Module :: module(), + Line :: integer(), + Options :: [Status | Trigger | null | Cond], + Status :: active | inactive, + Trigger :: enable | disable | delete, + Cond :: null | Function, + Function :: {Module,Name}, + Name :: atom(). all_breaks(Mod) when is_atom(Mod) -> dbg_iserver:safe_call({all_breaks, Mod}). -%%-------------------------------------------------------------------- -%% snapshot() -> [{Pid, Init, Status, Info}] -%% Pid = pid() -%% Init = atom() First interpreted function -%% Status = idle | running | waiting | break | exit -%% Info = {} | {Mod, Line} | ExitReason -%% Mod = atom() -%% Line = integer() -%% ExitReason = term() -%%-------------------------------------------------------------------- +-doc """ +Gets information about all processes executing interpreted code. + +- `Pid` - Process identifier. +- `Function` - First interpreted function called by the process. +- `Status` - Current status of the process. +- `Info` - More information. + +`Status` is one of the following: + +- `idle` - The process is no longer executing interpreted code. + `Info` is `{}`. +- `running` - The process is running. `Info` is `{}`. +- `waiting` - The process is waiting at a `receive`. `Info` is `{}`. +- `break` - Process execution is stopped, normally at a breakpoint. + `Info` is `{Module,Line}`. +- `exit` - The process is terminated. `Info` is `ExitReason`. +- `no_conn` - The connection is down to the node where the process is running. + `Info` is `{}`. +""". +-spec snapshot() -> [Snapshot] when + Snapshot :: {Pid, Function, Status, Info}, + Pid :: pid(), + Function :: {Module,Name,Args}, + Module :: module(), + Name :: atom(), + Args :: [term()], + Status :: idle | running | waiting | break | exit | no_conn, + Info :: {} | {Module,Line} | ExitReason, + Line :: integer(), + ExitReason :: term(). snapshot() -> dbg_iserver:safe_call(snapshot). -%%-------------------------------------------------------------------- -%% clear() -%%-------------------------------------------------------------------- +-doc """ +Clears information about processes executing interpreted code by removing all +information about terminated processes. +""". +-spec clear() -> ok. clear() -> dbg_iserver:safe_cast(clear). - -%%-------------------------------------------------------------------- -%% continue(Pid) -> ok | {error, not_interpreted} -%% continue(X, Y, Z) -> ok | {error, not_interpreted} -%%-------------------------------------------------------------------- + +-doc """ +Resumes process execution for `Pid`. +""". +-spec continue(Pid :: pid()) -> ok | {error,not_interpreted}. continue(Pid) when is_pid(Pid) -> case dbg_iserver:safe_call({get_meta, Pid}) of {ok, Meta} when is_pid(Meta) -> @@ -337,7 +661,14 @@ continue(Pid) when is_pid(Pid) -> Error -> Error end. - + +-doc """ +Resumes process execution for `c:pid(X, Y, Z)`. +""". +-spec continue(X,Y,Z) -> ok | {error,not_interpreted} when + X :: integer(), + Y :: integer(), + Z :: integer(). continue(X, Y, Z) when is_integer(X), is_integer(Y), is_integer(Z) -> continue(c:pid(X, Y, Z)). @@ -351,7 +682,9 @@ continue(X, Y, Z) when is_integer(X), is_integer(Y), is_integer(Z) -> %% stop() %% Functions for starting and stopping dbg_iserver explicitly. %%-------------------------------------------------------------------- +-doc false. start() -> dbg_iserver:start(). +-doc false. stop() -> lists:foreach( fun(Mod) -> @@ -379,6 +712,7 @@ stop() -> %% {int, {auto_attach, false|{Flags, Function}}} %% {int, {stack_trace, Flag}} %%-------------------------------------------------------------------- +-doc false. subscribe() -> dbg_iserver:cast({subscribe, self()}). %%-------------------------------------------------------------------- @@ -388,6 +722,7 @@ subscribe() -> dbg_iserver:cast({subscribe, self()}). %% Tell dbg_iserver to attach to Pid using Function. Will result in: %% spawn(Mod, Func, [Pid, Status | Args]) %%-------------------------------------------------------------------- +-doc false. attach(Pid, {Mod, Func}) -> attach(Pid, {Mod, Func, []}); attach(Pid, Function) -> @@ -399,12 +734,15 @@ attach(Pid, Function) -> %% (continue(Pid)) %% finish(Pid) %%-------------------------------------------------------------------- +-doc false. step(Pid) -> {ok, Meta} = dbg_iserver:call({get_meta, Pid}), dbg_icmd:step(Meta). +-doc false. next(Pid) -> {ok, Meta} = dbg_iserver:call({get_meta, Pid}), dbg_icmd:next(Meta). +-doc false. finish(Pid) -> {ok, Meta} = dbg_iserver:call({get_meta, Pid}), dbg_icmd:finish(Meta). @@ -421,6 +759,7 @@ finish(Pid) -> %% the meta process and returns its pid. dbg_iserver may also refuse, %% if there already is a process attached to Pid. %%-------------------------------------------------------------------- +-doc false. attached(Pid) -> dbg_iserver:call({attached, self(), Pid}). @@ -438,6 +777,7 @@ attached(Pid) -> %% => {Sp, Mod, {Func, Arity}, Line} %% Cmd = eval Arg = {Cm, Cmd} | {Cm, Cmd, Sp} %%-------------------------------------------------------------------- +-doc false. meta(Meta, step) -> dbg_icmd:step(Meta); meta(Meta, next) -> dbg_icmd:next(Meta); meta(Meta, continue) -> dbg_icmd:continue(Meta); @@ -447,6 +787,7 @@ meta(Meta, timeout) -> dbg_icmd:timeout(Meta); meta(Meta, stop) -> dbg_icmd:stop(Meta); meta(Meta, messages) -> dbg_icmd:get(Meta, messages, null). +-doc false. meta(Meta, trace, Trace) -> dbg_icmd:set(Meta, trace, Trace); meta(Meta, stack_trace, Flag) -> dbg_icmd:set(Meta, stack_trace, Flag); meta(Meta, bindings, Stack) -> dbg_icmd:get(Meta, bindings, Stack); @@ -460,6 +801,7 @@ meta(Meta, eval, Arg) -> dbg_icmd:eval(Meta, Arg). %% Pid = pid() | any %% Return the contents of an interpreted module. %%-------------------------------------------------------------------- +-doc false. contents(Mod, Pid) -> {ok, Bin} = dbg_iserver:call({contents, Mod, Pid}), binary_to_list(Bin). @@ -469,6 +811,7 @@ contents(Mod, Pid) -> %% Mod = Name = atom() %% Arity = integer() %%-------------------------------------------------------------------- +-doc false. functions(Mod) -> [F || F <- dbg_iserver:call({functions, Mod}), functions_1(F)]. @@ -480,6 +823,7 @@ functions_1(_Func) -> true. %% External exports only to be used by error_handler %%==================================================================== +-doc false. eval(Mod, Func, Args) -> dbg_debugged:eval(Mod, Func, Args). @@ -533,8 +877,8 @@ load({Mod, Src, Beam, BeamBin, Exp, Abst}, Dist) -> erts_debug:breakpoint({Mod,'_','_'}, false), {module,Mod} = code:load_binary(Mod, Beam, BeamBin) end), - case erl_prim_loader:get_file(filename:absname(Src)) of - {ok, SrcBin, _} -> + case erl_prim_loader:read_file(filename:absname(Src)) of + {ok, SrcBin} -> MD5 = code:module_md5(BeamBin), SrcBin1 = unicode:characters_to_binary(SrcBin, enc(SrcBin)), true = is_binary(SrcBin1), @@ -673,7 +1017,7 @@ check_beam(BeamBin) when is_binary(BeamBin) -> error end; check_beam(Beam) when is_list(Beam) -> - {ok, Bin, _FullPath} = erl_prim_loader:get_file(filename:absname(Beam)), + {ok, Bin} = erl_prim_loader:read_file(filename:absname(Beam)), check_beam(Bin). is_file(Name) -> @@ -689,8 +1033,7 @@ everywhere(local, Fun) -> scan_module_name(File) -> try - {ok, Bin, _FullPath} = - erl_prim_loader:get_file(filename:absname(File)), + {ok, Bin} = erl_prim_loader:read_file(filename:absname(File)), scan_module_name_1([], <<>>, Bin, enc(Bin)) catch _:_ -> @@ -749,3 +1092,4 @@ del_mod(AbsMod, Dist) -> erlang:yield() end), ok. + diff --git a/eclipse/build b/eclipse/build index b28a9da..15cf8ca 100755 --- a/eclipse/build +++ b/eclipse/build @@ -13,18 +13,18 @@ rm -rf org.erlide.kernel.ide/ebin mkdir -p org.erlide.kernel.common/ebin mkdir -p org.erlide.kernel.debugger/ebin -mkdir -p org.erlide.kernel.debugger/ebin/23 -mkdir -p org.erlide.kernel.debugger/ebin/24 mkdir -p org.erlide.kernel.debugger/ebin/25 +mkdir -p org.erlide.kernel.debugger/ebin/26 +mkdir -p org.erlide.kernel.debugger/ebin/27 mkdir -p org.erlide.kernel.ide/ebin # what if we keep the otp app structure? /priv might be useful find ../common/_build/default/lib -type f \( -name "*.beam" -o -name "*.app" \) -exec cp {} org.erlide.kernel.common/ebin/ \; -find ../debugger/erlide_debugger/_build/default/lib -type f \( -name "*.beam" -o -name "*.app" \) ! -path "*/erlide_debugger_23/*" -exec cp {} org.erlide.kernel.debugger/ebin/ \; -find ../debugger/erlide_debugger_23/_build/default/lib -type f \( -name "*.beam" -o -name "*.app" \) -exec cp {} org.erlide.kernel.debugger/ebin/23/ \; -find ../debugger/erlide_debugger_24/_build/default/lib -type f \( -name "*.beam" -o -name "*.app" \) -exec cp {} org.erlide.kernel.debugger/ebin/24/ \; +find ../debugger/erlide_debugger/_build/default/lib -type f \( -name "*.beam" -o -name "*.app" \) ! -path "*/erlide_debugger_25/*" -exec cp {} org.erlide.kernel.debugger/ebin/ \; find ../debugger/erlide_debugger_25/_build/default/lib -type f \( -name "*.beam" -o -name "*.app" \) -exec cp {} org.erlide.kernel.debugger/ebin/25/ \; +find ../debugger/erlide_debugger_26/_build/default/lib -type f \( -name "*.beam" -o -name "*.app" \) -exec cp {} org.erlide.kernel.debugger/ebin/26/ \; +find ../debugger/erlide_debugger_27/_build/default/lib -type f \( -name "*.beam" -o -name "*.app" \) -exec cp {} org.erlide.kernel.debugger/ebin/27/ \; find ../ide/_build/default/lib -type f \( -name "*.beam" -o -name "*.app" \) -exec cp {} org.erlide.kernel.ide/ebin/ \; VSN=`get_feature_vsn org.erlide.kernel.feature` diff --git a/eclipse/org.erlide.kernel.common/META-INF/MANIFEST.MF b/eclipse/org.erlide.kernel.common/META-INF/MANIFEST.MF index 7bd08d9..15d77b1 100644 --- a/eclipse/org.erlide.kernel.common/META-INF/MANIFEST.MF +++ b/eclipse/org.erlide.kernel.common/META-INF/MANIFEST.MF @@ -2,7 +2,7 @@ Manifest-Version: 1.0 Bundle-ManifestVersion: 2 Bundle-Name: Erlide Kernel Bundle-SymbolicName: org.erlide.kernel.common;singleton:=true -Bundle-Version: 0.117.0.qualifier +Bundle-Version: 0.118.0.qualifier Bundle-Vendor: erlide.org project Bundle-RequiredExecutionEnvironment: JavaSE-1.6 Eclipse-BundleShape: dir diff --git a/eclipse/org.erlide.kernel.common/pom.xml b/eclipse/org.erlide.kernel.common/pom.xml index 1879d3f..e926241 100644 --- a/eclipse/org.erlide.kernel.common/pom.xml +++ b/eclipse/org.erlide.kernel.common/pom.xml @@ -8,6 +8,6 @@ org.erlide.kernel.common - 0.117.0-SNAPSHOT + 0.118.0-SNAPSHOT eclipse-plugin diff --git a/eclipse/org.erlide.kernel.debugger/META-INF/MANIFEST.MF b/eclipse/org.erlide.kernel.debugger/META-INF/MANIFEST.MF index 535c9b8..322d92d 100644 --- a/eclipse/org.erlide.kernel.debugger/META-INF/MANIFEST.MF +++ b/eclipse/org.erlide.kernel.debugger/META-INF/MANIFEST.MF @@ -2,7 +2,7 @@ Manifest-Version: 1.0 Bundle-ManifestVersion: 2 Bundle-Name: Erlide Kernel Bundle-SymbolicName: org.erlide.kernel.debugger;singleton:=true -Bundle-Version: 0.117.0.qualifier +Bundle-Version: 0.118.0.qualifier Bundle-Vendor: erlide.org project Bundle-RequiredExecutionEnvironment: JavaSE-1.6 Eclipse-BundleShape: dir diff --git a/eclipse/org.erlide.kernel.debugger/build.properties b/eclipse/org.erlide.kernel.debugger/build.properties index bd25cb1..2bc314a 100644 --- a/eclipse/org.erlide.kernel.debugger/build.properties +++ b/eclipse/org.erlide.kernel.debugger/build.properties @@ -1,3 +1,3 @@ -bin.includes = META-INF/, ebin/, ebin/23/, ebin/24/, ebin/25/, plugin.xml +bin.includes = META-INF/, ebin/, ebin/25/, ebin/26/, ebin/27/, plugin.xml jars.compile.order = . source.. = / diff --git a/eclipse/org.erlide.kernel.debugger/plugin.xml b/eclipse/org.erlide.kernel.debugger/plugin.xml index a00b86b..367b96f 100644 --- a/eclipse/org.erlide.kernel.debugger/plugin.xml +++ b/eclipse/org.erlide.kernel.debugger/plugin.xml @@ -6,22 +6,22 @@ + otp_version="25"> + otp_version="25"> + otp_version="26"> + otp_version="27"> ​ diff --git a/eclipse/org.erlide.kernel.debugger/pom.xml b/eclipse/org.erlide.kernel.debugger/pom.xml index 39740db..967ed31 100644 --- a/eclipse/org.erlide.kernel.debugger/pom.xml +++ b/eclipse/org.erlide.kernel.debugger/pom.xml @@ -8,6 +8,6 @@ org.erlide.kernel.debugger - 0.117.0-SNAPSHOT + 0.118.0-SNAPSHOT eclipse-plugin diff --git a/eclipse/org.erlide.kernel.feature/feature.xml b/eclipse/org.erlide.kernel.feature/feature.xml index b0df9e1..635c184 100644 --- a/eclipse/org.erlide.kernel.feature/feature.xml +++ b/eclipse/org.erlide.kernel.feature/feature.xml @@ -2,7 +2,7 @@ diff --git a/eclipse/org.erlide.kernel.feature/pom.xml b/eclipse/org.erlide.kernel.feature/pom.xml index dbd82fe..f18f8ef 100644 --- a/eclipse/org.erlide.kernel.feature/pom.xml +++ b/eclipse/org.erlide.kernel.feature/pom.xml @@ -12,7 +12,7 @@ org.erlide.kernel.feature - 0.117.0-SNAPSHOT + 0.118.0-SNAPSHOT eclipse-feature diff --git a/eclipse/org.erlide.kernel.ide/META-INF/MANIFEST.MF b/eclipse/org.erlide.kernel.ide/META-INF/MANIFEST.MF index a499380..0341139 100644 --- a/eclipse/org.erlide.kernel.ide/META-INF/MANIFEST.MF +++ b/eclipse/org.erlide.kernel.ide/META-INF/MANIFEST.MF @@ -2,7 +2,7 @@ Manifest-Version: 1.0 Bundle-ManifestVersion: 2 Bundle-Name: Erlide Kernel Bundle-SymbolicName: org.erlide.kernel.ide;singleton:=true -Bundle-Version: 0.117.0.qualifier +Bundle-Version: 0.118.0.qualifier Bundle-Vendor: erlide.org project Bundle-RequiredExecutionEnvironment: JavaSE-1.6 Eclipse-BundleShape: dir diff --git a/eclipse/org.erlide.kernel.ide/pom.xml b/eclipse/org.erlide.kernel.ide/pom.xml index d3a672d..e8d5746 100644 --- a/eclipse/org.erlide.kernel.ide/pom.xml +++ b/eclipse/org.erlide.kernel.ide/pom.xml @@ -8,6 +8,6 @@ org.erlide.kernel.ide - 0.117.0-SNAPSHOT + 0.118.0-SNAPSHOT eclipse-plugin diff --git a/eclipse/org.erlide.kernel.site/pom.xml b/eclipse/org.erlide.kernel.site/pom.xml index d75edb3..d257ea9 100644 --- a/eclipse/org.erlide.kernel.site/pom.xml +++ b/eclipse/org.erlide.kernel.site/pom.xml @@ -13,5 +13,5 @@ org.erlide.kernel.site eclipse-repository -0.117.0-SNAPSHOT +0.118.0-SNAPSHOT diff --git a/ide/apps/erlide_ide/src/erlide_ide.app.src b/ide/apps/erlide_ide/src/erlide_ide.app.src index 4f6c4e9..8ce14ac 100644 --- a/ide/apps/erlide_ide/src/erlide_ide.app.src +++ b/ide/apps/erlide_ide/src/erlide_ide.app.src @@ -1,7 +1,7 @@ {application, erlide_ide, [ {description,"erlide_ide"}, - {vsn, "0.117.0"}, + {vsn, "0.118.0"}, {erlide_context, ide}, {registered, []}, {applications, [kernel, stdlib, erlide_common, erlide_ide_core]}, diff --git a/ide/apps/erlide_ide_core/src/erlide_ide_core.app.src b/ide/apps/erlide_ide_core/src/erlide_ide_core.app.src index a3b2569..fa4326e 100644 --- a/ide/apps/erlide_ide_core/src/erlide_ide_core.app.src +++ b/ide/apps/erlide_ide_core/src/erlide_ide_core.app.src @@ -1,7 +1,7 @@ {application, erlide_ide_core, [ {description,"erlide_ide_core"}, - {vsn, "0.117.0"}, + {vsn, "0.118.0"}, {erlide_context, ide}, {registered, []}, {applications, [kernel, stdlib, erlide_common]}, diff --git a/ide/build b/ide/build index 2d65d0d..56dd966 100755 --- a/ide/build +++ b/ide/build @@ -8,4 +8,4 @@ prj=`basename $dir` export LOCALDEP_DIR=`pwd` export REBAR_COLOR="low" -build_project ../rebar3 $prj 23 "$@" +build_project ../rebar3 $prj 25 "$@" diff --git a/ide/rebar.config b/ide/rebar.config index 0810834..a6b945a 100644 --- a/ide/rebar.config +++ b/ide/rebar.config @@ -1,4 +1,4 @@ -{require_otp_vsn, "23.*"}. +{require_otp_vsn, "25.*"}. {plugins, [ {rebar_localdep, {git, "https://github.com/alinpopa/rebar3-localdep-plugin.git", {branch, "master"}}}, diff --git a/rebar3 b/rebar3 old mode 100644 new mode 100755 index ed2a36d..762dc0b Binary files a/rebar3 and b/rebar3 differ