test_runner

user:portray_message(error, _) :-
    \+ prolog_error_occurred,
    assertz(prolog_error_occurred),
    fail. % to let SICStus portray the error

add_additional_arguments(List) :-
    (retract(additional_arguments(Old)) -> true ; Old=[]),
    append(Old,List,New),
    assertz(additional_arguments(New)).

add_additional_preference(PREF,PREFVAL) :-
    (retract(additional_arguments(Old0)) -> remove_matching_pref(Old0,PREF,Old) ; Old=[]),
    New = ['-p',PREF,PREFVAL|Old],
    format('New additional arguments: ~w~n',[New]),
    assertz(additional_arguments(New)).

additional_testcase_file(ID,_,_,EFile) :- extra_testcase_file(ID,EFile).

additional_testcase_file(_ID,File,Arguments,TFile) :- member('-t',Arguments),
    get_default_trace_file(File,TFile).

additional_testcase_file(ID,_,_,RefFile2) :- get_testcase_diff_check_output(ID,_File1,RefFile2).

all_categories(X) :-
    findall(Groups,
    cli_testcase(_Id,Groups,_Conf,_Args,_Desc),
    List),
    append(List,ListOfGroups),
    remove_dups(ListOfGroups,X).

all_files(Files) :- findall(F,test_file(_,_,F),A), sort(A,Files).

all_first_categories(X) :- % only categories that appear as first category
    findall(Group1,
    cli_testcase(_Id,[Group1|_],_Conf,_Args,_Desc),
    ListOfGroups),
    remove_dups(ListOfGroups,X).

all_ids(X) :-
    findall(Id,
    cli_testcase(Id,_Groups,_Conf,_Args,_Desc),
    List),
    remove_dups(List,X).

all_valid_files(Files,Mode) :-
    findall(F, (valid_test_file(_,_,F,XT),
    relevant_extension(XT,Mode)),
    A),
    sort(A,Files).

assert_test_failed(Id) :-
    assertz(test_failed(Id)),
    retractall(last_test_failed(_)),
    assertz(last_test_failed(Id)).

assert_test_skipped(Id) :- assertz(test_skipped(Id)).

auto_complete_preference(Prefix,Name) :-
    atom_codes(Prefix,PC),
    eclipse_preference(EP,Name),
    (atom_codes(EP,EPC) ; atom_codes(Name,EPC)),
    append(PC,_,EPC).

bench_probcli_binary_testcase(Id,Args,Repeats,probcli_binary(V1,V2,V3,F,Path,_,_),Walltimes,Ok) :-
    format('~nRunning test ~w using version ~w.~w.~w-~w (~w)~n',[Id,V1,V2,V3,F,Path]),
    run_probcli_binary_testcase(Id,Path,Args,_WT,Ok), % run once for parser
    rep_bench(Repeats,Id,Path,Args,Walltimes).

binary_command(eval). binary_command(evalt). binary_command(evalf).

binary_command(eval). binary_command(evalt). binary_command(evalf).

binary_command(eval). binary_command(evalt). binary_command(evalf).

binary_command('-mc').

cache :- add_additional_arguments(['-cache','/Users/leuschel/svn_root/NewProB/examples/cache/']).

call_xmllint(File,ErrText,ExitLint) :- use_logxml_schema,
    absolute_file_name(prob_home('doc/logxml_xsd.xml'),SchemaFile),
    file_exists(SchemaFile),!,
    get_command_path(xmllint,LintPath),
    format('Calling ~w with schema ~w for logxml file ~w~n',[LintPath,SchemaFile,File]),
    system_call(LintPath,['--schema', SchemaFile, File, '-noout'],_OutputText,ErrText,ExitLint).

call_xmllint(File,ErrText,ExitLint) :-
    get_command_path(xmllint,LintPath),
    format('Calling ~w without schema for logxml file ~w~n',[LintPath,File]),
    system_call(LintPath,[File],_OutputText,ErrText,ExitLint).

category(X) :- run_tests_by_category(X).

category_analysis :-
    format('Analysing test categories:~n',[]),
    findall(Cat-Id,(cli_testcase(Id,Categories,_,_Args,_Comm1),member(Cat,Categories)),L),
    sort(L,SL),
    keyclumped(SL,Groups), % Groups = [ Cat1 - [TestNr1, ...], Cat2 - [...], ...]
    maplist(print_cat_group,Groups).

