clib package
This commit is contained in:
Vítor Santos Costa
300
packages/clib/test_socket.pl
Normal file
300
packages/clib/test_socket.pl
Normal file
@@ -0,0 +1,300 @@
|
||||
/* $Id$
|
||||
|
||||
Part of SWI-Prolog
|
||||
|
||||
Author: Jan Wielemaker
|
||||
E-mail: jan@swi.psy.uva.nl
|
||||
WWW: http://www.swi-prolog.org
|
||||
Copyright (C): 1985-2002, University of Amsterdam
|
||||
|
||||
This program is free software; you can redistribute it and/or
|
||||
modify it under the terms of the GNU General Public License
|
||||
as published by the Free Software Foundation; either version 2
|
||||
of the License, or (at your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
GNU General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU Lesser General Public
|
||||
License along with this library; if not, write to the Free Software
|
||||
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
||||
|
||||
As a special exception, if you link this library with other files,
|
||||
compiled with a Free Software compiler, to produce an executable, this
|
||||
library does not by itself cause the resulting executable to be covered
|
||||
by the GNU General Public License. This exception does not however
|
||||
invalidate any other reasons why the executable file might be covered by
|
||||
the GNU General Public License.
|
||||
*/
|
||||
|
||||
:- module(test_socket,
|
||||
[ test_socket/0,
|
||||
server/1, % +Port
|
||||
client/1 % +Address
|
||||
]).
|
||||
|
||||
%:- asserta(user:file_search_path(foreign, '.')).
|
||||
|
||||
:- use_module(library(socket)).
|
||||
%:- use_module(user:socket). % debugging
|
||||
:- use_module(streampool).
|
||||
:- use_module(library(debug)).
|
||||
|
||||
test_socket :-
|
||||
test_udp,
|
||||
test_tcp.
|
||||
|
||||
test_tcp :-
|
||||
make_server(Port, Socket),
|
||||
thread_create(run_server(Socket), Server, []),
|
||||
client(localhost:Port),
|
||||
thread_join(Server, Status),
|
||||
( Status == true
|
||||
-> true
|
||||
; format(user_error, 'Server exit-status: ~w~n', [Status]),
|
||||
fail
|
||||
).
|
||||
|
||||
|
||||
/*******************************
|
||||
* SERVER *
|
||||
*******************************/
|
||||
|
||||
server(Port) :-
|
||||
make_server(Port, Socket),
|
||||
run_server(Socket).
|
||||
|
||||
run_server(Socket) :-
|
||||
writeln(before_main),
|
||||
tcp_open_socket(Socket, In, _Out),
|
||||
add_stream_to_pool(In, accept(Socket)),
|
||||
stream_pool_main_loop.
|
||||
|
||||
make_server(Port, Socket) :-
|
||||
tcp_socket(Socket),
|
||||
tcp_bind(Socket, Port),
|
||||
tcp_listen(Socket, 5).
|
||||
|
||||
accept(Socket) :-
|
||||
tcp_accept(Socket, Slave, Peer),
|
||||
debug(connection, 'connect(~p)', [Peer]),
|
||||
tcp_open_socket(Slave, In, Out),
|
||||
add_stream_to_pool(In, client(In, Out, Peer)).
|
||||
|
||||
client(In, Out, Peer) :-
|
||||
read(In, Term),
|
||||
( Term == end_of_file
|
||||
-> debug(connection, 'close(~p)', [Peer]),
|
||||
close(In),
|
||||
close(Out)
|
||||
; ( catch(action(Term, In, Out), E, true)
|
||||
-> ( var(E)
|
||||
-> true
|
||||
; tcp_send(Out, exception(E))
|
||||
)
|
||||
; tcp_send(Out, no)
|
||||
)
|
||||
).
|
||||
|
||||
/*******************************
|
||||
* ACTION *
|
||||
*******************************/
|
||||
|
||||
action(echo(X), _In, Out) :-
|
||||
tcp_send(Out, X).
|
||||
action(wait(X), _In, Out) :-
|
||||
sleep(X),
|
||||
tcp_send(Out, yes).
|
||||
action(slow_read, In, Out) :-
|
||||
sleep(2),
|
||||
read(In, Term),
|
||||
tcp_send(Out, Term).
|
||||
action(quit, _In, Out) :-
|
||||
close_stream_pool,
|
||||
tcp_send(Out, quitted).
|
||||
|
||||
|
||||
/*******************************
|
||||
* CLIENT SIDE *
|
||||
*******************************/
|
||||
|
||||
:- dynamic
|
||||
client/2.
|
||||
|
||||
client(Address) :-
|
||||
tcp_socket(S),
|
||||
tcp_connect(S, Address),
|
||||
tcp_open_socket(S, In, Out),
|
||||
asserta(client(In, Out)),
|
||||
test,
|
||||
retract(client(In, Out)),
|
||||
close(Out),
|
||||
close(In).
|
||||
|
||||
echo(echo-1) :-
|
||||
X = 'Hello World',
|
||||
client(In, Out),
|
||||
tcp_send(Out, echo(X)),
|
||||
tcp_reply(In, X).
|
||||
echo(echo-2) :-
|
||||
findall(A, between(0, 100000, A), X),
|
||||
client(In, Out),
|
||||
tcp_send(Out, echo(X)),
|
||||
tcp_reply(In, X).
|
||||
|
||||
slow(slow-1) :-
|
||||
client(In, Out),
|
||||
tcp_send(Out, wait(2)),
|
||||
tcp_reply(In, yes).
|
||||
slow(slow-1) :-
|
||||
client(In, Out),
|
||||
tcp_send(Out, slow_read),
|
||||
findall(A, between(0, 100000, A), X),
|
||||
tcp_send(Out, X),
|
||||
tcp_reply(In, X).
|
||||
|
||||
quit(quit-1) :-
|
||||
client(In, Out),
|
||||
tcp_send(Out, quit),
|
||||
tcp_reply(In, quitted).
|
||||
|
||||
|
||||
/*******************************
|
||||
* UTIL *
|
||||
*******************************/
|
||||
|
||||
tcp_send(Out, Term) :-
|
||||
format(Out, '~q.~n', [Term]),
|
||||
flush_output(Out).
|
||||
|
||||
tcp_reply(In, Reply) :-
|
||||
read(In, Term),
|
||||
reply(Term, In, Reply).
|
||||
|
||||
reply(exception(E), _, _) :-
|
||||
throw(E).
|
||||
reply(T, _, T).
|
||||
|
||||
/*******************************
|
||||
* UDP *
|
||||
*******************************/
|
||||
|
||||
receive_loop(Socket, Queue) :-
|
||||
repeat,
|
||||
udp_receive(Socket, Data, From, [as(atom)]),
|
||||
thread_send_message(Queue, got(Data, From)),
|
||||
writeln(before_main:Data:done),
|
||||
Data == quit, !,
|
||||
tcp_close_socket(Socket).
|
||||
|
||||
receiver(Port, ThreadId) :-
|
||||
thread_self(Me),
|
||||
udp_socket(S),
|
||||
tcp_bind(S, Port),
|
||||
thread_create(receive_loop(S, Me), ThreadId, []).
|
||||
|
||||
test_udp :-
|
||||
format(user_error, 'Running test set "udp"', []),
|
||||
( catch(run_udp, E, true)
|
||||
-> ( var(E)
|
||||
-> format(user_error, ' . done~n', [])
|
||||
; print_message(error, E)
|
||||
)
|
||||
; format(user_error, 'FAILED~n', [])
|
||||
).
|
||||
|
||||
run_udp :-
|
||||
receiver(Port, ThreadId),
|
||||
udp_socket(S),
|
||||
udp_send(S, 'hello world', localhost:Port, []),
|
||||
thread_get_message(got(X, _)),
|
||||
udp_send(S, 'quit', localhost:Port, []),
|
||||
thread_get_message(got(Q, _)),
|
||||
thread_join(ThreadId, Exit),
|
||||
writeln(done),
|
||||
tcp_close_socket(S),
|
||||
assertion(X=='hello world'),
|
||||
assertion(Q=='quit'),
|
||||
assertion(Exit==true), !.
|
||||
|
||||
|
||||
/*******************************
|
||||
* TEST MAIN-LOOP *
|
||||
*******************************/
|
||||
|
||||
testset(echo).
|
||||
testset(slow).
|
||||
testset(quit).
|
||||
|
||||
:- dynamic
|
||||
failed/1,
|
||||
blocked/2.
|
||||
|
||||
test :-
|
||||
retractall(failed(_)),
|
||||
retractall(blocked(_,_)),
|
||||
forall(testset(Set), runtest(Set)),
|
||||
report_blocked,
|
||||
report_failed.
|
||||
|
||||
report_blocked :-
|
||||
findall(Head-Reason, blocked(Head, Reason), L),
|
||||
( L \== []
|
||||
-> format('~nThe following tests are blocked:~n', []),
|
||||
( member(Head-Reason, L),
|
||||
format(' ~p~t~40|~w~n', [Head, Reason]),
|
||||
fail
|
||||
; true
|
||||
)
|
||||
; true
|
||||
).
|
||||
report_failed :-
|
||||
findall(X, failed(X), L),
|
||||
length(L, Len),
|
||||
( Len > 0
|
||||
-> format('~n*** ~w tests failed ***~n', [Len]),
|
||||
fail
|
||||
; format('~nAll tests passed~n', [])
|
||||
).
|
||||
|
||||
runtest(Name) :-
|
||||
format('Running test set "~w" ', [Name]),
|
||||
flush,
|
||||
functor(Head, Name, 1),
|
||||
nth_clause(Head, _N, R),
|
||||
clause(Head, _, R),
|
||||
( catch(Head, Except, true)
|
||||
-> ( var(Except)
|
||||
-> put(.), flush
|
||||
; Except = blocked(Reason)
|
||||
-> assert(blocked(Head, Reason)),
|
||||
put(!), flush
|
||||
; test_failed(R, Except)
|
||||
)
|
||||
; test_failed(R, fail)
|
||||
),
|
||||
fail.
|
||||
runtest(_) :-
|
||||
format(' done.~n').
|
||||
|
||||
test_failed(R, Except) :-
|
||||
clause(Head, _, R),
|
||||
functor(Head, Name, 1),
|
||||
arg(1, Head, TestName),
|
||||
clause_property(R, line_count(Line)),
|
||||
clause_property(R, file(File)),
|
||||
( Except == failed
|
||||
-> format('~N~w:~d: Test ~w(~w) failed~n',
|
||||
[File, Line, Name, TestName])
|
||||
; message_to_string(Except, Error),
|
||||
format('~N~w:~d: Test ~w(~w):~n~t~8|ERROR: ~w~n',
|
||||
[File, Line, Name, TestName, Error])
|
||||
),
|
||||
assert(failed(Head)).
|
||||
|
||||
blocked(Reason) :-
|
||||
throw(blocked(Reason)).
|
||||
|
||||
|
||||
Reference in New Issue
Block a user