187 lines
		
	
	
		
			4.9 KiB
		
	
	
	
		
			Perl
		
	
	
	
	
	
		
		
			
		
	
	
			187 lines
		
	
	
		
			4.9 KiB
		
	
	
	
		
			Perl
		
	
	
	
	
	
| 
								 | 
							
								/*  $Id$
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    Part of SWI-Prolog
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    Author:        Jan Wielemaker
							 | 
						||
| 
								 | 
							
								    E-mail:        wielemak@science.uva.nl
							 | 
						||
| 
								 | 
							
								    WWW:           http://www.swi-prolog.org
							 | 
						||
| 
								 | 
							
								    Copyright (C): 1985-2007, 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 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_json,
							 | 
						||
| 
								 | 
							
									  [ test_json/0
							 | 
						||
| 
								 | 
							
									  ]).
							 | 
						||
| 
								 | 
							
								:- asserta(user:file_search_path(foreign, '.')).
							 | 
						||
| 
								 | 
							
								:- asserta(user:file_search_path(foreign, '../clib')).
							 | 
						||
| 
								 | 
							
								:- asserta(user:file_search_path(foreign, '../sgml')).
							 | 
						||
| 
								 | 
							
								:- asserta(user:file_search_path(library, '../plunit')).
							 | 
						||
| 
								 | 
							
								:- asserta(user:file_search_path(library, '../clib')).
							 | 
						||
| 
								 | 
							
								:- asserta(user:file_search_path(library, '../sgml')).
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								:- use_module(library(plunit)).
							 | 
						||
| 
								 | 
							
								:- use_module(json).
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								test_json :-
							 | 
						||
| 
								 | 
							
									run_tests([ json_read,
							 | 
						||
| 
								 | 
							
										    json_convert,
							 | 
						||
| 
								 | 
							
										    json_http
							 | 
						||
| 
								 | 
							
										  ]).
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								:- begin_tests(json_read).
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								test(true, X == @(true)) :-
							 | 
						||
| 
								 | 
							
									atom_json_term(true, X, []).
							 | 
						||
| 
								 | 
							
								test(true, X == true) :-
							 | 
						||
| 
								 | 
							
									atom_json_term(true, X, [true(true)]).
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								test(string, X == hello) :-
							 | 
						||
| 
								 | 
							
									atom_json_term('"hello"', X, []).
							 | 
						||
| 
								 | 
							
								test(string, X == '\\\b\f\n\r\t') :-
							 | 
						||
| 
								 | 
							
									atom_json_term('"\\\\\\b\\f\\n\\r\\t"', X, []).
							 | 
						||
| 
								 | 
							
								test(string, X == '\u1234') :-
							 | 
						||
| 
								 | 
							
									atom_json_term('"\\u1234"', X, []).
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								test(int, X == 42) :-
							 | 
						||
| 
								 | 
							
									atom_json_term('42', X, []).
							 | 
						||
| 
								 | 
							
								test(int, X == -42) :-
							 | 
						||
| 
								 | 
							
									atom_json_term('-42', X, []).
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								test(float, X == 3.14) :-
							 | 
						||
| 
								 | 
							
									atom_json_term('3.14', X, []).
							 | 
						||
| 
								 | 
							
								test(float, X == -3.14) :-
							 | 
						||
| 
								 | 
							
									atom_json_term('-3.14', X, []).
							 | 
						||
| 
								 | 
							
								test(float, X == 1000.0) :-
							 | 
						||
| 
								 | 
							
									atom_json_term('1e3', X, []).
							 | 
						||
| 
								 | 
							
								test(float, X == 0.001) :-
							 | 
						||
| 
								 | 
							
									atom_json_term('1e-3', X, []).
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								test(empty, X == json([])) :-
							 | 
						||
| 
								 | 
							
									atom_json_term({}, X, []).
							 | 
						||
| 
								 | 
							
								test(empty, X == json([])) :-
							 | 
						||
| 
								 | 
							
									atom_json_term('  {  } ', X, []).
							 | 
						||
| 
								 | 
							
								test(empty, X == json([])) :-
							 | 
						||
| 
								 | 
							
									atom_json_term('  {\n//comment\n} ', X, []).
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								:- end_tests(json_read).
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
										 /*******************************
							 | 
						||
| 
								 | 
							
										 *	      CONVERT		*
							 | 
						||
| 
								 | 
							
										 *******************************/
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								:- begin_tests(json_convert).
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								:- use_module(json_convert).
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								:- json_object
							 | 
						||
| 
								 | 
							
									point(x:integer, y:integer),
							 | 
						||
| 
								 | 
							
									tpoint(x:integer, y:integer)+[type=point],
							 | 
						||
| 
								 | 
							
									fpoint(x:float, y:float).
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								test(pt2json, JSON == json([x=25,y=50])) :-
							 | 
						||
| 
								 | 
							
									prolog_to_json(point(25,50), JSON).
							 | 
						||
