:- module( ytest, [run_test/1,
                   run_tests/0,
                   test_mode/0,
                   op(1150, fx, test),
                   op(999, xfx, returns)] ).

:- use_module( clauses ).

:- 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 :-
    run_test(_Lab),
    fail.
run_tests :-
    show_bad.

run_test(Lab) :-
    current_module(M,M),
    test(Lab, (G returns Sols ), Done),
    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 ) :- 
                                %    close_io( Streams ).
    true.

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 ).