check_diff_output(Id) :-
    findall(diff(Id,GeneratedFile,StoredReferenceFile),
    get_testcase_diff_check_output(Id,GeneratedFile,StoredReferenceFile),
    ListOfDiffsToCheck),
    maplist(check_diff_output2, ListOfDiffsToCheck).

check_diff_output2(diff(Id,GeneratedFile,StoredReferenceFile)) :-
    \+ safe_file_exists(GeneratedFile) -> print_test_failed(Id,'Output file does not exist:',GeneratedFile) ;
    \+ safe_file_exists(StoredReferenceFile) -> print_test_failed(Id,'Stored file does not exist:',StoredReferenceFile) ;
    diff(Id,GeneratedFile,StoredReferenceFile).

check_error_cound(Id,Infos) :-
    testcase_expects_errors(Id),!,
    (member(expected_errors/E,Infos),E>0 -> true ; print_test_failed(Id,'Logxml file does not report errors:',Infos)).

check_error_cound(Id,Infos) :-
    (member(errors/0,Infos),member(expected_errors/0,Infos) -> true
    ; print_test_failed(Id,'Logxml file reports errors:',Infos)).

check_failed(failure) :- test_failed(X),!,print_failed_tests,
    print('Use the following command to run individual tests: '),nl,
    print(' ./prolog.sh --file tests/test_runner.pl --goal "run_id('),print(X),print(')."'),nl,
    (halt1_allowed -> halt1 ; print('halt(1) :: dontstop mode'),nl).

check_failed(success) :- number_of_tests_run(Nr),
    start_terminal_colour([green,bold],user_output),
    findall(Y,test_skipped(Y),Skips), length(Skips,NrSkips),
    bb_get(reset_test_runner_info,Info),
    (Nr=1,NrSkips=0,Info\=category(_,_) -> format(user_output,'Test successful.~n',[])
    ; NrSkips>0 -> format(user_output,'All ~w tests successful, ~w skipped (for ~w).~n',[Nr,NrSkips,Info])
    ; format(user_output,'All ~w tests successful (for ~w).~n',[Nr,Info])),
    reset_terminal_colour(user_output).

check_logxml(Id) :-
    logxml_file(File),!,
    xmllint(Id,File),
    check_logxml(Id,File).

check_logxml(_).

check_logxml(Id,File) :-
    catch(read_xml_log_file(File,Infos), E,
    print_test_failed(Id,'Exception trying to read logxml file:',E)),
    !,
    format_progress_nl('Read logxml file ~w, contains ~w.',[File,Infos]),
    check_error_cound(Id,Infos).

check_logxml(Id,File) :-
    print_test_failed(Id,'Logxml file could not be read:',File).

check_no_prolog_startup_error :-
    prolog_error_occurred,
    !,
    format('*** Error(s) from Prolog while starting test runner! Aborting. ***~n', []),
    halt(1).

check_no_prolog_startup_error.

clear_diff_output(Id) :- % clear all files that should be generated
    get_testcase_diff_check_output(Id,GeneratedFile,_StoredReferenceFile),
    safe_file_exists(GeneratedFile),
    (get_testcase_do_not_delete(Id,GeneratedFile) -> formatsilent(user_output,'% Keeping: ~w~n',[GeneratedFile])
    ; formatsilent(user_output,'% Deleting: ~w~n',[GeneratedFile]),
    delete_file(GeneratedFile)
    ),fail.

clear_diff_output(_).

clear_logxml_output(_Id) :- logxml_file(GeneratedFile),
    safe_file_exists(GeneratedFile),
    delete_file(GeneratedFile),
    fail.

clear_logxml_output(_).

codespeed_id(Ids) :- codespeed_id(Ids,[min_date(date(2020,1,1))]).

codespeed_id([],_) :- !.

codespeed_id([H|T],Options) :- !, codespeed_id(H,Options),!, codespeed_id(T,Options).

codespeed_id(Cat,Options) :- atom(Cat),!,
    get_tests_for_categories([Cat],List),
    codespeed_id(List,Options).

codespeed_id(testcase(Id, _, _, _, _),Options) :- !, codespeed_id(Id,Options).

