1:- module(test_engines,
2	  [ test_engines/0
3	  ]).
4:- use_module(library(plunit)).
5:- use_module(library(debug)).
6:- use_module(library(aggregate)).
7:- use_module(library(apply)).
8
9test_engines :-
10	run_tests([ engines
11		  ]).
12
13:- begin_tests(engines).
14
15test(alias, Alias = ename) :-
16	engine_create(X, engine_self(X), E, [alias(ename)]),
17	assertion(E == ename),
18	engine_next(E, Alias),
19	engine_destroy(E),
20	assertion(\+ is_engine(E)).
21test(rdef_alias, error(permission_error(create,engine,ename))) :-
22	engine_create(X, engine_self(X), E, [alias(ename)]),
23	call_cleanup(engine_create(x, true, _, [alias(ename)]),
24		     engine_destroy(E)).
25test(stack_limit, TheLimit =:= 1_000_000) :-
26	engine_create(Limit, current_prolog_flag(stack_limit, Limit), E,
27		      [ stack_limit(1_000_000) ]),
28	engine_next(E, TheLimit),
29	engine_destroy(E).
30test(findall, L == [1,2,3,4,5]) :-
31	e_findall(X, between(1, 5, X), L).
32test(yield, L == [1,2,3,4,5]) :-
33	e_yield(5, L).
34test(post, Sums == [1,3,6,10,15]) :-
35	numlist(1, 5, List),
36	sums_list(List, Sums).
37test(whisper, Final == 10) :-
38	whisper(9, 1, Final).
39test(count, Final =:= N*M) :-
40	N = 4,					% threads
41	M = 10000,				% steps
42	counter(N, M, Final).
43test(error, Ex == foo) :-
44	engine_create(_, throw(foo), E),
45	catch(engine_next(E, _), Ex, true),
46	engine_destroy(E).
47test(no_data, error(existence_error(term, delivery, E))) :-
48	setup_call_cleanup(
49	    engine_create(_, sum(0), E),
50	    maplist(engine_next(E), [1]),
51	    engine_destroy(E)).
52test(gc, [sto(rational_trees)]) :-
53	gc_engines(engine_create(_, true, _), 100).
54test(gc2, [sto(rational_trees)]) :-
55	gc_engines(( engine_create(X, between(1,1,X), E),
56		     engine_next(E, V),
57		     assertion(V == 1)
58		   ), 100).
59test(gc3, [sto(rational_trees)]) :-
60	gc_engines(( engine_create(X, between(1,2,X), E),
61		     engine_next(E, V),
62		     assertion(V == 1)
63		   ), 100).
64test(gc4, [sto(rational_trees)]) :-
65	gc_engines(( engine_create(X, between(1,2,X), E),
66		     engine_next(E, V),
67		     assertion(V == 1),
68		     engine_destroy(E)
69		   ), 100).
70
71:- end_tests(engines).
72
73
74:- meta_predicate e_findall(?, 0, -).
75
76e_findall(Templ, Goal, List) :-
77	setup_call_cleanup(
78	    engine_create(Templ, Goal, E),
79	    get_answers(E, List),
80	    engine_destroy(E)).
81
82e_yield(Len, List) :-
83	setup_call_cleanup(
84	    engine_create(_, yield_loop(1,Len), E),
85	    get_answers(E, List),
86	    engine_destroy(E)).
87
88yield_loop(I, M) :-
89	I =< M, !,
90	engine_yield(I),
91	I2 is I+1,
92	yield_loop(I2, M).
93
94get_answers(E, [H|T]) :-
95	engine_next(E, H), !,
96	get_answers(E, T).
97get_answers(_, []).
98
99%%	sums_list(+List, +Sums)
100%
101%	Demonstrate keeping state inside an engine.
102
103sums_list(List, Sums) :-
104	setup_call_cleanup(
105	    engine_create(_, sum(0), E),
106	    maplist(engine_post(E), List, Sums),
107	    engine_destroy(E)).
108
109sum(Sum) :-
110	engine_fetch(New),
111	Sum1 is New + Sum,
112	engine_yield(Sum1),
113	sum(Sum1).
114
115
116%%	whisper(+N, +From, -Final)
117%
118%	Create a chain of engines,  each   of  which fetches the version
119%	from its left neighbour and posts it   to its right after adding
120%	one.
121
122whisper(N, From, Final) :-
123	engine_create(Final, final(Final), Last),
124	whisper_list(N, Last, First),
125	engine_post(First, From, Final).
126
127whisper_list(0, First, First) :- !.
128whisper_list(N, Next, First) :-
129	engine_create(Final, add1_and_tell(Next, Final), Me),
130	N1 is N - 1,
131	whisper_list(N1, Me, First).
132
133final(X) :-
134	engine_fetch(X).
135
136add1_and_tell(Next, Final) :-
137	engine_fetch(X),
138	X2 is X + 1,
139	debug(whisper, 'Sending ~d to ~p', [X2, Next]),
140	engine_post(Next, X2, Final).
141
142%%	gc_engines(:Create, +N) is semidet.
143%
144%	Create N engines using Create and try to GC them.
145
146:- meta_predicate
147	gc_engines(0, +).
148
149gc_engines(Create, N) :-
150	garbage_collect_atoms,
151	aggregate_all(count, current_engine(_), Count0),
152	forall(between(1, N, _), Create),
153	garbage_collect_atoms,
154	(   between(1, 100, _),
155	    aggregate_all(count, current_engine(_), Count1),
156	    (   Count1 < Count0 + N/4
157	    ->  !
158	    ;   sleep(0.01),			% Reclaim is in a thread
159		fail
160	    )
161	->  true
162	;   aggregate_all(count, current_engine(_), Count2),
163	    Dangling is Count2-Count0,
164	    format('~NWARNING: left ~D of ~D engines dangling~n',
165		   [Dangling, N])
166	).
167
168%%	counter(+N, +M, -Total)
169%
170%	Create a counting engine  and  creat   N  threads  that send the
171%	engine M requests to count. Return the final count (which should
172%	be N*M).
173
174counter(N, M, Total) :-
175	counter(E),
176	length(Threads, N),
177	maplist(create_counting(E, M), Threads),
178	maplist(join_true, Threads),
179	add(E,0,Total),
180	engine_destroy(E).
181
182counter(E) :-
183	engine_create(_, add_counter(0), E).
184
185add_counter(I) :-
186	engine_fetch(Add),
187	I1 is I+Add,
188	engine_yield(I1),
189	add_counter(I1).
190
191create_counting(E, M, Id) :-
192	thread_create(forall(between(1, M, _), add(E, 1, _)), Id, []).
193
194join_true(Id) :-
195	thread_join(Id, Result),
196	assertion(Result == true).
197
198add(E, Add, Sum) :-
199	engine_post(E, Add, Sum).
200