Test suites for Dialyzer

This is a transcription of most of the cvs.srv.it.uu.se:/hipe repository
dialyzer_tests into test suites that use the test server framework.

See README for information on how to use the included scripts for
modifications and updates.

When testing Dialyzer it's important that several OTP modules
are included in the plt. The suites takes care of that too.

1 files changed, 490 insertions, 0 deletions

diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_esi.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_esi.erl
new file mode 100644
index 0000000000..d527f36788
--- /dev/null
+++ b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_esi.erl
@@ -0,0 +1,490 @@
+%% ``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 via the world wide web 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.
+%% 
+%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
+%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
+%% AB. All Rights Reserved.''
+%% 
+%%     $Id: mod_esi.erl,v 1.1 2008/12/17 09:53:35 mikpe Exp $
+%%
+-module(mod_esi).
+-export([do/1,load/2]).
+
+%%Functions provided to help erl scheme alias programmer to 
+%%Create dynamic webpages that are sent back to the user during 
+%%Generation
+-export([deliver/2]).
+
+
+-include("httpd.hrl").
+
+-define(VMODULE,"ESI").
+-include("httpd_verbosity.hrl").
+
+-define(GATEWAY_INTERFACE,"CGI/1.1").
+-define(DEFAULT_ERL_TIMEOUT,15000).
+%% do
+
+do(Info) ->
+    ?vtrace("do",[]),
+    case httpd_util:key1search(Info#mod.data,status) of
+	%% A status code has been generated!
+	{StatusCode,PhraseArgs,Reason} ->
+	    {proceed,Info#mod.data};
+	%% No status code has been generated!
+	undefined ->
+	    case httpd_util:key1search(Info#mod.data,response) of
+		%% No response has been generated!
+		undefined ->
+		    case erl_or_eval(Info#mod.request_uri,
+				     Info#mod.config_db) of
+			{eval,CGIBody,Modules} ->
+			    eval(Info,Info#mod.method,CGIBody,Modules);
+			{erl,CGIBody,Modules} ->
+			    erl(Info,Info#mod.method,CGIBody,Modules);
+			proceed ->
+			    {proceed,Info#mod.data}
+		    end;
+		%% A response has been generated or sent!
+		Response ->
+		    {proceed,Info#mod.data}
+	    end
+    end.
+
+	    
+
+%% erl_or_eval
+
+erl_or_eval(RequestURI, ConfigDB) ->
+    case erlp(RequestURI, ConfigDB) of
+	false ->
+	    case evalp(RequestURI, ConfigDB) of
+		false ->
+		    ?vtrace("neither erl nor eval",[]),
+		    proceed;
+		Other ->
+		    Other
+	    end;
+	Other ->
+	    Other
+    end.
+
+erlp(RequestURI, ConfigDB) ->
+    case httpd_util:multi_lookup(ConfigDB, erl_script_alias) of
+	[] ->
+	    false;
+	AliasMods ->
+	    erlp_find_alias(RequestURI,AliasMods)
+    end.
+
+erlp_find_alias(_RequestURI,[]) ->
+    ?vtrace("erlp_find_alias -> no match",[]),
+    false;
+erlp_find_alias(RequestURI,[{Alias,Modules}|Rest]) ->
+    case regexp:first_match(RequestURI,"^"++Alias++"/") of
+	{match,1,Length} ->
+	    ?vtrace("erlp -> match with Length: ~p",[Length]),
+	    {erl,string:substr(RequestURI,Length+1),Modules};
+	nomatch ->
+	    erlp_find_alias(RequestURI,Rest)
+    end.
+
+evalp(RequestURI, ConfigDB) ->
+    case httpd_util:multi_lookup(ConfigDB, eval_script_alias) of
+	[] ->
+	    false;
+	AliasMods ->
+	    evalp_find_alias(RequestURI,AliasMods)
+    end.
+
+evalp_find_alias(_RequestURI,[]) ->
+    ?vtrace("evalp_find_alias -> no match",[]),
+    false;
+evalp_find_alias(RequestURI,[{Alias,Modules}|Rest]) ->
+    case regexp:first_match(RequestURI,"^"++Alias++"\\?") of
+	{match, 1, Length} ->
+	    ?vtrace("evalp_find_alias -> match with Length: ~p",[Length]),
+	    {eval, string:substr(RequestURI,Length+1),Modules};
+	nomatch ->
+	    evalp_find_alias(RequestURI,Rest)
+    end.
+
+
+%%
+%% Erl mechanism
+%% 
+
+%%This is exactly the same as the GET method the difference is that
+%%The response must not contain any data expect the response header
+
+
+erl(Info,"HEAD",CGIBody,Modules) ->
+    erl(Info,"GET",CGIBody,Modules);	
+		
+erl(Info,"GET",CGIBody,Modules) ->
+    ?vtrace("erl GET request",[]),
+    case httpd_util:split(CGIBody,":|%3A|/",2) of
+	{ok, [Mod,FuncAndInput]} ->
+	    ?vtrace("~n   Mod:          ~p"
+		    "~n   FuncAndInput: ~p",[Mod,FuncAndInput]),
+	    case httpd_util:split(FuncAndInput,"[\?/]",2) of
+		{ok, [Func,Input]} ->
+		    ?vtrace("~n   Func:  ~p"
+			    "~n   Input: ~p",[Func,Input]),
+		    exec(Info,"GET",CGIBody,Modules,Mod,Func,
+			 {input_type(FuncAndInput),Input});
+		{ok, [Func]} ->
+		    exec(Info,"GET",CGIBody,Modules,Mod,Func,{no_input,""});
+		{ok, BadRequest} ->
+		    {proceed,[{status,{400,none,BadRequest}}|Info#mod.data]}
+	    end;
+	{ok, BadRequest} ->
+	    ?vlog("erl BAD (GET-) request",[]),
+	    {proceed, [{status,{400,none,BadRequest}}|Info#mod.data]}
+    end;
+
+erl(Info, "POST", CGIBody, Modules) ->
+    ?vtrace("erl POST request",[]),
+    case httpd_util:split(CGIBody,":|%3A|/",2) of
+	{ok,[Mod,Func]} ->
+	    ?vtrace("~n   Mod:  ~p"
+		    "~n   Func: ~p",[Mod,Func]),
+	    exec(Info,"POST",CGIBody,Modules,Mod,Func,
+		 {entity_body,Info#mod.entity_body});
+	{ok,BadRequest} ->
+	    ?vlog("erl BAD (POST-) request",[]),
+	    {proceed,[{status,{400,none,BadRequest}}|Info#mod.data]}
+    end.
+
+input_type([]) ->
+    no_input;
+input_type([$/|Rest]) ->
+    path_info;
+input_type([$?|Rest]) ->
+    query_string;
+input_type([First|Rest]) ->
+    input_type(Rest).
+
+
+%% exec
+
+exec(Info,Method,CGIBody,["all"],Mod,Func,{Type,Input}) ->
+    ?vtrace("exec ~s 'all'",[Method]),
+    exec(Info,Method,CGIBody,[Mod],Mod,Func,{Type,Input});
+exec(Info,Method,CGIBody,Modules,Mod,Func,{Type,Input}) ->
+    ?vtrace("exec ~s request with:"
+	    "~n   Modules: ~p"
+	    "~n   Mod:     ~p"
+	    "~n   Func:    ~p"
+	    "~n   Type:    ~p"
+	    "~n   Input:   ~p",
+	    [Method,Modules,Mod,Func,Type,Input]),
+    case lists:member(Mod,Modules) of
+	true ->
+	    {_,RemoteAddr}=(Info#mod.init_data)#init_data.peername,
+	    ServerName=(Info#mod.init_data)#init_data.resolve,
+	    Env=get_environment(Info,ServerName,Method,RemoteAddr,Type,Input),
+	    ?vtrace("and now call the module",[]),
+	    case try_new_erl_scheme_method(Info,Env,Input,list_to_atom(Mod),list_to_atom(Func)) of
+		{error,not_new_method}->
+		    case catch apply(list_to_atom(Mod),list_to_atom(Func),[Env,Input]) of
+			{'EXIT',Reason} ->
+			    ?vlog("exit with Reason: ~p",[Reason]),
+			    {proceed,[{status,{500,none,Reason}}|Info#mod.data]};
+			Response ->
+			    control_response_header(Info,Mod,Func,Response)
+		    end;
+		ResponseResult->
+		    ResponseResult
+	    end;
+	false ->
+	    ?vlog("unknown module",[]),
+	    {proceed,[{status,{403,Info#mod.request_uri,
+			       ?NICE("Client not authorized to evaluate: "++CGIBody)}}|Info#mod.data]}
+    end.
+
+control_response_header(Info,Mod,Func,Response)->
+    case control_response(Response,Info,Mod,Func) of
+	{proceed,[{response,{StatusCode,Response}}|Rest]} ->
+	    case httpd_util:lookup(Info#mod.config_db,erl_script_nocache,false) of
+		true ->
+		    case httpd_util:split(Response,"\r\n\r\n|\n\n",2) of
+			{ok,[Head,Body]}->
+			    Date=httpd_util:rfc1123_date(),
+			    Cache="Cache-Control:no-cache\r\nPragma:no-cache\r\nExpires:"++ Date ++ "\r\n",
+			    {proceed,[{response,{StatusCode,[Head,"\r\n",Cache,"\r\n",Body]}}|Rest]};
+			_->    
+			   {proceed,[{response,{StatusCode,Response}}|Rest]}
+		    end;
+		WhatEver->
+		    {proceed,[{response,{StatusCode,Response}}|Rest]}
+	    end;
+	WhatEver->
+	    WhatEver
+    end.
+
+control_response(Response,Info,Mod,Func)->
+    ?vdebug("Response: ~n~p",[Response]),
+    case mod_cgi:status_code(lists:flatten(Response)) of
+	{ok,StatusCode} ->
+	    {proceed,[{response,{StatusCode,Response}}|Info#mod.data]};
+	{error,Reason} ->
+	    {proceed,
+	     [{status,{400,none,
+		       ?NICE("Error in "++Mod++":"++Func++"/2: "++
+			     lists:flatten(io_lib:format("~p",[Reason])))}}|
+	      Info#mod.data]}
+    end.
+
+parsed_header([]) ->
+    [];
+parsed_header([{Name,[Value|R1]}|R2]) when list(Value) ->
+    NewName=lists:map(fun(X) -> if X == $- -> $_; true -> X end end,Name),
+    [{list_to_atom("http_"++httpd_util:to_lower(NewName)),
+      multi_value([Value|R1])}|parsed_header(R2)];
+parsed_header([{Name,Value}|Rest]) when list(Value)->
+    {ok,NewName,_}=regexp:gsub(Name,"-","_"),
+    [{list_to_atom("http_"++httpd_util:to_lower(NewName)),Value}|
+     parsed_header(Rest)].
+
+multi_value([]) ->
+    [];
+multi_value([Value]) ->
+    Value;
+multi_value([Value|Rest]) ->
+    Value++", "++multi_value(Rest).
+
+%%
+%% Eval mechanism
+%% 
+
+
+eval(Info,"POST",CGIBody,Modules) ->
+    ?vtrace("eval(POST) -> method not supported",[]),	    
+    {proceed,[{status,{501,{"POST",Info#mod.request_uri,Info#mod.http_version},
+		       ?NICE("Eval mechanism doesn't support method POST")}}|
+	      Info#mod.data]};
+
+eval(Info,"HEAD",CGIBody,Modules) ->
+    %%The function that sends the data in httpd_response handles HEAD reqest by not
+    %% Sending the body
+    eval(Info,"GET",CGIBody,Modules);
+
+
+eval(Info,"GET",CGIBody,Modules) ->
+    ?vtrace("eval(GET) -> entry when"
+	    "~n   Modules: ~p",[Modules]),	    
+    case auth(CGIBody,Modules) of
+	true ->
+	    case lib:eval_str(string:concat(CGIBody,". ")) of
+		{error,Reason} ->
+		    ?vlog("eval -> error:"
+			  "~n   Reason: ~p",[Reason]),	    
+		    {proceed,[{status,{500,none,Reason}}|Info#mod.data]};
+		{ok,Response} ->
+		    ?vtrace("eval -> ok:"
+			    "~n   Response: ~p",[Response]),	    
+		    case mod_cgi:status_code(lists:flatten(Response)) of
+			{ok,StatusCode} ->
+			    {proceed,[{response,{StatusCode,Response}}|Info#mod.data]};
+			{error,Reason} ->
+			    {proceed,[{status,{400,none,Reason}}|Info#mod.data]}
+		    end
+	    end;
+	false ->
+	    ?vlog("eval -> auth failed",[]),	    
+	    {proceed,[{status,
+		       {403,Info#mod.request_uri,
+			?NICE("Client not authorized to evaluate: "++CGIBody)}}|
+		      Info#mod.data]}
+    end.
+
+auth(CGIBody,["all"]) ->
+    true;
+auth(CGIBody,Modules) ->
+    case regexp:match(CGIBody,"^[^\:(%3A)]*") of
+	{match,Start,Length} ->
+	    lists:member(string:substr(CGIBody,Start,Length),Modules);
+	nomatch ->
+	    false
+    end.
+
+%%----------------------------------------------------------------------
+%%Creates the environment list that will be the first arg to the 
+%%Functions that is called through the ErlScript Schema
+%%----------------------------------------------------------------------
+
+get_environment(Info,ServerName,Method,RemoteAddr,Type,Input)->
+    Env=[{server_software,?SERVER_SOFTWARE},
+		 {server_name,ServerName},
+		 {gateway_interface,?GATEWAY_INTERFACE},
+		 {server_protocol,?SERVER_PROTOCOL},
+		 {server_port,httpd_util:lookup(Info#mod.config_db,port,80)},
+		 {request_method,Method},
+		 {remote_addr,RemoteAddr},
+		 {script_name,Info#mod.request_uri}|
+		 parsed_header(Info#mod.parsed_header)],
+    get_environment(Type,Input,Env,Info).
+
+
+get_environment(Type,Input,Env,Info)->
+    Env1=case Type of
+	query_string ->
+	    [{query_string,Input}|Env];
+	path_info ->
+	    Aliases=httpd_util:multi_lookup(Info#mod.config_db,alias),
+	    {_,PathTranslated,_}=mod_alias:real_name(Info#mod.config_db,[$/|Input],Aliases),
+	    [{path_info,"/"++httpd_util:decode_hex(Input)},
+	     {path_translated,PathTranslated}|Env];
+	entity_body ->
+	    [{content_length,httpd_util:flatlength(Input)}|Env];
+	no_input ->
+	    Env
+    end,
+    get_environment(Info,Env1).
+
+get_environment(Info,Env)->
+    case httpd_util:key1search(Info#mod.data,remote_user) of
+	undefined ->
+	    Env;
+	RemoteUser ->
+	    [{remote_user,RemoteUser}|Env]
+    end.
+%%
+%% Configuration
+%%
+
+%% load
+
+load([$E,$r,$l,$S,$c,$r,$i,$p,$t,$A,$l,$i,$a,$s,$ |ErlScriptAlias],[]) ->
+    case regexp:split(ErlScriptAlias," ") of
+	{ok, [ErlName|Modules]} ->
+	    {ok, [], {erl_script_alias, {ErlName,Modules}}};
+	{ok, _} ->
+	    {error,?NICE(httpd_conf:clean(ErlScriptAlias)++
+			 " is an invalid ErlScriptAlias")}
+    end;
+load([$E,$v,$a,$l,$S,$c,$r,$i,$p,$t,$A,$l,$i,$a,$s,$ |EvalScriptAlias],[]) ->
+    case regexp:split(EvalScriptAlias, " ") of
+	{ok, [EvalName|Modules]} ->
+	    {ok, [], {eval_script_alias, {EvalName,Modules}}};
+	{ok, _} ->
+	    {error, ?NICE(httpd_conf:clean(EvalScriptAlias)++
+			  " is an invalid EvalScriptAlias")}
+    end;
+load([$E,$r,$l,$S,$c,$r,$i,$p,$t,$T,$i,$m,$e,$o,$u,$t,$ |Timeout],[])->
+    case catch list_to_integer(httpd_conf:clean(Timeout)) of
+	TimeoutSec when integer(TimeoutSec)  ->
+	   {ok, [], {erl_script_timeout,TimeoutSec*1000}};
+	_ ->
+	   {error, ?NICE(httpd_conf:clean(Timeout)++
+			 " is an invalid ErlScriptTimeout")}
+    end;
+load([$E,$r,$l,$S,$c,$r,$i,$p,$t,$N,$o,$C,$a,$c,$h,$e |CacheArg],[])->
+    case catch list_to_atom(httpd_conf:clean(CacheArg)) of
+        true ->
+	    {ok, [], {erl_script_nocache,true}};
+	false ->
+	   {ok, [], {erl_script_nocache,false}};
+	_ ->
+	   {error, ?NICE(httpd_conf:clean(CacheArg)++
+			 " is an invalid ErlScriptNoCache directive")}
+    end.
+
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%                                                                    %%
+%% Functions below handles the data from the dynamic webpages         %%
+%% That sends data back to the user part by part                      %%
+%%                                                                    %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%----------------------------------------------------------------------
+%%Deliver is the callback function users can call to deliver back data to the
+%%client
+%%----------------------------------------------------------------------
+
+deliver(SessionID,Data)when pid(SessionID) ->
+    SessionID ! {ok,Data},
+    ok;
+deliver(SessionID,Data) ->
+    {error,bad_sessionID}.
+
+
+%%----------------------------------------------------------------------
+%% The method that tries to execute the new format 
+%%----------------------------------------------------------------------
+
+%%It would be nicer to use erlang:function_exported/3 but if the 
+%%Module isn't loaded the function says that it is not loaded
+
+
+try_new_erl_scheme_method(Info,Env,Input,Mod,Func)-> 
+    process_flag(trap_exit,true),
+    Pid=spawn_link(Mod,Func,[self(),Env,Input]),
+    Timeout=httpd_util:lookup(Info#mod.config_db,erl_script_timeout,?DEFAULT_ERL_TIMEOUT),
+    RetVal=receive_response_data(Info,Pid,0,undefined,[],Timeout),
+    process_flag(trap_exit,false),
+    RetVal.
+
+
+%%----------------------------------------------------------------------
+%%The function recieves the data from the process that generates the page
+%%and send the data to the client through the mod_cgi:send function
+%%----------------------------------------------------------------------
+
+receive_response_data(Info,Pid,Size,StatusCode,AccResponse,Timeout) ->
+    ?DEBUG("receive_response_data()-> Script Size: ~p,StatusCode ~p ,Timeout: ~p ~n",[Size,StatusCode,Timeout]),
+    receive
+	{ok, Response} ->
+	    NewStatusCode=mod_cgi:update_status_code(StatusCode,Response),
+				  
+	    ?DEBUG("receive_response_data/2 NewStatusCode: ~p~n",[NewStatusCode]),
+	    case mod_cgi:send(Info, NewStatusCode,Response, Size,AccResponse) of
+		socket_closed ->
+		    (catch exit(Pid,final)),
+		    {proceed,[{response,{already_sent,200,Size}}|Info#mod.data]};
+		head_sent->
+		    (catch exit(Pid,final)),
+		    {proceed,[{response,{already_sent,200,Size}}|Info#mod.data]};
+		_ ->
+		    %%The data is sent and the socket is not closed contine
+		    NewSize = mod_cgi:get_new_size(Size,Response),
+		    receive_response_data(Info,Pid,NewSize,NewStatusCode,"notempty",Timeout)
+	    end;
+	{'EXIT', Pid, Reason} when AccResponse==[] ->
+	    {error,not_new_method};
+	{'EXIT', Pid, Reason} when pid(Pid) ->
+	    NewStatusCode=mod_cgi:update_status_code(StatusCode,AccResponse),
+	    mod_cgi:final_send(Info,NewStatusCode,Size,AccResponse),
+	    {proceed, [{response,{already_sent,200,Size}}|Info#mod.data]};
+	%% This should not happen!
+	WhatEver ->
+	    NewStatusCode=mod_cgi:update_status_code(StatusCode,AccResponse),
+	    mod_cgi:final_send(Info,StatusCode,Size,AccResponse),
+	    {proceed, [{response,{already_sent,200,Size}}|Info#mod.data]}
+    after 
+	Timeout ->
+	    (catch exit(Pid,timeout)), % KILL the port !!!!
+	    httpd_socket:close(Info#mod.socket_type,Info#mod.socket),
+	    {proceed,[{response,{already_sent,200,Size}}|Info#mod.data]}
+    end.
+
+
+
+
+
+
+
+
+