| 
								 | 
							
								test(pt2json, JSON == json([x=25,y=50,type=point])) :-
							 | 
						||
| 
								 | 
							
									prolog_to_json(tpoint(25,50), JSON).
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								test(json2pt, X == point(25,50)) :-
							 | 
						||
| 
								 | 
							
									json_to_prolog(json([x=25,y=50]), X).
							 | 
						||
| 
								 | 
							
								test(json2pt, X == point(25,50)) :-
							 | 
						||
| 
								 | 
							
									json_to_prolog(json([y=50,x=25]), X).
							 | 
						||
| 
								 | 
							
								test(json2pt, X == fpoint(25.1,50.0)) :-
							 | 
						||
| 
								 | 
							
									json_to_prolog(json([y=50.0,x=25.1]), X).
							 | 
						||
| 
								 | 
							
								test(json2pt, T == T2) :-
							 | 
						||
| 
								 | 
							
									T = json([y=50,x=25.1]),
							 | 
						||
| 
								 | 
							
									json_to_prolog(json([y=50,x=25.1]), T2).
							 | 
						||
| 
								 | 
							
								test(json2pt, X == tpoint(25,50)) :-
							 | 
						||
| 
								 | 
							
									json_to_prolog(json([x=25,y=50,type=point]), X).
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								:- end_tests(json_convert).
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
										 /*******************************
							 | 
						||
| 
								 | 
							
										 *	       HTTP		*
							 | 
						||
| 
								 | 
							
										 *******************************/
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								:- use_module(http_json).
							 | 
						||
| 
								 | 
							
								:- use_module(http_client).
							 | 
						||
| 
								 | 
							
								:- use_module(thread_httpd).
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								:- dynamic
							 | 
						||
| 
								 | 
							
									port/1.
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								make_server :-
							 | 
						||
| 
								 | 
							
									retractall(port(_)),
							 | 
						||
| 
								 | 
							
									http_server(reply,
							 | 
						||
| 
								 | 
							
										    [ port(Port),
							 | 
						||
| 
								 | 
							
										      workers(1)
							 | 
						||
| 
								 | 
							
										    ]),
							 | 
						||
| 
								 | 
							
									assert(port(Port)).
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								kill_server :-
							 | 
						||
| 
								 | 
							
									retract(port(Port)),
							 | 
						||
| 
								 | 
							
									http_stop_server(Port, []).
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								reply(Request) :-
							 | 
						||
| 
								 | 
							
									memberchk(path('/json/echo'), Request), !,
							 | 
						||
| 
								 | 
							
									http_read_json(Request, JSON),
							 | 
						||
| 
								 | 
							
									reply_json(JSON).
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								echo(Term, Reply) :-
							 | 
						||
| 
								 | 
							
									port(Port),
							 | 
						||
| 
								 | 
							
									format(string(URL), 'http://localhost:~w/json/echo', [Port]),
							 | 
						||
| 
								 | 
							
									http_post(URL, json(Term), Reply, []).
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								:- begin_tests(json_http, [ setup(make_server),
							 | 
						||
| 
								 | 
							
											    cleanup(kill_server)
							 | 
						||
| 
								 | 
							
											  ]).
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								test(echo, X == 42) :-
							 | 
						||
| 
								 | 
							
									echo(42, X).
							 | 
						||
| 
								 | 
							
								test(echo, X == -3.14) :-
							 | 
						||
| 
								 | 
							
									echo(-3.14, X).
							 | 
						||
| 
								 | 
							
								test(echo, X == name) :-
							 | 
						||
| 
								 | 
							
									echo(name, X).
							 | 
						||
| 
								 | 
							
								test(echo, X == [1,2,3]) :-
							 | 
						||
| 
								 | 
							
									echo([1,2,3], X).
							 | 
						||
| 
								 | 
							
								test(echo, X == json([name=json, arity=2])) :-
							 | 
						||
| 
								 | 
							
									echo(json([name=json, arity=2]), X).
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								test(unicode, X == Atom) :-
							 | 
						||
| 
								 | 
							
									Atom = '\u0411\u0435\u0437\u0443\u043f\u0440\u0435\u0447\u043d\u043e\u0435',
							 | 
						||
| 
								 | 
							
									echo(Atom, X).
							 | 
						||
| 
								 | 
							
								test(quote, X == Atom) :-
							 | 
						||
| 
								 | 
							
									Atom = 'hello, "world"',
							 | 
						||
| 
								 | 
							
									echo(Atom, X).
							 | 
						||
| 
								 | 
							
								test(control, X == Atom) :-
							 | 
						||
| 
								 | 
							
									Atom = 'hello\n\t\r\b\003\',
							 | 
						||
| 
								 | 
							
									echo(Atom, X).
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								:- end_tests(json_http).
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								:- multifile
							 | 
						||
| 
								 | 
							
									user:message_hook/3.
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								user:message_hook(httpd_stopped_worker(_, true), _Kind, _Lines).
							 |