The R13B03 release.OTP_R13B03

1 files changed, 199 insertions, 0 deletions

diff --git a/lib/test_server/src/things/verify.erl b/lib/test_server/src/things/verify.erl
new file mode 100644
index 0000000000..eac20c013e
--- /dev/null
+++ b/lib/test_server/src/things/verify.erl
@@ -0,0 +1,199 @@
+%%
+%% %CopyrightBegin%
+%% 
+%% Copyright Ericsson AB 1996-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(verify).
+
+-export([dir/0, dir/1]).
+
+%% usage verify:dir()
+%% or    verify:dir(Dir)
+%% 
+%% runs tests on all files with the extension ".t1"
+%% creates an error log file verify.log in the directory where the
+%% tests were run
+
+-import(lists, [reverse/1, foldl/3, map/2]).
+
+dir() ->
+    dir(".").
+
+dir(Dir) ->
+    case file:list_dir(Dir) of
+	{ok, Files} ->
+	    VFiles = collect_vers(Files, []),
+	    VFiles1 = map(fun(F) -> Dir ++ "/" ++ F end, VFiles),
+	    Nerrs = foldl(fun(F, Sum) -> 
+				  case file(F) of
+				      {file,_,had,N,errors} ->
+					  Sum + N;
+				      no_errors ->
+					  Sum;
+				      Other ->
+					  Sum + 1
+				  end
+			  end, 0, VFiles1),
+	    case Nerrs of
+		0 -> no_errors;
+		_ -> {dir,Dir,had,Nerrs,errors}
+	    end;
+	_ ->
+	    {error, cannot,list_dir, Dir}
+    end.
+
+collect_vers([H|T], L) ->
+    case reverse(H) of
+	[$1,$t,$.|T1] -> collect_vers(T, [reverse(T1)|L]);
+	_             -> collect_vers(T, L)
+    end;
+collect_vers([], L) ->
+    L.
+
+file(File) ->
+    case file:open(File ++ ".t1", read) of
+	{ok, S} ->
+	    io:format("Verifying: ~s\n", [File]),
+	    ErrFile = File ++ ".errs",
+	    {ok, E} = file:open(ErrFile, write),
+	    Bind0 = erl_eval:new_bindings(),
+	    NErrs = do(S, {E, File, Bind0, 0}, 1),
+	    file:close(S),
+	    file:close(E),
+	    case NErrs of
+		0 ->
+		    file:delete(ErrFile),
+		    no_errors;
+		_ ->
+		    {file,File,had,NErrs,errors}
+	    end;
+	_ ->
+	    error_in_opening_file
+    end.
+
+do(S, Env, Line) ->
+    R = io:scan_erl_exprs(S, '', Line),
+    do1(R, S, Env).
+
+do1({eof,_}, _, {_,_,_,NErrs}) ->
+    NErrs;
+do1({ok,Toks,Next}, S, Env0) ->
+    E1 = handle_toks(Toks, Next, Env0),
+    do(S, E1, Next);
+do1({error, {Line,Mod,Args}, Next}, S, E) ->
+    io:format("*** ~w ~p~n", [Line,Mod:format_error(Args)]),
+    E1 = add_error(E),
+    do(S, E1, Next).
+
+add_error({Stream, File, Bindings, N}) -> {Stream, File, Bindings, N+1}.
+
+handle_toks(Toks, Line, Env0) ->
+    %% io:format("Toks:~p\n", [Toks]).
+    case erl_parse:parse_exprs(Toks) of
+	{ok, Exprs} ->
+	    %% io:format("Got:~p\n", [Exprs]),
+	    eval(Exprs, Line, Env0);
+	{error, {LineNo, Mod, What}} ->
+	    Str = apply(Mod, format_error, [What]),
+	    io:format("*** Line:~w  ***~s\n", [LineNo, Str]),
+	    add_error(Env0);
+	Parse_error ->
+	    io:format("Parse Error:~p\n",[Parse_error]),
+ 	    add_error(Env0)
+    end.
+
+forget([{var,_,Name}], B0) -> erl_eval:del_binding(Name, B0);
+forget([], _)              -> erl_eval:new_bindings().
+
+eval([{call,_,{atom,_,f}, Args}], _, {Stream, Bind0, Errs}) ->
+    Bind1 = forget(Args, Bind0),
+    {Stream, Bind1, Errs};
+eval(Exprs, Line, {Stream, File, Bind0, NErrs}) ->
+    %% io:format("Bindings >> ~p\n", [Bind0]),
+    %% io:format("Exprs >> ~p\n", [Exprs]),
+    case catch erl_eval:exprs(Exprs, Bind0) of
+	{'EXIT', Reason} ->
+	    out_both(Stream, "----------------------------------~n", []),
+	    out_both(Stream, "File:~s Error in:~s~n", [File, pp(Exprs)]),
+	    print_bindings(Stream, Exprs, Bind0),
+	    print_lhs(Stream, Exprs),
+	    out_both(Stream, '*** Rhs evaluated to:~p~n',[rhs(Exprs, Bind0)]),
+	    {Stream, File, Bind0, NErrs+1};
+	{value, _, Bind1} ->
+	    {Stream, File, Bind1, NErrs}
+    end.
+
+pp([H])   -> erl_pp:expr(H);
+pp([H|T]) -> [erl_pp:expr(H),$,|pp(T)];
+pp([])    -> [].
+
+print_bindings(E, Form, Bindings) ->
+    case varsin(Form) of
+	[] ->
+	    true;
+	Vars ->
+	    print_vars(E, Vars, Bindings)
+    end.
+
+print_vars(E, [Var|T], Bindings) ->
+    case erl_eval:binding(Var, Bindings) of
+	{value, Val} ->
+	    out_both(E, '~s = ~p\n',[Var, Val]);
+	unbound ->
+	    out_both(E, '~s *is unbound*\n', [Var])
+    end,
+    print_vars(E, T, Bindings);
+print_vars(_, [], _) ->
+    true.
+
+
+out_both(E, Format, Data) ->
+    io:format(Format, Data),
+    io:format(E, Format, Data).
+
+print_lhs(E, [{match, _, Lhs, Rhs}]) ->
+    %% io:format(">>>> here:~w\n",[Lhs]),
+    out_both(E, '*** Lhs was:~s\n',[erl_pp:expr(Lhs)]);
+print_lhs(E, _) ->
+    out_both(E, '** UNDEFINED **', []).
+
+
+rhs([{match, _, Lhs, Rhs}], Bindings) ->
+    case catch erl_eval:exprs([Rhs], Bindings) of
+	{value, Val, _} -> Val;
+	Other           ->  undefined()
+    end;
+rhs(_, _) ->
+    undefined().
+
+varsin(X) -> varsin(X, []).
+
+varsin({var,_,'_'}, L) ->
+    L;
+varsin({var,_,V}, L) ->
+    case lists:member(V, L) of
+	true  -> L;
+	false -> [V|L]
+    end;
+varsin([H|T], L) ->
+    varsin(T, varsin(H, L));
+varsin(T, L) when tuple(T) ->
+    varsin(tuple_to_list(T), L);
+varsin(_, L) ->
+    L.
+    
+undefined() ->
+    '** UNDEFINED **'.