codespeed_id(Id,Options) :-
    use_module('probcli_bak/codespeed_versions.pl'), % contains probcli_binary
    cli_testcase(Id,_TestCategories,_TestInfos,Arguments,Comment),
    format('Benchmarking test ~w using probcli binaries ~w~nTest Description: ~w~n',[Id,Options,Comment]),
    maplist(convert_arg_to_atom,Arguments,Args2),
    findall(probcli_binary(V1,V2,V3,F,Path,Sics,Date),
    get_probcli_binary_info(Options,V1,V2,V3,F,Path,_Hash,Sics,Date),Binaries),
    Repeats=3,
    maplist(bench_probcli_binary_testcase(Id,Args2,Repeats),Binaries,Walltimes,Oks),
   
    ajoin(['codespeed/res_',Id,'.csv'],FName),
    absolute_file_name(FName,AF,[relative_to(probcli_bak)]),
    format('Writing codespeed results for ~w to ~w~n',[Id,AF]),
    open(AF,write,Stream),
    format(Stream,'\"Test ~w\"~n',[Id]),
    format(Stream,'\"~w\"~n',[Comment]),
    ajoin_with_sep(Arguments,' ',ArgsStr),
    format(Stream,'Command:,\"probcli ~w\"~n~n',[ArgsStr]),
    format(Stream,'\"~w.~w.~w-~w\",~w,~w,~w,~w,~w,~w,\"~w\"~n',[v1,v2,v3,f,sics,date,avg,min,max,ok,walltimes]),
    maplist(print_codespeed_results(Stream,Repeats),Binaries,Walltimes,Oks),
    close(Stream),
    maplist(print_codespeed_results(user_output,Repeats),Binaries,Walltimes,Oks).

convert_arg_to_atom(Nr,Atom) :- number(Nr), number_codes(Nr,C),!,atom_codes(Atom,C).

convert_arg_to_atom(A,A).

copy(Cat) :- (Cat=[_|_] -> C=Cat ; C=[Cat]),
    generate_copy_commands(C,'testarchive/').

diff(Id,F1,F2) :-
    formatsilent(user_output,'% Checking: diff / cmp ~w ~w~n',[F1,F2]),
    get_command_path(diff,DiffPath),
    get_command_path(cmp,CmpPath),
    (system_call(DiffPath,['-b',F1,F2],DiffOutputText,_ErrTextDiff,ExitDiff) % use -q for quiet
    -> true
    ; DiffOutputText = "*** CALLING DIFF FAILED !", ExitDiff = fail
    ),
    formatsilent(user_output,'% Checking: cmp ~w ~w~n',[F1,F2]),
    (system_call(CmpPath,['-b',F1,F2],CmpOutputText,_ErrTextCmp,_ExitCmp)
    -> true
    ; CmpOutputText = "*** CALLING CMP FAILED !"
    ),
    (ExitDiff = exit(0)%, ExitCmp = exit(0)
    -> true
    ; diff_failed(Id,F1,F2,DiffOutputText,CmpOutputText)).

diff_failed(Id,F1,F2,DiffOutputText,CmpOutputText) :-
    test_took(Time,_),
    atom_codes(DiffOutputAtom,DiffOutputText),
    atom_codes(CmpOutputAtom,CmpOutputText),
    ErrMsg = ['Diff for test with Id\n',Id,'\nfailed:\n','Output file\n',F1,'\ndoes not correspond to stored version\n',F2,
    '\nOutput of Diff:\n',DiffOutputAtom,
    '\nOutput of Cmp:\n',CmpOutputAtom],
    create_and_print_junit_result(['Diff Checking'],Id,Time,error(ErrMsg)),
    assert_test_failed(Id),
    assertz(test_diff_failed(Id,F1,F2)),
    start_terminal_colour(red,user_error),
    format(user_error,'*** Test ~w FAILED: Diff failed:~nOutput file ~w~ndoes not correspond to stored version~n~w~n', [Id,F1,F2]),
    format(user_error,'Diff:~n~s~n',[DiffOutputText]),
    format(user_error,'Cmp:~n~s~n',[CmpOutputText]),
    reset_terminal_colour(user_error).

