The R13B03 release.OTP_R13B03

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}.
+
+
+
+
+
+
+
+
+
+