This repository has been archived on 2023-08-20. You can view files and clone it, but cannot push or open issues or pull requests.
yap-6.3/library/ytest.yap
Vítor Santos Costa 2192f73b11 make it compile under MSN vc. Unfortunately it has a weird crash at boot :(
- Lots of indenting changes
- VC++ is strict with variadic macros
- VC++ does not accept unistd.h
- new interface for walltime
- VC++ does not seem to have support for integer overflow.
- VC++ defines YENV_REG?
- no access flags, x permissions ignored.
- new FindGMP supporting MPIR
- make horus optional (c++ is hard).
2016-02-28 19:32:55 +00:00

175 lines
3.6 KiB
Prolog

:- module( ytest, [run_test/1,
run_tests/0,
test_mode/0,
op(1150, fx, test),
op(995, xfx, given),
op(990, xfx, returns)] ).
:- use_module( library(clauses) ).
:- use_module( library(maplist) ).
:- use_module( library(gensym) ).
:- use_module( library(lists) ).
:- multifile test/1.
:- dynamic error/3, failed/3.
test_mode.
user:term_expansion( test( (A, B) ), ytest:test( Lab, Cond, Done ) ) :-
info((A,B), Lab, Cond , Done ).
run_tests :-
source_module(M),
run_test(_Lab,M),
fail.
run_tests :-
show_bad.
run_test(Lab, M) :-
test(Lab, (G returns Sols given Program ), Done),
ensure_ground( Done),
format('~w : ',[ Lab ]),
reset( Streams ),
assertall(Program, Refs),
conj2list( Sols, LSols ),
% trace,
catch( do_returns(M:G, LSols, Lab), Ball, end( Ball ) ),
shutdown( Streams, Refs ).
run_test(Lab,M) :-
test(Lab, (G returns Sols ), Done),
ensure_ground( Done),
format('~w : ',[ Lab ]),
reset( Streams ),
conj2list( Sols, LSols ),
% trace,
catch( do_returns(M:G, LSols, Lab), Ball, end( Ball ) ),
shutdown( Streams, _ ).
info((A,B), Lab, Cl, G) :- !,
info(A, Lab, Cl, G),
info(B, Lab, Cl, G).
info(A, _, _, _) :- var(A), !.
info(A returns B, _, (A returns B), g(_,ok)) :- !.
info(A, A, _, g(ok,_)) :- primitive(A), !.
info(_A, _, _, _).
do_returns(G0 , Sols0, Lab ) :-
counter(I),
fetch(I, Sols0, Pattern0, Next),
Pattern0 = ( V0 =@= Target0 ),
copy_term(G0-V0, G-VGF),
catch( answer(G, VGF, Target0, Lab, Sol) , Error, Sol = error(G, Error) ),
step( _I, Sols, G0, Sol, Lab ),
!.
answer(G, V, Target0, Lab, answer(G)) :-
call(G),
( V =@= Target0
->
success(Lab, V)
;
failure(V, Target0, Lab)
).
step( I, Sols , G0, Sol, Lab ) :-
inc(I),
fetch(I, Sols, Pattern, Next),
( Sol = answer(_)
->
true
;
Sol = error(_, Error)
->
(
nonvar(Pattern ) ,
Pattern = ( Error -> G),
G
->
success
;
error(I, G0, Error, Pattern, Lab )
)
),
(
Next == ... -> throw( done )
;
Next == [] -> throw( done )
).
% fail
success( _, _) :-
write('.'),
flush_output.
error(_, G, E, _ , Lab) :-
write('X'),
flush_output,
assert( error(Lab,E,G) ).
failure( G, Pattern, Lab) :-
write('X'),
flush_output,
assert(failed(Lab, G, Pattern)).
reset( _ ) :-
nb_setval( counter,( 0 ) ).
inc( I ) :-
nb_getval( counter,( I ) ),
I1 is I+1,
nb_setval( counter,( I1 ) ).
counter( I ) :-
nb_getval( counter,( I ) ).
shutdown( _Streams, Refs ) :-
% close_io( Streams ).
maplist( erase, Refs ).
test_error( Ball, e( Ball ) ).
fetch( 0, [ A ], A, []) :-
!.
fetch( 0, [ A, B | _ ], A, B) :-
!.
fetch( I0, [ _ | L ] , A, B) :-
I0 > 0,
I is I0-1,
fetch( I, L, A, B ).
show_bad :-
error( Lab, E , B),
numbervars(E, 1, _),
format( '~n~n~w: error, error ~w.~n', [Lab, E] ),
writeln( error: E: B ),
fail.
show_bad :-
failed( Lab, V, P ),
numbervars(V, 1, _),
numbervars(P, 1, _),
format( '~n~n~w: failed, ~w =\\@= ~w.~n', [Lab, V, P] ),
fail.
show_bad.
end(done) :-
!,
nl,
fail.
end(Ball) :-
writeln( bad:Ball ).
assertall(Cls, REfs) :-
conj2list(Cls, LCls),
maplist( assert, LCls, Refs).
ensure_ground( g(Lab,Ok)) :-
ground(Ok),
gensym( tmp_, Lab ).
ensure_ground( g(Lab,Ok)) :-
ground(Ok),
ground(Lab).