diff_in_editor :- findall(I,test_diff_failed(I,_,_),LI), sort(LI,SI),
    format('Opening failed diff files in editor: ~w~n',[SI]),
    test_diff_failed(Id,F1,F2),
    format('Test ~w~n~w ~w~n',[Id,F1,F2]),
    diff_files_with_editor(F1,F2),
    fail.

diff_in_editor.

eval_argv(Cmd) :- format('ARGV ==> ~w~n',[Cmd]),
    atom_codes(Cmd,C), safe_number_codes(Nr,C), !, test_eval(Nr).

eval_argv(Cmd) :- test_eval(Cmd),!.

expect_error_arg('-expcterr').

expect_error_arg('-expecterr').

expect_error_arg('-expect').

expect_error_arg('-expcterrpos').

file_in_arguments(F,['-p',_,_|T]) :- !, file_in_arguments(F,T).

file_in_arguments(F,[C,_|T]) :- binary_command(C),!, file_in_arguments(F,T).

file_in_arguments(F,[H|T]) :- is_file(H),H=F ; file_in_arguments(F,T).

format_error_nl(F,Args) :- format_with_colour_nl(user_output,[red,bold],F,Args).

format_progress_nl(F,Args) :- format_with_colour_nl(user_output,[blue],F,Args).

format_warning(F,Args) :- format_with_colour(user_output,[red],F,Args).

format_warning_nl(F,Args) :- format_with_colour_nl(user_output,[red],F,Args).

full_flush :- flush_output(user_output), flush_output(user_error).

generate_copy_command(File,Dest) :-
    safe_file_exists(File),
    get_parent_directory(File,Dir),!,
    string_concatenate(Dest,Dir,DestDir),
    string_concatenate(Dest,File,DestFile),
    format(user_output,'\tmkdir -p ~w~n',[DestDir]),
    get_command_path(mkdir,MkCmdPath),
    system_call(MkCmdPath, ['-p',DestDir],_Text1,_JExit1),
    format(user_output,'\tcp ~w ~w~n',[File,DestFile]),
    get_command_path(cp,CpCmdPath),
    system_call(CpCmdPath, [File,DestFile],_Text2,_JExit2).

generate_copy_command(_,_).

generate_copy_commands(Categories,Dest) :-
    cli_testcase(ID, TestCategories, _Infos, Arguments, _Comment),
    non_empty_inter(Categories,TestCategories), %print(ID),nl,
    Arguments=[MainFile|_], generate_copy_command(MainFile,Dest), % print(MainFile),nl,
    additional_testcase_file(ID,MainFile,Arguments,ExtraFile),
    generate_copy_command(ExtraFile,Dest),
    fail.

generate_copy_commands(_,_).

generate_makefile(RegenerateGoal,Filename,TargetCommand) :-
    tell(Filename),
    all_first_categories(AllTestCategories),
    ajoin_with_sep(AllTestCategories, ' \\\n\t', JoinedCategories),
    write('# This Makefile is generated automatically. DO NOT EDIT.\n'),
    write('# If you have added/removed a test category, regenerate using this command:\n'),
    format('# ./prolog.sh --file tests/test_runner.pl --goal "~q, halt ; halt(1)."\n\n', [RegenerateGoal]),
    format('categories = \\\n\t~w\n\n', [JoinedCategories]),
    write('.PHONY: test_all_source\n'),
    write('test_all_source: $(categories)\n\n'),
    write('.PHONY: $(categories)\n'),
    format('$(categories):\n\t~w\n', [TargetCommand]),
    told.

generate_makefile_all_tests :-
    % run tests where category G is the first category to avoid running tests multiple times
    % also avoids concurrency issues when test run multiple times in parallel with diff checking of output
    generate_makefile(generate_makefile_all_tests, 'tests/Makefile_All_Tests',
    % Makefile_All_Tests is (indirectly) included from the top-level Makefile,
    % so the working directory is the repository root
    % and the test_runner.pl path must include the tests/ directory prefix.
    './prolog.sh --file tests/test_runner.pl --goal "run_silently, run_tests_by_first_category($@), halt_tests ; halt(1)."').

generate_makefile_for_coverage :-
    generate_makefile(generate_makefile_for_coverage, 'Makefile_Coverage_Groups', './prolog.sh --file tests/prob_cov_runner.pl --goal "coverage_group_data($@), halt ; halt(1)."').

get_last_test_id(Id) :- set_last_test_id, last_test_id(Id).

