diff options
Diffstat (limited to 'lib/test_server/src/test_server_line.erl')
| -rw-r--r-- | lib/test_server/src/test_server_line.erl | 380 |
1 files changed, 380 insertions, 0 deletions
diff --git a/lib/test_server/src/test_server_line.erl b/lib/test_server/src/test_server_line.erl new file mode 100644 index 0000000000..26ef3a3040 --- /dev/null +++ b/lib/test_server/src/test_server_line.erl @@ -0,0 +1,380 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +-module(test_server_line). + +%% User interface +-export([get_lines/0]). +-export([clear/0]). + +%% Parse transform functions +-export([parse_transform/2]). +-export(['$test_server_line'/3]). +-export(['$test_server_lineQ'/3]). +-export([trace_line/3]). + +-define(TEST_SERVER_LINE_SIZE, 10). +%-define(STORAGE_FUNCTION, '$test_server_line'). +-define(STORAGE_FUNCTION, '$test_server_lineQ'). + +-include("test_server.hrl"). + +-record(vars, {module, % atom() Module name + function, % atom() Function name + arity, % int() Function arity + lines, % [int()] seen lines + is_guard=false, % boolean() + no_lines=[], % [{atom(),integer()}] + % Functions to exclude + line_trace=false + }). + + + + +%% Process dictionary littering variant +%% + +'$test_server_line'(Mod, Func, Line) -> + {Prev,Next} = + case get('$test_server_line') of + I when is_integer(I) -> + if 1 =< I, I < ?TEST_SERVER_LINE_SIZE -> {I,I+1}; + true -> {?TEST_SERVER_LINE_SIZE,1} + end; + _ -> {?TEST_SERVER_LINE_SIZE,1} + end, + PrevTag = {'$test_server_line',Prev}, + case get(PrevTag) of + {Mod,Func,_} -> put(PrevTag, {Mod,Func,Line}); + _ -> + put({'$test_server_line',Next}, {Mod,Func,Line}), + put('$test_server_line', Next) + end, ok. + +test_server_line_get() -> + case get('$test_server_line') of + I when is_integer(I), 1 =< I, I =< ?TEST_SERVER_LINE_SIZE -> + test_server_line_get_1(?TEST_SERVER_LINE_SIZE, I, []); + _ -> [] + end. + +test_server_line_get_1(0, _I, R) -> + R; +test_server_line_get_1(Cnt, I, R) -> + J = if I < ?TEST_SERVER_LINE_SIZE -> I+1; + true -> 1 end, + case get({'$test_server_line',J}) of + undefined -> + %% Less than ?TEST_SERVER_LINE_SIZE number of lines stored + %% Start from line 1 and stop at actutual number of lines + case get({'$test_server_line',1}) of + undefined -> R; % no lines at all stored + E -> test_server_line_get_1(I-1,1,[E|R]) + end; + E -> + test_server_line_get_1(Cnt-1, J, [E|R]) + end. + +test_server_line_clear() -> + Is = lists:seq(1,?TEST_SERVER_LINE_SIZE), + lists:foreach(fun (I) -> erase({'$test_server_line',I}) end, Is), + erase('$test_server_line'), + ok. + + +%% Queue variant, uses just one process dictionary entry +%% + +'$test_server_lineQ'(Mod, Func, Line) -> + case get('$test_server_lineQ') of + {I,Q} when is_integer(I), 1 =< I, I =< ?TEST_SERVER_LINE_SIZE -> + case queue:head(Q) of + {Mod,Func,_} -> + %% Replace queue head + put('$test_server_lineQ', + {I,queue:cons({Mod,Func,Line}, queue:tail(Q))}); + _ when I < ?TEST_SERVER_LINE_SIZE -> + put('$test_server_lineQ', + {I+1,queue:cons({Mod,Func,Line}, Q)}); + _ -> + %% Waste last in queue + put('$test_server_lineQ', + {I,queue:cons({Mod,Func,Line}, queue:lait(Q))}) + end; + _ -> + Q = queue:new(), + put('$test_server_lineQ', {1,queue:cons({Mod,Func,Line}, Q)}) + end, ok. + +%test_server_lineQ_get() -> +% case get('$test_server_lineQ') of +% {I,Q} when integer(I), 1 =< I, I =< ?TEST_SERVER_LINE_SIZE -> +% queue:to_list(Q); +% _ -> [] +% end. + +test_server_lineQ_clear() -> + erase('$test_server_lineQ'), + ok. + + +%% Get line - check if queue or dictionary is used, then get the lines +%% + +get_lines() -> + case get('$test_server_lineQ') of + {I,Q} when is_integer(I), 1 =< I, I =< ?TEST_SERVER_LINE_SIZE -> + queue:to_list(Q); + _ -> + test_server_line_get() + end. + +%% Clear all dictionary entries +%% +clear() -> + test_server_line_clear(), + test_server_lineQ_clear(). + + +trace_line(Mod,Func,Line) -> + io:format(lists:concat([Mod,":",Func,",",integer_to_list(Line),": ~p"]), + [erlang:now()]). + + +%%%================================================================= +%%%========= **** PARSE TRANSFORM **** ======================== +%%%================================================================= +parse_transform(Forms, _Options) -> + transform(Forms, _Options). + +%% forms(Fs) -> lists:map(fun (F) -> form(F) end, Fs). + +transform(Forms, _Options)-> + Vars0 = #vars{}, + {ok, MungedForms, _Vars} = transform(Forms, [], Vars0), + MungedForms. + + +transform([Form|Forms], MungedForms, Vars) -> + case munge(Form, Vars) of + ignore -> + transform(Forms, MungedForms, Vars); + {MungedForm, Vars2} -> + transform(Forms, [MungedForm|MungedForms], Vars2) + end; +transform([], MungedForms, Vars) -> + {ok, lists:reverse(MungedForms), Vars}. + +%% This code traverses the abstract code, stored as the abstract_code +%% chunk in the BEAM file, as described in absform(3) for Erlang/OTP R8B +%% (Vsn=abstract_v2). +%% The abstract format after preprocessing differs slightly from the abstract +%% format given eg using epp:parse_form, this has been noted in comments. +munge(Form={attribute,_,module,Module}, Vars) -> + Vars2 = Vars#vars{module=Module}, + {Form, Vars2}; + +munge(Form={attribute,_,no_lines,Funcs}, Vars) -> + Vars2 = Vars#vars{no_lines=Funcs}, + {Form, Vars2}; + +munge(Form={attribute,_,line_trace,_}, Vars) -> + Vars2 = Vars#vars{line_trace=true}, + {Form, Vars2}; + +munge({function,0,module_info,_Arity,_Clauses}, _Vars) -> + ignore; % module_info will be added again when the forms are recompiled +munge(Form = {function,Line,Function,Arity,Clauses}, Vars) -> + case lists:member({Function,Arity},Vars#vars.no_lines) of + true -> + %% Line numbers in this function shall not be stored + {Form,Vars}; + false -> + Vars2 = Vars#vars{function=Function, + arity=Arity, + lines=[]}, + {MungedClauses, Vars3} = munge_clauses(Clauses, Vars2, []), + {{function,Line,Function,Arity,MungedClauses}, Vars3} + end; +munge(Form, Vars) -> % attributes + {Form, Vars}. + +munge_clauses([{clause,Line,Pattern,Guards,Body}|Clauses], Vars, MClauses) -> + {MungedGuards, _Vars} = munge_exprs(Guards, Vars#vars{is_guard=true},[]), + {MungedBody, Vars2} = munge_body(Body, Vars, []), + munge_clauses(Clauses, Vars2, + [{clause,Line,Pattern,MungedGuards,MungedBody}| + MClauses]); +munge_clauses([], Vars, MungedClauses) -> + {lists:reverse(MungedClauses), Vars}. + +munge_body([Expr|Body], Vars, MungedBody) -> + %% Here is the place to add a call to storage function! + Line = element(2, Expr), + Lines = Vars#vars.lines, + case lists:member(Line,Lines) of + true -> % already a bump at this line! + {MungedExpr, Vars2} = munge_expr(Expr, Vars), + munge_body(Body, Vars2, [MungedExpr|MungedBody]); + false -> + Bump = {call, 0, {remote,0, + {atom,0,?MODULE}, + {atom,0,?STORAGE_FUNCTION}}, + [{atom,0,Vars#vars.module}, + {atom, 0, Vars#vars.function}, + {integer, 0, Line}]}, + Lines2 = [Line|Lines], + + {MungedExpr, Vars2} = munge_expr(Expr, Vars#vars{lines=Lines2}), + MungedBody2 = + if Vars#vars.line_trace -> + LineTrace = {call, 0, {remote,0, + {atom,0,?MODULE}, + {atom,0,trace_line}}, + [{atom,0,Vars#vars.module}, + {atom, 0, Vars#vars.function}, + {integer, 0, Line}]}, + [MungedExpr,LineTrace,Bump|MungedBody]; + true -> + [MungedExpr,Bump|MungedBody] + end, + munge_body(Body, Vars2, MungedBody2) + end; +munge_body([], Vars, MungedBody) -> + {lists:reverse(MungedBody), Vars}. + +munge_expr({match,Line,ExprL,ExprR}, Vars) -> + {MungedExprL, Vars2} = munge_expr(ExprL, Vars), + {MungedExprR, Vars3} = munge_expr(ExprR, Vars2), + {{match,Line,MungedExprL,MungedExprR}, Vars3}; +munge_expr({tuple,Line,Exprs}, Vars) -> + {MungedExprs, Vars2} = munge_exprs(Exprs, Vars, []), + {{tuple,Line,MungedExprs}, Vars2}; +munge_expr({record,Line,Expr,Exprs}, Vars) -> + %% Only for Vsn=raw_abstract_v1 + {MungedExprName, Vars2} = munge_expr(Expr, Vars), + {MungedExprFields, Vars3} = munge_exprs(Exprs, Vars2, []), + {{record,Line,MungedExprName,MungedExprFields}, Vars3}; +munge_expr({record_field,Line,ExprL,ExprR}, Vars) -> + %% Only for Vsn=raw_abstract_v1 + {MungedExprL, Vars2} = munge_expr(ExprL, Vars), + {MungedExprR, Vars3} = munge_expr(ExprR, Vars2), + {{record_field,Line,MungedExprL,MungedExprR}, Vars3}; +munge_expr({cons,Line,ExprH,ExprT}, Vars) -> + {MungedExprH, Vars2} = munge_expr(ExprH, Vars), + {MungedExprT, Vars3} = munge_expr(ExprT, Vars2), + {{cons,Line,MungedExprH,MungedExprT}, Vars3}; +munge_expr({op,Line,Op,ExprL,ExprR}, Vars) -> + {MungedExprL, Vars2} = munge_expr(ExprL, Vars), + {MungedExprR, Vars3} = munge_expr(ExprR, Vars2), + {{op,Line,Op,MungedExprL,MungedExprR}, Vars3}; +munge_expr({op,Line,Op,Expr}, Vars) -> + {MungedExpr, Vars2} = munge_expr(Expr, Vars), + {{op,Line,Op,MungedExpr}, Vars2}; +munge_expr({'catch',Line,Expr}, Vars) -> + {MungedExpr, Vars2} = munge_expr(Expr, Vars), + {{'catch',Line,MungedExpr}, Vars2}; +munge_expr({call,Line1,{remote,Line2,ExprM,ExprF},Exprs}, + Vars) when Vars#vars.is_guard==false-> + {MungedExprM, Vars2} = munge_expr(ExprM, Vars), + {MungedExprF, Vars3} = munge_expr(ExprF, Vars2), + {MungedExprs, Vars4} = munge_exprs(Exprs, Vars3, []), + {{call,Line1,{remote,Line2,MungedExprM,MungedExprF},MungedExprs}, Vars4}; +munge_expr({call,Line1,{remote,_Line2,_ExprM,ExprF},Exprs}, + Vars) when Vars#vars.is_guard==true -> + %% Difference in abstract format after preprocessing: BIF calls in guards + %% are translated to {remote,...} (which is not allowed as source form) + %% NOT NECESSARY FOR Vsn=raw_abstract_v1 + munge_expr({call,Line1,ExprF,Exprs}, Vars); +munge_expr({call,Line,Expr,Exprs}, Vars) -> + {MungedExpr, Vars2} = munge_expr(Expr, Vars), + {MungedExprs, Vars3} = munge_exprs(Exprs, Vars2, []), + {{call,Line,MungedExpr,MungedExprs}, Vars3}; +munge_expr({lc,Line,Expr,LC}, Vars) -> + {MungedExpr, Vars2} = munge_expr(Expr, Vars), + {MungedLC, Vars3} = munge_lc(LC, Vars2, []), + {{lc,Line,MungedExpr,MungedLC}, Vars3}; +munge_expr({block,Line,Body}, Vars) -> + {MungedBody, Vars2} = munge_body(Body, Vars, []), + {{block,Line,MungedBody}, Vars2}; +munge_expr({'if',Line,Clauses}, Vars) -> + {MungedClauses,Vars2} = munge_clauses(Clauses, Vars, []), + {{'if',Line,MungedClauses}, Vars2}; +munge_expr({'case',Line,Expr,Clauses}, Vars) -> + {MungedExpr,Vars2} = munge_expr(Expr,Vars), + {MungedClauses,Vars3} = munge_clauses(Clauses, Vars2, []), + {{'case',Line,MungedExpr,MungedClauses}, Vars3}; +munge_expr({'receive',Line,Clauses}, Vars) -> + {MungedClauses,Vars2} = munge_clauses(Clauses, Vars, []), + {{'receive',Line,MungedClauses}, Vars2}; +munge_expr({'receive',Line,Clauses,Expr,Body}, Vars) -> + {MungedClauses,Vars2} = munge_clauses(Clauses, Vars, []), + {MungedExpr, Vars3} = munge_expr(Expr, Vars2), + {MungedBody, Vars4} = munge_body(Body, Vars3, []), + {{'receive',Line,MungedClauses,MungedExpr,MungedBody}, Vars4}; +munge_expr({'try',Line,Exprs,Clauses,CatchClauses,After}, Vars) -> + {MungedExprs, Vars1} = munge_exprs(Exprs, Vars, []), + {MungedClauses, Vars2} = munge_clauses(Clauses, Vars1, []), + {MungedCatchClauses, Vars3} = munge_clauses(CatchClauses, Vars2, []), + {MungedAfter, Vars4} = munge_body(After, Vars3, []), + {{'try',Line,MungedExprs,MungedClauses,MungedCatchClauses,MungedAfter}, + Vars4}; +%% Difference in abstract format after preprocessing: Funs get an extra +%% element Extra. +%% NOT NECESSARY FOR Vsn=raw_abstract_v1 +munge_expr({'fun',Line,{function,Name,Arity},_Extra}, Vars) -> + {{'fun',Line,{function,Name,Arity}}, Vars}; +munge_expr({'fun',Line,{clauses,Clauses},_Extra}, Vars) -> + {MungedClauses,Vars2}=munge_clauses(Clauses, Vars, []), + {{'fun',Line,{clauses,MungedClauses}}, Vars2}; +munge_expr({'fun',Line,{clauses,Clauses}}, Vars) -> + %% Only for Vsn=raw_abstract_v1 + {MungedClauses,Vars2}=munge_clauses(Clauses, Vars, []), + {{'fun',Line,{clauses,MungedClauses}}, Vars2}; +munge_expr(Form, Vars) -> % var|char|integer|float|string|atom|nil|bin|eof + {Form, Vars}. + +munge_exprs([Expr|Exprs], Vars, MungedExprs) when Vars#vars.is_guard==true, + is_list(Expr) -> + {MungedExpr, _Vars} = munge_exprs(Expr, Vars, []), + munge_exprs(Exprs, Vars, [MungedExpr|MungedExprs]); +munge_exprs([Expr|Exprs], Vars, MungedExprs) -> + {MungedExpr, Vars2} = munge_expr(Expr, Vars), + munge_exprs(Exprs, Vars2, [MungedExpr|MungedExprs]); +munge_exprs([], Vars, MungedExprs) -> + {lists:reverse(MungedExprs), Vars}. + +munge_lc([{generate,Line,Pattern,Expr}|LC], Vars, MungedLC) -> + {MungedExpr, Vars2} = munge_expr(Expr, Vars), + munge_lc(LC, Vars2, [{generate,Line,Pattern,MungedExpr}|MungedLC]); +munge_lc([Expr|LC], Vars, MungedLC) -> + {MungedExpr, Vars2} = munge_expr(Expr, Vars), + munge_lc(LC, Vars2, [MungedExpr|MungedLC]); +munge_lc([], Vars, MungedLC) -> + {lists:reverse(MungedLC), Vars}. + + + + + + + + + + |