1% * -*- Mode: Prolog -*- */
    2
    3default_ref_dir("ref").
    4default_test_dir("target").
    5
    6:- dynamic failed_test/2.    7:- dynamic only_test/1.    8
    9base_path(Dir) :-
   10	prolog_load_context(directory,SrcDir),
   11	string_concat(SrcDir,"../../",Dir).
   12base_path(Dir) :-
   13	working_directory(Dir,Dir).  % default
   14
   15biomake_path(Path) :-
   16	base_path(Dir),
   17	string_concat(Dir,"bin/biomake",Path).
   18
   19biomake_cmd(Args,Target,Cmd) :-
   20	biomake_path(Make),
   21	format(string(Cmd),"~s ~s ~s",[Make,Args,Target]).
   22
   23user:prolog_exception_hook(_,
   24                           _, _, _) :-
   25        backtrace(99),
   26        !,
   27        fail.
   28
   29test(N) :-
   30	assert(only_test(N)),
   31	test.
   32
   33test :-
   34	init_counts,
   35
   36	announce("FAILURE TESTS"),
   37	run_failure_test("-f Makefile.cyclic","test1"),
   38	run_failure_test("-f Makefile.cyclic","cyclic.test1"),
   39	run_failure_test("--no-backtrace -f Makefile.err","empty"),
   40	run_failure_test("--no-backtrace -f Makefile.tab","empty"),
   41	run_failure_test("--no-backtrace","missing_target"),
   42	run_failure_test("ref","target",["echo Up to date >uptodate"],[],"--no-backtrace","uptodate"),
   43	
   44	announce("PROLOG SYNTAX"),
   45	run_test("-p Prolog.makespec","simple_prolog"),
   46	run_test("-p Prolog.makespec","lower_case_variable.pltest"),
   47	run_test("-p Prolog.makespec","upper_case_var_assignment"),
   48	run_test("ref/prolog","target/prolog",["rm [hmz]*"],[],"",""),
   49	run_test("ref","target",[],[],"-f Makefile.translate -T Makefile.translated","Makefile.translated"),
   50	
   51	announce("BASIC GNU MAKEFILE SYNTAX"),
   52	run_test("simple"),
   53	run_test("target1"),
   54	run_test("target2"),
   55	run_test("silent"),
   56	run_test("one_line"),
   57	run_test("one_line_with_deps"),
   58	run_test("comment_in_rule"),
   59	run_test("comment_in_deps"),
   60	run_test("-f Makefile.include","inc2.test"),
   61	run_test("-f Makefile.include","makefile_list"),
   62	run_test("-f Makefile.include goal1 goal2 goal3","makecmdgoals"),
   63	run_test("-f Makefile.dir1","relative_include_path"),
   64	run_test("forced_rebuild"),
   65	run_test("ref","target",["touch old_dep","echo Pre-update >older_dep"],[],"","older_dep"),
   66	run_test("ref","target",["echo Pre-update >newer_dep","sleep 1","touch new_dep"],[],"","newer_dep"),
   67	run_test("altrules1.type1"),
   68	run_test("altrules2.type1"),
   69	run_failure_test("ref","target",["touch altdep1"],[],"-f Makefile.patterns","deps_exist_but_rules_fail"),
   70	run_test("ref","target",["touch pattern.dep"],[],"-f Makefile.patterns","pattern_deps_exist_but_rules_fail"),
   71	run_test("-f Makefile.patterns -B setup_always_make_with_missing_pattern_dep","always_make_with_missing_pattern_dep.test"),
   72	run_test("escape_dollar"),
   73	run_test("percent_in_body"),
   74	run_test("split_lines"),
   75	run_test("split_recipe_lines"),
   76	run_test("split_target_lines"),
   77	run_test("-f Makefile.dep_linebreak","dep_linebreak"),  % overlaps somewhat with split_target_lines, so moved closer to it
   78	run_failure_test("--no-backtrace -f Makefile.nl","escaped_nl"),
   79	run_test("--no-backtrace -f Makefile.nl2","escaped_nl2"),
   80	run_test("wildcard_deps"),
   81	run_test("-f Makefile.suppress","suppress_errors_temporarily"),
   82	run_test("-f Makefile.suppress -Q test","suppress_errors_temporarily_in_script"),
   83	run_test("-f Makefile.targetexpr","braces_in_deplist"),
   84	run_test("-f Makefile.targetexpr","function_in_deplist"),
   85	run_test("-f Makefile.targetexpr","slash_var_in_deplist"),
   86	run_test("-f Makefile.targetexpr","var_slash_var_in_deplist"),
   87	run_test("-f Makefile.modifier","padded_modifier"),
   88	run_test("-f Makefile.modifier","padded_modifier_from_foreach"),
   89
   90	announce("SPECIAL TARGETS"),
   91	run_test("-f Makefile.oneshell","oneshell"),
   92	run_test("ref","target",["echo untouched by biomake > oneshell_control"],[],"-f Makefile.oneshell_control","oneshell_control"),
   93	run_test("ref","target",["echo empty > test.phony","echo empty > test2.phony"],[],"-f Makefile.phony1","phony_target"),
   94	run_test("ref","target",["echo empty > test.phony","echo empty > test2.phony"],[],"-f Makefile.phony2","expanded_phony_target"),
   95	run_test("-f Makefile.ignore","ignore"),
   96	run_failure_test("-f Makefile.ignore_control","ignore_control"),
   97	run_test("-f Makefile.ignore_all","ignore_all"),
   98	run_test("-f Makefile.delete","deltest"),
   99	run_test("-f Makefile.delete","deltest2"),
  100
  101	announce("AUTOMATIC VARIABLES"),
  102	run_test("stem.echo"),
  103	run_test("first_dep"),
  104	run_test("all_deps"),
  105	run_test("subdir/target_file"),
  106	run_test("subdir/target_dir"),
  107	run_test("subdir/stem_file.txt"),
  108	run_test("subdir/stem_dir.txt"),
  109	run_test("dep_file"),
  110	run_test("dep_dir"),
  111	run_test("deps_file"),
  112	run_test("deps_dir"),
  113
  114	announce("VARIABLES"),
  115	run_test("multiple.wildcards.baz"),
  116	run_test("vars1"),
  117	run_test("DEF=def","vars2"),
  118	run_test("ABC=123","vars3"),
  119	run_test("hyphenated_var"),
  120	run_test("unbound_var"),
  121	run_test("multi_targets_from_var"),
  122	run_test("append_var"),
  123	run_test("append_simple_var"),
  124	run_test("append_recursive_var"),
  125	run_test("computed_var1"),
  126	run_test("computed_var2"),
  127	run_test("computed_var3"),
  128	run_test("two_lines"),
  129	run_test("shell_assign"),
  130	run_test("-f Makefile.env","envtest"),
  131	run_test("-f Makefile.env","envtest2"),
  132	run_test("-p Makespec.env2","envtest3"),
  133	run_test("-p Makespec.env2","envtest4"),
  134	
  135	announce("CONDITIONAL SYNTAX"),
  136	run_test("-f Makefile.cond","ifdef_true"),
  137	run_test("-f Makefile.cond","ifdef_false"),
  138	run_test("-f Makefile.cond","ifeq_true"),
  139	run_test("-f Makefile.cond","ifeq_false"),
  140	run_test("-f Makefile.cond","ifndef_true"),
  141	run_test("-f Makefile.cond","ifndef_false"),
  142	run_test("-f Makefile.cond","ifneq_true"),
  143	run_test("-f Makefile.cond","ifneq_false"),
  144	run_test("-f Makefile.cond","ifeq_true_ifneq_false"),
  145	run_test("-f Makefile.cond","ifeq_false_ifneq_true"),
  146	run_test("-f Makefile.cond","nested_ifeq_ifneq"),
  147	run_test("-f Makefile.cond","nested_ifeq_include"),
  148	run_test("-f Makefile.cond","ifeq_space1"),
  149	run_test("-f Makefile.cond","ifeq_space2"),
  150	run_test("-f Makefile.cond","ifeq_space3"),
  151	run_test("-f Makefile.cond","ifeq_quote"),
  152	run_test("-f Makefile.cond","ifeq_dblquote"),
  153	run_test("-f Makefile.cond","empty_ifeq"),
  154	run_test("-f Makefile.cond","complex_ifeq"),
  155
  156	announce("TEXT FUNCTIONS"),
  157	run_test("subst"),
  158	run_test("patsubst"),
  159	run_test("substref"),
  160	run_test("substref_list"),
  161	run_test("strip"),
  162	run_test("findstring1"),
  163	run_test("findstring2"),
  164	run_test("filter"),
  165	run_test("filter_out"),
  166	run_test("sort"),
  167	run_test("word2"),
  168	run_test("words"),
  169	run_test("wordlist"),
  170	run_test("firstword"),
  171	run_test("lastword"),
  172	run_test("var_in_command"),
  173
  174	announce("FILENAME FUNCTIONS"),
  175	run_test("dir"),
  176	run_test("notdir"),
  177	run_test("basename"),
  178	run_test("suffix"),
  179	run_test("addsuffix"),
  180	run_test("addprefix"),
  181	run_test("join"),
  182	run_test("wildcard"),
  183	run_test("wildcard_nonexistent"),
  184	run_test("abspath"),
  185	run_test("realpath"),
  186
  187	announce("CONDITIONAL FUNCTIONS"),
  188	run_test("if1"),
  189	run_test("if2"),
  190	run_test("if3"),
  191	run_test("if4"),
  192	run_test("or1"),
  193	run_test("or2"),
  194	run_test("or3"),
  195	run_test("and1"),
  196	run_test("and2"),
  197
  198	announce("OTHER FUNCTIONS"),
  199	run_test("call"),
  200	run_test("shell"),
  201	run_test("foreach"),
  202	run_test("value"),
  203	run_test("bad_function_syntax"),
  204	run_test("function_whose_args_are_both_expressions"),
  205
  206	announce("ARITHMETIC FUNCTIONS"),
  207	run_test("iota"),
  208	run_test("iota2"),
  209	run_test("add"),
  210	run_test("multiply"),
  211	run_test("divide"),
  212	run_test("iota_add_multiply"),
  213
  214	announce("MD5 CHECKSUMS"),
  215
  216	% this is a low-level unit test of the MD5 checksums
  217	run_test("ref/md5","target/md5",[],[],"-B -H --debug md5","hello_world"),
  218
  219	% this tests that the file is not rebuilt just because of modification times
  220	biomake_cmd("-f Makefile.md5 -H --debug md5","md5_avoid_update",MakeMd5AvoidUpdate),
  221	run_test("ref","target",[MakeMd5AvoidUpdate,"sleep 1","touch md5_avoid_update_dep"],[],"-f Makefile.md5 -H --debug md5 SRC=test","md5_avoid_update"),
  222
  223	% the next test fakes out the MD5 checksums... kind of hacky
  224	% the general idea is to test whether biomake can be tricked into NOT making a target
  225	% because the MD5 checksums and file sizes look correct.
  226	% this is really a way of checking that biomake is paying attention to the checksums,
  227	% while only looking at the files it generates.
  228	run_test("ref/md5.wrong","target/md5.wrong",["echo wrong >hello","echo wrong >world","echo wrong_wrong >hello_world","sleep 1","mkdir -p .biomake/md5","cp ../md5.checksums/* .biomake/md5"],[],"-H","hello_world"),
  229
  230	% this next test checks that the MD5 checksums *can't* be faked out if file sizes change.
  231	% basically the same as the previous test, but now one of the "wrong" files (world)
  232	% is also the wrong length, which should trigger its rebuild - but not the rebuild of
  233	% hello_world, on which it depends, since that has the right length and its MD5 looks OK.
  234	run_test("ref/md5.len","target/md5.len",["echo wrong >hello","echo wrong length >world","echo wrong_wrong >hello_world","sleep 1","mkdir -p .biomake/md5","cp ../md5.checksums/* .biomake/md5"],[],"-H","hello_world"),
  235
  236	% this next test checks that the MD5 checksums are recomputed if the MD5 cache file modification times look stale.
  237	run_test("ref/md5.time","target/md5.time",["echo wrong >hello","echo wrong_wrong >hello_world","sleep 1","mkdir -p .biomake/md5","cp ../md5.checksums/* .biomake/md5","sleep 1","echo world >world"],[],"-H","hello_world"),
  238
  239	% this next test checks that, once the MD5 checksums are recomputed if the MD5 cache file modification times look stale, the target is then rebuilt if the hash turns out to have been different from the one stored in the cache file.
  240	run_test("ref/md5.time2","target/md5.time2",["echo wrong >hello","echo wrong_wrong >hello_world","sleep 1","mkdir -p .biomake/md5","cp ../md5.checksums/* .biomake/md5","sleep 1","echo wrong >world"],[],"-H","hello_world"),
  241
  242	announce("QUEUES"),
  243
  244	% Queues are a bit under-served by tests at the moment...
  245	% The first two tests just test that the Makefile is working and that commands can be run from a script.
  246	run_test("-f Makefile.queue","i.am.the.garbage.flower"),
  247	run_test("-f Makefile.queue --one-shell","love.will.tear.us.apart"),
  248	% The remaining tests use the test queue (which just runs commands in a script),
  249	% the thread-pool queue, and a faked version of the SGE queue, with and without MD5 hashes.
  250	run_test("-f Makefile.queue -Q test","what.difference.does.it.make"),
  251	run_test("-f Makefile.queue -Q poolq","they.made.you.a.moron"),
  252	run_test("-f Makefile.queue -Q test -H","under.blue.moon.i.saw.you"),
  253	run_test("-f Makefile.queue -Q poolq -H","the.head.on.the.door"),
  254	run_test("ref","target",[],["t/slurm/fake_swait"],"-d -f Makefile.queue -Q slurm --qsub-exec ../slurm/fake_sbatch --qdel-exec ../slurm/fake_scancel","slurmtest"),
  255	run_test("ref","target",[],["t/sge/fake_qwait"],"-d -f Makefile.queue -Q sge --qsub-exec ../sge/fake_qsub --qdel-exec ../sge/fake_qdel","outside.theres.a.boxcar.waiting"),
  256	run_test("ref","target",[],["t/sge/fake_qwait"],"-d -f Makefile.queue -Q sge -H --qsub-exec ../sge/fake_qsub --qdel-exec ../sge/fake_qdel","that.was.my.favourite.dress"),
  257	run_test("ref","target",[],["t/sge/fake_qwait"],"-d -f Makefile.queue -Q sge --qsub-exec ../sge/fake_qsub --qdel-exec ../sge/fake_qdel --queue-args '--fake-arg dummy'","walk.right.through.the.door"),
  258	run_test("ref","target",["rm test_file"],["t/sge/fake_qwait"],"-d -f Makefile.queue -Q sge --qsub-exec ../sge/fake_qsub --qdel-exec ../sge/fake_qdel","your-own-personal-jesus"),
  259	run_test("ref","target",["rm test_file2"],["t/sge/fake_qwait"],"-d -f Makefile.queue -Q sge --qsub-exec ../sge/fake_qsub --qdel-exec ../sge/fake_qdel","reach-out,touch-faith"),
  260	run_test("ref","target",["echo 'echo testing test_file3 >test_file3' >test_header_file"],["t/sge/fake_qwait"],"-d -f Makefile.queue -Q sge --qsub-exec ../sge/fake_qsub --qdel-exec ../sge/fake_qdel","flesh_and_bone_by_the_telephone"),
  261
  262	announce("COMMAND-LINE OPTIONS"),
  263	run_test("--file=Makefile.argval","arg_equals_val"),
  264	run_test("-f Makefile.subdir.include -I subdir","include_dir"),
  265	run_test("ref","target",["touch what_if_dep","sleep 1","echo Pre-update >what_if"],[],"-W what_if_dep","what_if"),
  266	run_test("ref","target",["echo Pre-update >old_file_target","sleep 1","touch old_file_target_dep"],[],"-o old_file_target","old_file_target"),
  267	run_test("ref","target",["echo Pre-update >old_file_dep","sleep 1","touch old_file_dep_dep"],[],"-o old_file_dep_dep","old_file_dep"),
  268	run_test("-k nonexistent_target","keep_going"),
  269	run_failure_test("another_nonexistent_target","stop_on_error1"),
  270	run_failure_test("-k -S yet_another_nonexistent_target","stop_on_error2"),
  271	run_test("ref","target",["echo Pre-update >touch"],[],"-B -t","touch"),
  272	run_test("ref/md5.touch","target/md5.touch",["echo wrong >hello","echo wrong >world","echo wrong_wrong >hello_world"],[],"-t -H","hello_world"),
  273	run_test("ref","target",["echo Pre-update >multi_arg"],[],"-Bk still_another_nonexistent_target","multi_arg"),
  274	run_test("CMDLINE_VAR=average --eval EVAL_VAR=worthy","cmdline_eval1"),
  275	run_test("CMDLINE_VAR=mediocre. --eval-prolog EVAL_VAR=deserving.","cmdline_eval2"),
  276	
  277	announce("EMBEDDED PROLOG SYNTAX"),
  278	run_test("-f Makefile.bagof","bagof1"),
  279	run_test("-f Makefile.bagof","bagof2"),
  280	run_test("-f Makefile.bagof","bagof3"),
  281	run_test("-f Makefile.goal","headgoal_a"),
  282	run_test("-f Makefile.goal","headgoal_x"),
  283	run_test("-f Makefile.goal","depgoal_a"),
  284	run_test("-f Makefile.goal","depgoal_x"),
  285	run_test("-f Makefile.goal","head_and_dep_goals_a_b"),
  286	run_test("-f Makefile.goal","head_and_dep_goals_a_x"),
  287	run_test("-f Makefile.goal","head_and_dep_goals_x_b"),
  288	run_test("-f Makefile.goal","head_and_dep_goals_x_y"),
  289	run_test("-f Makefile.goal","multiline_depgoal_c_b"),
  290	run_test("-f Makefile.goal","multiline_depgoal_a_x"),
  291	run_test("-f Makefile.goal","multiline_depgoal_x_b"),
  292	run_test("-f Makefile.goal","multi_matches_abc.def.ghi.jkl"),
  293	run_test("-f Makefile.goal","pass_var_to_prolog"),
  294	run_test("-f Makefile.goal","pass_var_to_prolog2"),
  295	run_test("-f Makefile.goal","pass_var_to_prolog3"),
  296	run_test("ref/embedded","target/embedded",["rm [hmz]*"],[],"",""),
  297	run_test("-f Makefile.precedence","rule_precedence_generic"),
  298	run_test("-f Makefile.precedence","rule_precedence_specific1"),
  299	run_test("-f Makefile.precedence","rule_precedence_specific2"),
  300	run_test("-f Makefile.precedence","rule_precedence_specific3"),
  301	run_test("-f Makefile.precedence","rule_precedence_somewhat_specific"),
  302	run_test("-f Makefile.precedence","rule_precedence_even_more_control"),
  303	run_test("-f Makefile.precedence","rule_precedence_even_more_specific"),
  304	run_test("-f Makefile.depchain","dep_chain_one_step"),
  305	run_test("-f Makefile.depchain","dep_chain_two_step"),
  306	run_test("-f Makefile.size_file","size_file_empty_dep"),
  307	run_test("-f Makefile.size_file","size_file_nonempty_dep"),
  308	run_test("-f Makefile.size_file -Q test","size_file_empty_test_dep"),
  309	run_test("-f Makefile.size_file -Q test","size_file_nonempty_test_dep"),
  310	run_test("-f Makefile.size_file -Q poolq","size_file_empty_poolq_dep"),
  311	run_test("-f Makefile.size_file -Q poolq","size_file_nonempty_poolq_dep"),
  312	run_test("-f Makefile.dcg","dcg_test"),
  313	run_test("-f Makefile.dcg","mismatch_dcg_test"),
  314
  315	announce("PCRE REGEX LIBRARY"),
  316	run_test("-f Makefile.regex","testregex_apple"),
  317	run_failure_test("-f Makefile.regex","testregex_cat"),
  318	run_failure_test("-f Makefile.regex","testregex_ALBACORE"),  % fails due to default case-sensitivity of regexes
  319
  320	announce("REMOTE SYNC"),
  321	run_test("ref/sync","target/sync",[],[],"","all"),
  322
  323	announce("EXPANDED ARGUMENTS IN TEXT FUNCTIONS"),
  324	run_test("-f Makefile.expand","abspath_expanded"),
  325	run_test("-f Makefile.expand","addprefix_expanded"),
  326	run_test("-f Makefile.expand","addsuffix_expanded"),
  327	run_test("-f Makefile.expand","filter_expanded"),
  328	run_test("-f Makefile.expand","filter_out_expanded"),
  329	run_test("-f Makefile.expand","findstring1_expanded"),
  330	run_test("-f Makefile.expand","findstring2_expanded"),
  331	run_test("-f Makefile.expand","foreach_addsuffix_expanded"),
  332	run_test("-f Makefile.expand","foreach_findstring_expanded"),
  333	run_test("-f Makefile.expand","join_expanded"),
  334	run_test("-f Makefile.expand","patsubst_expanded"),
  335	run_test("-f Makefile.expand","realpath_expanded"),
  336	run_test("-f Makefile.expand","sort_expanded"),
  337	run_test("-f Makefile.expand","subst_expanded"),
  338	run_test("-f Makefile.expand","wildcard_expanded"),
  339	run_test("-f Makefile.expand","word2_expanded"),
  340
  341	% All done
  342	report_counts,
  343        (   failed_test(_,_)
  344        ->  halt(1)
  345        ;   halt(0)).
  346
  347init_counts :-
  348	nb_setval(tests,0),
  349	nb_setval(passed,0).
  350
  351announce(_) :-
  352    only_test(_),
  353    !.
  354
  355announce(X) :-
  356    string_chars(X,C),
  357    length(C,L),
  358    n_chars(L,'=',Bc),
  359    string_chars(Banner,Bc),
  360    format("~w~n~w~n~w~n~n",[Banner,X,Banner]).
  361
  362report_counts :-
  363	only_test(_),
  364	!.
  365
  366report_counts :-
  367	nb_getval(tests,T),
  368	nb_getval(passed,P),
  369	(P = T -> format("ok: passed ~d/~d tests~n",[P,T]);
  370	 (forall(failed_test(N,D),
  371		 format("Failed test #~d: ~w~n",[N,D])),
  372	  format("not ok: passed ~d/~d tests~n",[P,T]))).
  373
  374run_test(Target) :-
  375	default_ref_dir(RefDir),
  376	default_test_dir(TestDir),
  377	report_test(RefDir,TestDir,[],[],"",Target,"~s",[Target]).
  378
  379run_test(Args,Target) :-
  380	default_ref_dir(RefDir),
  381	default_test_dir(TestDir),
  382	report_test(RefDir,TestDir,[],[],Args,Target,"~s ~s",[Args,Target]).
  383
  384run_test(RefDir,TestDir,Setup,Cleanup,Args,Target) :-
  385	report_test(RefDir,TestDir,Setup,Cleanup,Args,Target,"[t/~s,t/~s,~s ~s]",[RefDir,TestDir,Args,Target]).
  386
  387report_test(RefDir,TestDir,Setup,Cleanup,Args,Target,Fmt,Vars) :-
  388	working_directory(CWD,CWD),
  389	start_test(Fmt,Vars,Desc),
  390	!,
  391	(exec_test(RefDir,TestDir,Setup,Cleanup,Args,Target)
  392         -> pass_test(Desc); fail_test(Desc)),
  393	working_directory(_,CWD).
  394
  395report_test(_,_,_,_,_,_,_,_).
  396
  397start_test(Fmt,Vars,Desc) :-
  398	inc(tests),
  399	nb_getval(tests,T),
  400	(only_test(N) -> N = T; true),
  401	format(string(Desc),Fmt,Vars),
  402	format("Starting test #~d: ~s~n",[T,Desc]).
  403
  404pass_test(Desc) :-
  405        nb_getval(tests,T),
  406        format("ok: passed test #~d: ~s~n~n",[T,Desc]),
  407	inc(passed).
  408
  409fail_test(Desc) :-
  410        nb_getval(tests,T),
  411	assert(failed_test(T,Desc)),
  412	format("not ok: failed test #~d: ~s~n~n",[T,Desc]).
  413
  414inc(Counter) :-
  415	nb_getval(Counter, C),
  416	CNew is C + 1,
  417	nb_setval(Counter, CNew).
  418
  419make_test_path(Dir,TestPath) :-
  420    format(string(TestPath),"t/~s",[Dir]).
  421
  422make_test_path(Dir,Target,TestPath) :-
  423    format(string(TestPath),"t/~s/~s",[Dir,Target]).
  424
  425exec_test(RefDir,TestDir,Setup,Cleanup,Args,Target) :-
  426	make_test_path(TestDir,TestPath),
  427	make_test_path(TestDir,Target,TargetPath),
  428	biomake_cmd(Args,Target,Exec),
  429	working_directory(CWD,TestPath),
  430	% If no "Setup" shell commands were specified, remove the target file.
  431	% If Setup commands were specified, let the caller take care of this.
  432	(Setup = []
  433         -> (exists_file(Target)
  434             -> (format("Deleting ~w~n",[Target]),
  435                 delete_file(Target))
  436             ; true)
  437         ; (forall(member(Cmd,Setup),
  438	          (format("~s~n",[Cmd]),
  439                   shell(Cmd); true)))),
  440	format("Running '~s' in ~s~n",[Exec,TestPath]),
  441	shell(Exec,Err),
  442	!,
  443	(Err = 0 -> true; format("Error code ~w~n",Err), fail),
  444	working_directory(_,CWD),
  445	% 'Cleanup' is a bit of a misnomer, it's more like a post-processing step
  446	forall(member(Cmd,Cleanup),
  447	       (format("~s~n",[Cmd]),
  448               shell(Cmd); true)),
  449	compare_output(TestDir,RefDir,Target),
  450	% If no "Setup" shell commands were specified, remove the target file again at the end.
  451	(Setup = [] -> (exists_file(TargetPath) -> delete_file(TargetPath); true); true).
  452
  453% If we are using the default test & reference directories,
  454% then just compare the target files.
  455compare_output(TestDir,RefDir,Target) :-
  456    default_test_dir(TestDir),
  457    default_ref_dir(RefDir),
  458    !,
  459    make_test_path(TestDir,TestPath),
  460    make_test_path(RefDir,RefPath),
  461    compare_files(TestPath,RefPath,Target).
  462
  463% If we are not in the default test & reference directories,
  464% then compare the entire directories, allowing for more sensitive tests.
  465compare_output(TestDir,RefDir,_) :-
  466    make_test_path(TestDir,TestPath),
  467    make_test_path(RefDir,RefPath),
  468    compare_files(TestPath,RefPath).
  469
  470non_ignored_files(Dir,List) :-
  471    directory_files(Dir,Files),
  472    include(not_ignored,Files,List).
  473
  474not_ignored(File) :-
  475    \+ ignored(File).
  476ignored('.').
  477ignored('..').
  478ignored('tmp').
  479
  480compare_files(TestPath,RefPath,File) :-
  481    format(string(TestFilePath),"~s/~s",[TestPath,File]),
  482    format(string(RefFilePath),"~s/~s",[RefPath,File]),
  483    compare_files(TestFilePath,RefFilePath).
  484
  485% Directory version of compare_files recursively compares directories
  486compare_files(TestPath,RefPath) :-
  487    exists_directory(TestPath),
  488    exists_directory(RefPath),
  489    !,
  490    format("Comparing directory ~s to ~s~n",[TestPath,RefPath]),
  491    non_ignored_files(TestPath,TestFiles),
  492    non_ignored_files(RefPath,RefFiles),
  493    (lists_equal(TestFiles,RefFiles);
  494     (format("File lists do not match~n~w: ~w~n~w: ~w~n",[TestPath,TestFiles,RefPath,RefFiles]),
  495      fail)),
  496    !,
  497    forall(member(File,TestFiles),
  498	   compare_files(TestPath,RefPath,File)).
  499
  500% File version of compare_files tests for equality
  501compare_files(TestPath,RefPath) :-
  502    format("Comparing file ~s to ~s ... ",[TestPath,RefPath]),
  503    read_string_from_file(TestPath,TestText),
  504    read_string_from_file(RefPath,RefText),
  505    RefText = TestText,
  506    format("match: ~w == ~w~n",[TestPath,RefPath]).
  507
  508% If file version of compare_files failed, but files were present, then print a diff
  509compare_files(TestPath,RefPath) :-
  510	exists_file(TestPath),
  511	exists_file(RefPath),
  512	format("MISMATCH: ~w != ~w~n",[TestPath,RefPath]),
  513	format(string(Diff),"diff -y ~s ~s",[TestPath,RefPath]),
  514	format("~s:~n",[Diff]),
  515	shell(Diff,_),
  516	fail.
  517
  518% If file version of compare_files failed because a file is absent, then say so
  519compare_files(TestPath,_) :-
  520	file_missing(TestPath),
  521	fail.
  522
  523compare_files(_,RefPath) :-
  524	file_missing(RefPath),
  525	fail.
  526
  527lists_equal([],[]) :- !.
  528lists_equal([X|Xs],[X|Ys]) :- !, lists_equal(Xs,Ys).
  529    
  530file_missing(Path) :-
  531	\+ exists_file(Path),
  532	format("File ~s does not exist~n",[Path]).
  533
  534read_string_from_file(Path,String) :-
  535	exists_file(Path),
  536	open(Path,read,IO,[]),
  537	read_string(IO,"","",_,String),
  538	close(IO).
  539
  540run_failure_test(Args,Target) :-
  541	default_ref_dir(RefDir),
  542	default_test_dir(TestDir),
  543	report_failure_test(RefDir,TestDir,[],[],Args,Target,"[~s ~s] (expecting failure)",[Args,Target]).
  544
  545run_failure_test(RefDir,TestDir,Setup,Cleanup,Args,Target) :-
  546        report_failure_test(RefDir,TestDir,Setup,Cleanup,Args,Target,"[t/~s,t/~s,~s ~s] (expecting failure)",[RefDir,TestDir,Args,Target]).
  547
  548report_failure_test(RefDir,TestDir,Setup,Cleanup,Args,Target,Fmt,Vars) :-
  549	working_directory(CWD,CWD),
  550	start_test(Fmt,Vars,Desc),
  551	!,
  552	(exec_test(RefDir,TestDir,Setup,Cleanup,Args,Target)
  553         -> fail_test(Desc); pass_test(Desc)),
  554	working_directory(_,CWD).
  555
  556report_failure_test(_,_,_,_,_,_,_,_).
  557
  558n_chars(N,_,[]) :- N =< 0, !.
  559n_chars(N,C,[C|Ls]) :- Ndec is N - 1, n_chars(Ndec,C,Ls), !