get_preference_name(Prefix,Name) :- auto_complete_preference(Prefix,Name),!.

get_preference_name(Prefix,_) :-
    format_warning_nl('No matching preference found for: ~w',[Prefix]),fail.

get_probcli_binary_info(Options,V1,V2,V3,F,Path,Hash,Sics,Date) :-
    probcli_binary(V1,V2,V3,F,Path,Hash,Sics,Date), % from codespeed_versions.pl
    (( member(min_date(D2),Options), D2 @> Date
    ; member(max_date(D3),Options), D3 @< Date
    ; member(min_version(V12,V22,V32),Options), v(V12,V22,V32) @> v(V1,V2,V3)
    )
    -> format('Excluding version ~w.~w.~w-~w ~w~n',[V1,V2,V3,F,Options]),
    fail
    ; % format('Including version ~w.~w.~w-~w ~w~n',[V1,V2,V3,F,Options]),
    true).

get_testcase_diff_check_output(Id,PF1,PF2) :-
    cli_testcase_diff_check_output(Id,F1,F2),
    patch_prob_examples_loc(F1,PF1),
    patch_prob_examples_loc(F2,PF2).

get_testcase_do_not_delete(Id,PF) :-
    cli_testcase_do_not_delete(Id,F),
    patch_prob_examples_loc(F,PF).

get_tests_for_categories(Categories,List) :-
    get_tests_for_categories(Categories,all,List).

get_tests_for_categories(Categories,FirstOnly,List) :-
    findall(testcase(Id, TestCategories, Infos, Arguments, Comment),
    (cli_testcase(Id, TestCategories, Infos, Arguments, Comment),
    (FirstOnly=first -> TestCategories=[C1|_], member(C1,Categories)
    ; intersect(Categories, TestCategories)) ),
    List).

group_cannot_be_checked_on_ci_server(setlog).

group_cannot_be_checked_on_ci_server(smt_solver_integration) :-
    host_platform(windows). % TODO Install Z3 on GitLab CI Windows runner

halt1 :-
    format_error_nl('TEST RUN FAILED',[]),
    halt(1).

halt1_allowed :- \+ repl_mode.

halt_tests :-
    prolog_error_occurred,
    !,
    halt1.

halt_tests :- test_failed(_),!,
    halt1.

halt_tests :-
    nl,print('TEST RUN SUCCESSFUL'),nl,
    halt. % regular halt

handle_test_exception(Exception) :-
    ( Exception = error(_,_) -> Type = 'Error'
    ; Exception = enumeration_warning(_,_,_,_,_) -> Type = 'Enumeration exception'
    ; Exception = solver_and_provers_too_weak -> Type = 'Solver exception'
    ; fail
    ),
    !,
    (halt1_allowed
    -> format_warning_nl('~w during test execution: ~w',[Type,Exception]),
    halt1
    ; true).

handle_test_exception(halt(1)) :- !.

handle_test_exception(parse_errors(_)) :- !.

handle_test_exception(user_interrupt_signal) :- !,
    assertz(user_interrupt_signal_received),
    format_warning_nl('CTRL-C received, aborting tests',[]).

handle_test_exception(Exception) :-
    format_warning_nl('Exception not caught in test_runner: ~w',[Exception]),
    halt1.

ids(Nr) :- show_command(Nr).

ids_in_category(Category,IDs) :-
    findall(Id,
    (cli_testcase(Id,Groups,_Conf,_Args,_Desc),member(Category,Groups)),
    List),
    remove_dups(List,IDs).

inc_test_target_coverage :-
    bb_get(test_target_coverage,X),
    X1 is X+1,
    bb_put(test_target_coverage,X1).

init_test_runner :- startup_prob,counter_init.

is_existing_file(X) :- \+ number(X), atom(X),
    atom_codes(X,Codes),[BS] = "/", (member(BS,Codes) -> true),
    file_exists(X).

is_file(F) :- atom(F), atom_codes(F,Codes), member(47,Codes),!.

is_global_time_out_cmd('-global_time_out').

is_global_time_out_cmd('--global_time_out').

is_global_time_out_cmd('-time_out'). % old version

jenkins_sanity_check :-
    sanity_check(true),
    (sanity_check_failed -> halt1 ; halt(0)).

