File: test_process.pl

package info (click to toggle)
swi-prolog 6.6.6-1~bpo70%2B1
  • links: PTS, VCS
  • area: main
  • in suites: wheezy-backports
  • size: 82,312 kB
  • sloc: ansic: 322,250; perl: 245,822; sh: 6,651; java: 5,254; makefile: 4,423; cpp: 4,153; ruby: 1,594; yacc: 843; xml: 82; sed: 12; sql: 6
file content (154 lines) | stat: -rw-r--r-- 3,902 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
:- module(test_process,
	  [ test_process/0
	  ]).

:- asserta(user:file_search_path(foreign, '.')).
:- asserta(user:file_search_path(library, '.')).
:- asserta(user:file_search_path(library, '../plunit')).

:- use_module(library(plunit)).
:- use_module(library(debug)).
:- use_module(library(apply)).
:- use_module(library(readutil)).
:- use_module(process).

test_process :-
	run_tests([ process_create,
		    process_wait,
		    process_threads
		  ]).

read_process(In, Text) :-
	read_stream_to_codes(In, Codes),
	close(In),
	atom_codes(Text, Codes).

:- begin_tests(process_create, [sto(rational_trees)]).

test(echo, true) :-
	process_create(path(true), [], []).
test(null_input, Codes == []) :-
	process_create(path(cat), [], [stdin(null), stdout(pipe(Out))]),
	read_stream_to_codes(Out, Codes),
	close(Out).
test(null_output, true) :-
	process_create(path(sh),
		       ['-c', 'echo THIS IS AN ERROR'],
		       [stdout(null)]).
test(null_error, true) :-
	process_create(path(sh),
		       ['-c', 'echo "THIS IS AN ERROR" 1>&2'],
		       [stderr(null)]).
test(read_error, X == 'error\n') :-
	process_create(path(sh),
		       ['-c', 'echo "error" 1>&2'],
		       [stderr(pipe(Out))]),
	read_process(Out, X).
test(echo, X == 'hello\n') :-
	process_create(path(sh),
		       ['-c', 'echo hello'],
		       [ stdout(pipe(Out))
		       ]),
	read_process(Out, X).
test(lwr, X == 'HELLO') :-
	process_create(path(tr), [hello, 'HELLO'], % a-z A-Z is non-portable
		       [ stdin(pipe(In)),
			 stdout(pipe(Out))
		       ]),
	format(In, hello, []),
	close(In),
	read_process(Out, X).
test(cwd, [true, condition(\+current_prolog_flag(windows, true))]) :-
	tmp_dir(Tmp),
	process_create(path(pwd), [],
		       [ stdout(pipe(Out)),
			 cwd(Tmp)
		       ]),
	read_process(Out, CWD0),
	normalize_space(atom(CWD), CWD0),
	same_file(CWD, Tmp).
test(cwd, [true, condition(current_prolog_flag(windows, true))]) :-
	tmp_dir(Tmp),
	getenv('COMSPEC', Shell),
	process_create(Shell, ['/c', cd],
		       [ stdout(pipe(Out)),
			 cwd(Tmp)
		       ]),
	read_process(Out, CWD0),
	normalize_space(atom(CWD), CWD0),
	same_file(CWD, Tmp).

tmp_dir(Dir) :-
	getenv('TEMP', Dir), !.
tmp_dir('/tmp').

:- end_tests(process_create).


:- begin_tests(process_wait, [sto(rational_trees)]).

test(wait_ok, X == exit(0)) :-
	process_create(path(sh), ['-c', 'exit 0'], [process(PID)]),
	process_wait(PID, X).
test(wait_ok, X == exit(42)) :-
	process_create(path(sh), ['-c', 'exit 42'], [process(PID)]),
	process_wait(PID, X).
test(kill_ok, [ X == killed(9),
		condition(\+current_prolog_flag(windows, true))]) :-
	process_create(path(sleep), [2], [process(PID)]),
	process_kill(PID, 9),
	process_wait(PID, X).
test(kill_ok, [ X = exit(_),
		condition(current_prolog_flag(windows, true))]) :-
	process_create(path(sleep), [2], [process(PID)]),
	process_kill(PID, 9),
	process_wait(PID, X).
test(wait_timeout, [ X = timeout ]) :-
	process_create(path(sleep), [2], [process(PID)]),
	(   current_prolog_flag(windows, true)
	->  TMO = 0.1
	;   TMO = 0
	),
	process_wait(PID, X, [timeout(TMO)]),
	process_kill(PID, 9),
	process_wait(PID, _).

:- end_tests(process_wait).

:- begin_tests(process_threads, [sto(rational_trees)]).

join(Id) :-
	thread_join(Id, Status),
	Status == true.

thread_create_and_wait(Id) :-
	thread_create(create_and_wait, Id, []).

create_and_wait :-
	process_create(path(cat), [],
		       [ stdin(pipe(ToDOT)),
			 stdout(pipe(XDotOut))
		       ]),
	Term = hello(world),
	format(ToDOT, '~q.~n', [Term]),
	close(ToDOT),
	read(XDotOut, Term2),
	assertion(Term2 =@= Term),
	read(XDotOut, EOF),
	assertion(EOF == end_of_file),
	close(XDotOut).

create_and_wait_once :-
	length(List, 2),
	maplist(thread_create_and_wait, List),
	maplist(join, List).

/* See create_pipes() in process.c */

test(concurr, true) :-
	forall(between(1, 50, _),
	       create_and_wait_once).

:- end_tests(process_threads).