l_pr([]) :- nl.

l_pr([H|T]) :- print(' '),print(H), l_pr(T).

last :- run_last_test.

lookup_test_description(Id,Desc) :- cli_testcase(Id,_,_,_,Desc).

makefile_by_category(File, Categories) :-
    (is_list(Categories) -> Cats = Categories ; Cats = [Categories]),
    my_open(File, Stream),
    format(Stream, 'PROBCLI=probcli~n',[]),
    format(Stream, 'test_all:', []),
    makefile_write_categories(Stream, Cats),
    makefile_by_category_aux(Stream, Cats),
    my_close(Stream).

makefile_by_category_aux(_Stream, []).

makefile_by_category_aux(Stream, [Cat | Cats]) :-
    makefile_by_category_single(Stream, Cat),
    makefile_by_category_aux(Stream, Cats).

makefile_by_category_single(Stream, Cat) :-
    findall(testcase(Id, TestCategories, Infos, Arguments, Comment),
    (cli_testcase(Id, TestCategories, Infos, Arguments, Comment),
    member(Cat, TestCategories)),
    List),
    (List=[] -> format_warning_nl('*** No testcase with category ~w found', [Cat])
    ; format(Stream, '~n~w:~n', [Cat]), makefile_write_calls(Stream, List)).

makefile_write_arguments(Stream, []) :-
    format(Stream, '~n', []).

makefile_write_arguments(Stream, [Arg | Args]) :-
    format(Stream, ' ~w', [Arg]),
    (quote_next_arg(Arg) -> makefile_write_arguments_quoted(Stream,Args)
    ; makefile_write_arguments(Stream, Args)).

makefile_write_arguments_quoted(Stream, []) :-
    format(Stream, '~n', []).

makefile_write_arguments_quoted(Stream, [Arg | Args]) :-
    format(Stream, ' \"~w\"', [Arg]),
    makefile_write_arguments(Stream, Args).

makefile_write_calls(_Stream, []).

makefile_write_calls(Stream, [testcase(Id, _TestCategories, _Infos, Arguments, Comment) | Tests]) :-
    (Comment='' -> true ; format(Stream,'\techo \"Test ~w : ~w\"~n',[Id,Comment])),
    format(Stream, '\t$(PROBCLI)', []),
    makefile_write_arguments(Stream, Arguments),
    makefile_write_diff(Stream, Id),
    makefile_write_calls(Stream, Tests).

makefile_write_categories(Stream, []) :-
    format(Stream, '~n', []).

makefile_write_categories(Stream, [Cat | Cats]) :-
    format(Stream, ' ~a', [Cat]),
    makefile_write_categories(Stream, Cats).

makefile_write_diff(Stream, ID) :-
    get_testcase_diff_check_output(ID, File1, File2),
    format(Stream, '\tdiff -b ~w ~w~n', [File1, File2]),
    fail.

makefile_write_diff(_Stream, _ID).

match_preference(A,A).

match_preference(A,B) :- eclipse_preference(A,B) ; eclipse_preference(B,A).

modify_timeout(_,OldOptions,New) :-
    append(_,['-expcterr','time_out'|_],OldOptions), !, New=OldOptions. % we expect a time_out

modify_timeout(Factor,[],['-p','TIME_OUT',NVal]) :-
    % timeout was not set at all - set it to Factor*Default
    % Note: there is a potential problem when the time_out is set inside the machine and not in the test !! TO DO: fix
    preferences:preference_default_value(time_out,DEFAULT),
    multiply_and_truncate_timeout(DEFAULT, Factor, NVal).

modify_timeout(Factor,[GTC,OLD|T],[GTC,NewT|MT]) :- is_global_time_out_cmd(GTC),!,
    tools:arg_is_number(OLD,OLDT),
    multiply_and_truncate_timeout(Factor, OLDT, NewT),
    modify_timeout(Factor,T,MT).

modify_timeout(Factor,['-p','TIME_OUT',OLD|T],['-p','TIME_OUT',NewT|T]) :-
    tools:arg_is_number(OLD,OLDT), !,
    multiply_and_truncate_timeout(Factor, OLDT, NewT). % TODO: we currently assume global_time_out appears before

modify_timeout(Factor,[H|T],[H|MT]) :- modify_timeout(Factor,T,MT).