1% ---------------------------------------------------------------------- 2% BEGIN LICENSE BLOCK 3% Version: CMPL 1.1 4% 5% The contents of this file are subject to the Cisco-style Mozilla Public 6% License Version 1.1 (the "License"); you may not use this file except 7% in compliance with the License. You may obtain a copy of the License 8% at www.eclipse-clp.org/license. 9% 10% Software distributed under the License is distributed on an "AS IS" 11% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See 12% the License for the specific language governing rights and limitations 13% under the License. 14% 15% The Original Code is The ECLiPSe Constraint Logic Programming System. 16% The Initial Developer of the Original Code is Cisco Systems, Inc. 17% Portions created by the Initial Developer are 18% Copyright (C) 1995-2006 Cisco Systems, Inc. All Rights Reserved. 19% 20% Contributor(s): IC-Parc, Imperal College London 21% 22% END LICENSE BLOCK 23% 24% System: ECLiPSe Constraint Logic Programming System 25% Version: $Id: test_util.pl,v 1.4 2013/01/23 21:06:00 jschimpf Exp $ 26% ---------------------------------------------------------------------- 27 28:- module(test_util). 29 30:- lib(calendar). 31 32:- export op(1200,fy,(fixme)). 33:- export op(1110,xfx,(should_give)). 34:- export op(1110,xf,(should_fail)). 35:- export op(1110,xfx,(should_throw)). 36:- export op(1110,xfx,(should_raise)). 37 38:- export test/2, test/1, test_info/2. 39:- export (should_give)/2, (should_fail)/1, 40 (should_throw)/2, (should_raise)/2, 41 (should_give)/3, (should_fail)/2, 42 (should_throw)/3, (should_raise)/3, 43 (fixme)/1, 44 get_failed_test_count/1. 45 46:- export make_integer/1, make_float/1, make_rational/1, make_bignum/1, 47 make_interval/1, make_neginteger/1, make_negfloat/1, 48 make_negrational/1, make_negbignum/1, make_neginterval/1, 49 make_atom/1, make_nil/1, make_string/1, make_struct/1, 50 make_list/1, make_var/1. 51 52 53:- tool((should_give)/2, should_give_body/3). 54:- tool((should_fail)/1, should_fail_body/2). 55:- tool((should_throw)/2, should_throw_body/3). 56:- tool((should_raise)/2, should_raise_body/3). 57 58:- tool((should_give)/3, should_give_body/4). 59:- tool((should_fail)/2, should_fail_body/3). 60:- tool((should_throw)/3, should_throw_body/4). 61:- tool((should_raise)/3, should_raise_body/4). 62 63:- tool(test_info/2, test_info_body/3). 64:- tool(test/2, test_body/3). 65:- tool(test/1, test_body/2). 66 67%% Number of tests 68:- local variable(test_count, 0). 69%% Number of skipped tests 70:- local variable(skipped_test_count, 0). 71%% Number of failed tests 72:- local variable(failed_test_count, 0). 73%% Line number of current test 74:- local variable(test_line, 0). 75 76:- set_stream(testlog, output). 77:- set_stream(test_csv_log, null). 78 79:- comment(categories, ["Development Tools"]). 80:- comment(summary, "Utilities for automated program tests"). 81:- comment(author, "Joachim Schimpf, IC-Parc"). 82:- comment(copyright, "Cisco Systems, Inc"). 83:- comment(date, "$Date: 2013/01/23 21:06:00 $"). 84:- comment(desc, html(" 85 Use this library as follows: Write a file with test patterns, using 86 the primitives should_fail/1, should_give/2, should_throw/2 and 87 should_raise/2, e.g. 88 <PRE> 89 3.0 > 3 should_fail. 90 X is 3.0+4 should_give X=7.0. 91 throw(ball) should_throw ball. 92 number_string(hello,_) should_raise 5. 93 </PRE> 94 The file name should have a .tst extension, e.g. mytests.tst. 95 Then run all the test in the file by calling test(mytests). This will 96 print a message for every test pattern that does not behave as expected. 97 The messages go to a stream called testlog (which defaults to output). 98 99 <P> 100 Alternatively, you can write a file with test patterns, using the 101 primitives should_fail/2, should_give/3, should_throw/3 and 102 should_raise/3, e.g. 103 <PRE> 104 should_fail(3.0 > 3, test_float_not_greater_than_integer). 105 should_give(X is 3.0+4, X=7.0, test_float_plus_integer_equals_float). 106 should_throw(throw(ball),ball,test_throw). 107 should_raise(number_string(hello,_),5,test_raises_5). 108 </PRE> 109 Here the extra last argument serves as a name for the test (or a short 110 description). It can be an atom or a string and it is used to output 111 results in comma separated format to a stream called test_csv_log 112 (defaults to null), e.g. test(mytest) should output the following to 113 test_csv_log: 114 <PRE> 115 test_float_not_greater_than_integer,pass,2001-10-29,16:59:20,0.00 116 test_float_plus_integer_equals_float,pass,2001-10-29,16:59:20,0.01 117 test_throw,pass,2001-10-29,16:59:20,0.00 118 test_raises_5,pass,2001-10-29,16:59:20,0.00 119 </PRE> 120 The first value is the name of the test (last argument in test pattern). 121 The second value is either `pass' or `fail' indicating whether the 122 particular test was successful or not. The third and fourth values show 123 the date and time (UTC) the test was run (in ISO 8601 format). The last 124 value shows the CPU time taken to run the test. 125 Extra values can be appended at the head of the comma separated values 126 by using test_info/2, e.g. test_info(mytest,test_result) would change 127 the output to test_csv_log as follows: 128 <PRE> 129 test_result,test_float_not_greater_than_integer,pass,2001-10-29,16:59:20,0.00 130 test_result,test_float_plus_integer_equals_float,pass,2001-10-29,16:59:20,0.01 131 test_result,test_throw,pass,2001-10-29,16:59:20,0.00 132 test_result,test_raises_5,pass,2001-10-29,16:59:20,0.00 133 </PRE> 134 This can be extremely useful, as useful information as the name of the 135 module tested, the directory where it is located, the name of the host, 136 etc. can be added to the log. 137 ")). 138 139:- comment((should_fail)/1, [ 140 template:"+Goal should_fail", 141 summary:"Run the goal Goal and print a message if it doesn't fail", 142 eg:"3.0 > 3 should_fail.", 143 see_also:[(should_give)/2, (should_throw)/2, (should_raise)/2, (should_fail)/2, 144 (should_give)/3, (should_throw)/3, (should_raise)/3] 145 ]). 146:- comment((should_fail)/2, [ 147 template:"should_fail(+Goal,+TestName)", 148 summary:"Run the goal Goal and print a message if it doesn't fail", 149 eg:"should_fail(3.0 > 3, test_float_not_greater_than_integer).", 150 see_also:[(should_give)/2, (should_throw)/2, (should_raise)/2, (should_fail)/1, 151 (should_give)/3, (should_throw)/3, (should_raise)/3] 152 ]). 153 :- comment((should_give)/2, [ 154 template:"+Goal should_give +CheckGoal", 155 summary:"Run the goal Goal and print a message if Goal and CheckGoal don't succeed", 156 desc:html("<P> 157 Run the goal Goal and print a message if Goal does not succeed, or 158 if the result doesn't satisfy CheckGoal. 159</P><P> 160 CheckGoal can be an arbitrary user-defined goal. In this case, the 161 first solution of Goal is committed to, and CheckGoal executed with 162 the variable instantiations of this solution. 163</P><P> 164 To allow verification of goals with multiple solutions, one special 165 form of CheckGoal is recognised: 166<BLOCKQUOTE> 167 multiple_solutions(SolCountVar, FinalCheck, SolutionCheck) 168</BLOCKQUOTE> 169 where SolCountVar should be a fresh variable. With such a CheckGoal, 170 ALL solutions to Goal will be generated. For each solution, SolutionCheck 171 will be executed with the variable instantiations of this solution, and 172 with SolCountVar instantiated to the number of this solution (starting 173 from 1). After all solutions have been found, FinalCheck will be 174 executed, with SolCountVar instantiated to the total number of solutions. 175</P>"), 176 eg:" 177 % Testing deterministic goals 178 179 X is 3.0+4 should_give X=7.0. 180 181 T1=foo(_,_), copy_term(T1,T2) should_give variant(T1,T2). 182 183 184 % Testing nondeterministic goals 185 186 member(X,[a,b,c]) should_give multiple_solutions(K, K==3, 187 ( K==1 -> X==a 188 ; K==2 -> X==b 189 ; K==3 -> X==c 190 )). 191 ", 192 see_also:[(should_fail)/1, (should_throw)/2, (should_raise)/2, (should_give)/3, 193 (should_fail)/2, (should_throw)/3, (should_raise)/3] 194 ]). 195:- comment((should_give)/3, [ 196 template:"should_give(+Goal,+CheckGoal,+TestName)", 197 summary:"Run the goal Goal and print a message if the result doesn't satisfy CheckGoal", 198 eg:"should_give(X is 3.0+4, X=7.0, test_float_plus_integer_equals_float).", 199 see_also:[(should_fail)/1, (should_throw)/2, (should_raise)/2, (should_give)/2, 200 (should_fail)/2, (should_throw)/3, (should_raise)/3] 201 ]). 202 203:- comment((should_throw)/2, [ 204 template:"+Goal should_throw +Exception", 205 summary:"Run the goal Goal and print a message if it doesn't throw Exception", 206 desc:"The exception term thrown must be an instance (see instance/2) of Exception", 207 eg:" 208 throw(ball) should_throw ball. 209 throw(error(type,atom)) should_throw error(type,_). 210 ", 211 see_also:[(should_give)/2, (should_fail)/1, (should_raise)/2, (should_throw)/3, 212 (should_give)/3, (should_fail)/2, (should_raise)/3, instance/2] 213 ]). 214:- comment((should_throw)/3, [ 215 template:"should_throw(+Goal,+Exception,+TestName)", 216 summary:"Run the goal Goal and print a message if it doesn't throw Exception", 217 desc:"The exception term thrown must be an instance (see instance/2) of Exception", 218 eg:" 219 should_throw(throw(ball),ball,test_throw). 220 should_throw(throw(error(type,atom)),error(type,_),test_type_error). 221 ", 222 see_also:[(should_give)/2, (should_fail)/1, (should_raise)/2, (should_throw)/2, 223 (should_give)/3, (should_fail)/2, (should_raise)/3, instance/2] 224 ]). 225:- comment((should_raise)/2, [ 226 template:"+Goal should_raise +Event", 227 summary:"Run the goal Goal and print a message if it doesn't raise Event.", 228 eg:"number_string(hello,_) should_raise 5. % type error", 229 see_also:[(should_give)/2, (should_fail)/1, (should_throw)/2, (should_raise/3), 230 (should_give)/3, (should_fail)/2, (should_throw)/3] 231 ]). 232:- comment((should_raise)/3, [ 233 template:"should_raise(+Goal,+Event,+TestName)", 234 summary:"Run the goal Goal and print a message if it doesn't raise Event.", 235 eg:"should_raise(number_string(hello,_),5,test_raises_5). % type error", 236 see_also:[(should_give)/2, (should_fail)/1, (should_throw)/2, (should_raise/2), 237 (should_give)/3, (should_fail)/2, (should_throw)/3] 238 ]). 239:- comment((fixme)/1, [ 240 template:"fixme +SkippedTest", 241 summary:"Skip a test that is known to fail.", 242 desc:"fixme/1 is a low-precedence prefix operator, and can thus be 243 textually prefixed to any other test. Its effect is that the test 244 is skipped (not executed). When multiple tests are done, the number 245 of skipped tests gets reported at the end. Skipped tests count as 246 neither succeeded or failed.", 247 eg:"fixme X is 0.1+0.1+0.1+0.1+0.1+0.1+0.1+0.1 should_give X=0.8.", 248 see_also:[(should_give)/2, (should_fail)/1, (should_throw)/2, (should_raise/2), 249 (should_give)/3, (should_fail)/2, (should_throw)/3] 250 ]). 251 252:- comment((get_failed_test_count)/1, [ 253 template:"get_failed_test_count(-N)", 254 summary:"Returns the number of tests that failed.", 255 desc: html(" 256<P> 257 The test framework counts the number of tests which fail; use this 258 predicate to retrieve this number. 259 ") 260]). 261 262:- comment((test)/1, [ 263 template:"test(+File)", 264 summary:"Runs all the test patterns in File.", 265 see_also:[test/2, test_info/2, 266 (should_give)/2, (should_fail)/1, (should_throw)/2, (should_raise)/2, 267 (should_give)/3, (should_fail)/2, (should_throw)/3, (should_raise)/3] 268 ]). 269 270:- comment((test)/2, [ 271 template:"test(+File, +Option)", 272 summary:"Runs all the test patterns in File.", 273 desc:html("\ 274 Runs all the test patterns in File. Option is either 'call' (the default) 275 or 'compile'. 276 When 'call' is chosen, every test goal gets executed simply by metacall 277 using call/1. 278 When 'compile' is chosen, every test goal gets compiled into an auxiliary 279 predicate (with all compile-time transformations applied), which in turn 280 is then executed. 281 "), 282 see_also:[test_info/2, 283 (should_give)/2, (should_fail)/1, (should_throw)/2, (should_raise)/2, 284 (should_give)/3, (should_fail)/2, (should_throw)/3, (should_raise)/3] 285 ]). 286 287:- comment((test_info)/2, [ 288 template:"test_info(+File,+Info)", 289 summary:"Runs all the test patterns in File, printing the Info string in test_csv_log.", 290 see_also:[test/1, 291 (should_give)/2, (should_fail)/1, (should_throw)/2, (should_raise)/2, 292 (should_give)/3, (should_fail)/2, (should_throw)/3, (should_raise)/3] 293 ]). 294 295 296get_failed_test_count(FailedTestsCount) :- 297 getval(failed_test_count, FailedTestsCount). 298 299test_body(File, Module) :- 300 test_body(File, call, "", Module). 301 302 303test_info_body(File, Info, Module) :- 304 test_body(File, call, Info, Module). 305 306test_body(File, Type, Module) :- 307 test_body(File, Type, "", Module). 308 309test_body(File, Type, Info, Module) :- 310 existing_file(File, ["",".tst"], [readable], File1), !, 311 open(File1, read, S), 312 printf(testlog, "%nRunning tests from file (using %w) %w...%n%b", [Type,File1]), 313 setval(test_count, 0), 314 setval(failed_test_count, 0), 315 setval(skipped_test_count, 0), 316 test_stream(S, Type, Info, Module), 317 close(S). 318test_body(File, _Type, _Info, _Module) :- 319 printf(testlog, "%nTest file not found: %w%n%b", [File]). 320 321test_stream(S, Type, Info, M) :- 322 repeat, 323 get_stream_info(S, line, Line), 324 setval(test_line, Line), 325 read(S, Test)@M, 326 ( Test == end_of_file -> 327 !, 328 getval(test_count, N), 329 getval(failed_test_count, FN), 330 getval(skipped_test_count, SN), 331 DN is N-SN, 332 ( SN==0 -> true ; printf(testlog, "%n%d tests skipped.", [SN]) ), 333 printf(testlog, "%n%d tests done.%n%d tests failed.%n%b", [DN,FN]) 334 ; 335 ( Info == "" -> 336 true 337 ; 338 printf(test_csv_log, "%q,", [Info]) 339 ), 340 cputime(Start), 341 342 do_test(Type, Test, M), 343 344 cputime(End), 345 CPUTime is End - Start, 346 get_date_and_time_strings(DateString, TimeString), 347 printf(test_csv_log, "%w,%w,%f%n", [DateString, TimeString, CPUTime]), 348 incval(test_count), 349 fail 350 ). 351 352printf_with_line(OutStream, Message, Params) :- 353 getval(test_line, Line), 354 ( Line > 0 -> 355 concat_strings("====== Line %d: ", Message, Format), 356 printf(OutStream, Format, [Line|Params]) 357 ; 358 concat_strings("====== ", Message, Format), 359 printf(OutStream, Format, Params) 360 ). 361 362get_date_and_time_strings(DateString, TimeString) :- 363 get_date_and_time(Date, Time), 364 date_to_string(Date, DateString), 365 time_to_string(Time, TimeString). 366 367date_to_string(Year-Month-Day, DateString) :- 368 open(string(""), write, DateStream), 369 printf(DateStream, "%04d-%02d-%02d", [Year, Month, Day]), 370 get_stream_info(DateStream, name, DateString), 371 close(DateStream). 372 373time_to_string(Hour:Minute:Second, TimeString) :- 374 open(string(""), write, TimeStream), 375 printf(TimeStream, "%02d:%02d:%02.0f", [Hour, Minute, Second]), 376 get_stream_info(TimeStream, name, TimeString), 377 close(TimeStream). 378 379get_date_and_time(Date, Time) :- 380 mjd_now(MJD), 381 mjd_to_ymd(MJD, Date), 382 mjd_to_time(MJD,Time). 383 384 385do_test(call, Test, M) ?- 386 once(Test)@M. 387do_test(compile, Test, M) ?- 388 compile_test_call(Test, M). 389 390compile_test_call(Test, M) :- 391 extract_test_goal(Test, Goal0, Head, NewTest), 392 catch(expand_goal(Goal0, Goal)@M, 393 _, Goal0 = Goal % ignore problem until compilation 394 ), 395 term_variables(Goal, Vars), 396 Head =.. ['$test__',_|Vars], 397 % catch and ignore `illegal goal' error if should_raise 398 get_event_handler(131, HH, HM), 399 set_event_handler(131, expected_handler/0), 400 catch( 401 (compile_term((Head:-Goal))@M -> 402 arg(1, Head, Test), 403 once(NewTest)@M, 404 functor(Head, F,A), 405 abolish(F/A)@M 406 ; 407 incval(failed_test_count), 408 printf_with_line(testlog, "Compilation of goal failed unexpectedly:%n%q%n%n%b", [Test]) 409 ), Tag, 410 ((Tag == ignore, nonvar(Test), Test = should_raise(_,_)) -> 411 true 412 ; 413 incval(failed_test_count), 414 printf_with_line(testlog, "Compilation of goal aborted unexpectedly:%n%q%n%n%b", [Test]) 415 ) 416 ), 417 set_event_handler(131, HH)@HM. 418 419% extract_test_goal(+Test, -Goal, -TemplateGoal, -TemplateTest) 420% extract the test goal Goal from the test pattern Test, and 421% create a new template for the test that will be used to call 422% the compiled test, the call itself, TemplateGoal, should be 423% filled in before calling TemplateTest 424extract_test_goal(should_fail(Goal), G0, G1, NewTest) ?- !, 425 G0 = Goal, 426 NewTest = should_fail(G1). 427extract_test_goal(should_fail(Goal,_Name), G0, G1, NewTest) ?- !, 428 G0 = Goal, 429 NewTest = should_fail(G1). 430 431extract_test_goal(should_give(Goal,Check), G0, G1, NewTest) ?- !, 432 G0 = Goal, 433 NewTest = should_give(G1,Check). 434extract_test_goal(should_give(Goal,Check,_Name), G0, G1, NewTest) ?- !, 435 G0 = Goal, 436 NewTest = should_give(G1,Check). 437 438extract_test_goal(should_raise(Goal,ErrorId), G0, G1, NewTest) ?- !, 439 G0 = Goal, 440 NewTest = should_raise(G1,ErrorId). 441extract_test_goal(should_raise(Goal,ErrorId,_Name), G0, G1, NewTest) ?- !, 442 G0 = Goal, 443 NewTest = should_raise(G1,ErrorId). 444 445extract_test_goal(should_throw(Goal,Expected), G0, G1, NewTest) ?- !, 446 G0 = Goal, 447 NewTest = should_throw(G1,Expected). 448extract_test_goal(should_throw(Goal,Expected,_Name), G0, G1, NewTest) ?- !, 449 G0 = Goal, 450 NewTest = should_throw(G1,Expected). 451 452extract_test_goal(Goal, Goal, G1, G1). 453 454 455fixme(_Test) :- 456 incval(skipped_test_count). 457 458 459should_fail_body(Goal, Module) :- 460 catch(should_fail1(Goal, Module), _, true). 461 462should_fail_body(Goal, Name, Module) :- 463 printf(test_csv_log, "%q,", [Name]), 464 catch(should_fail1(Goal, Module), _, true). 465 466 should_fail1(Goal, Module) :- 467 ( catch(call(Goal)@Module, Tag, unexpected_exit(Goal,Tag)) -> 468 unexpected_success(Goal) 469 ; 470 write(test_csv_log, "pass,") 471 ). 472 473 474should_give_body(Goal, Check, Module) :- 475 catch(should_give1(Goal, Check, Module), _, true). 476 477should_give_body(Goal, Check, Name, Module) :- 478 printf(test_csv_log, "%q,", [Name]), 479 catch(should_give1(Goal, Check, Module), _, true). 480 481 should_give1(Goal, multiple_solutions(K,CheckCount,Check), Module) ?- !, 482 shelf_create(count(0), Count), 483 ( 484 catch(call(Goal)@Module, Tag, unexpected_exit(Goal,Tag)), 485 shelf_inc(Count, 1), 486 ( var(K) -> shelf_get(Count, 1, K) ; true ), 487 ( catch(call(Check)@Module, _, fail) -> 488 fail % next solution 489 ; 490 write(test_csv_log, "fail,"), 491 incval(failed_test_count), 492 printf_with_line(testlog, "goal gave unexpected result:%n%q%n",[Goal]), 493 printf(testlog, "------ did not satisfy:%n%q%n%n%b", [Check]) 494 ) 495 ; 496 shelf_get(Count, 1, K), 497 ( catch(call(CheckCount)@Module, Tag, unexpected_exit(CheckCount,Tag)) -> 498 garbage_collect, % try to provoke any gc bugs 499 write(test_csv_log, "pass,") 500 ; 501 write(test_csv_log, "fail,"), 502 incval(failed_test_count), 503 printf_with_line(testlog, "unexpected number of solutions:%n%q%n", [Goal]), 504 printf(testlog, "------ did not satisfy:%n%q%n%n%b", [CheckCount]) 505 ) 506 ). 507 should_give1(Goal, Check, Module) :- 508 ( catch(call(Goal)@Module, Tag, unexpected_exit(Goal,Tag)) -> 509 ( catch(call(Check)@Module, _, fail) -> 510 garbage_collect, % try to provoke any gc bugs 511 write(test_csv_log, "pass,") 512 ; 513 write(test_csv_log, "fail,"), 514 incval(failed_test_count), 515 printf_with_line(testlog, "goal gave unexpected result:%n%q%n",[Goal]), 516 printf(testlog, "------ did not satisfy:%n%q%n%n%b", [Check]) 517 ) 518 ; 519 unexpected_failure(Goal) 520 ). 521 522should_throw_body(Goal, Expected, Module) :- 523 catch(should_throw1(Goal, Expected, Module), _, true). 524 525should_throw_body(Goal, Expected, Name, Module) :- 526 printf(test_csv_log, "%q,", [Name]), 527 catch(should_throw1(Goal, Expected, Module), _, true). 528 529 should_throw1(Goal, Expected, Module) :- 530 ( catch(call(Goal)@Module, Tag, expected_exit(Goal,Expected,Tag)) -> 531 unexpected_success(Goal) 532 ; 533 unexpected_failure(Goal) 534 ). 535 536should_raise_body(Goal, ErrorId, Module) :- 537 catch(should_raise1(Goal, ErrorId, Module), _, true). 538 539should_raise_body(Goal, ErrorId, Name, Module) :- 540 printf(test_csv_log, "%q,", [Name]), 541 catch(should_raise1(Goal, ErrorId, Module), _, true). 542 543 should_raise1(Goal, ErrorId, Module) :- 544 get_event_handler(ErrorId, H, M), 545 set_event_handler(ErrorId, expected_handler/0), 546 ( catch(call(Goal)@Module, Tag, 547 (set_event_handler(ErrorId, H)@M, expected_exit(Goal,ignore,Tag))) 548 -> 549 unexpected_success(Goal) 550 ; 551 unexpected_failure(Goal) 552 ), 553 set_event_handler(ErrorId, H)@M. 554 555 556 expected_handler :- 557 throw(ignore). 558 559 unexpected_success(Goal) :- 560 %% TEST has failed 561 write(test_csv_log, "fail,"), 562 incval(failed_test_count), 563 printf_with_line(testlog, "goal succeeded unexpectedly:%n%q%n%n%b", [Goal]). 564 565 unexpected_failure(Goal) :- 566 %% TEST has failed 567 write(test_csv_log, "fail,"), 568 incval(failed_test_count), 569 printf_with_line(testlog, "goal failed unexpectedly:%n%q%n%n%b", [Goal]). 570 571 unexpected_exit(Goal, Tag) :- 572 %% TEST has failed 573 write(test_csv_log, "fail,"), 574 incval(failed_test_count), 575 printf_with_line(testlog, "goal unexpectedly did throw(%w):%n%q%n%n%b", [Tag,Goal]), 576 throw(ignore). 577 578 expected_exit(Goal, Expected, Actual) :- 579 % The thrown term should be an instance of the Expected template. 580 % Note that the terms may be nonground, 581 % and thrown terms are always copies. 582 ( instance(Actual, Expected) -> 583 %% Test succeeded 584 write(test_csv_log, "pass,") 585 ; 586 %% TEST has failed 587 write(test_csv_log, "fail,"), 588 incval(failed_test_count), 589 printf_with_line(testlog, "goal unexpectedly did throw(%w):%n%q%n%n%b", [Actual,Goal]) 590 ), 591 throw(ignore). 592 593 594%%%%%%%%%%%%%%%%%%% 595% 596% type generation predicates -- avoid problems with smart compilers 597% 598 599make_integer(1). 600make_float(1.1). 601make_interval(1.0__1.1). 602make_neginteger(-1). 603make_negfloat(-1.1). 604make_neginterval(-1.1__-1.0). 605make_atom(atom). 606make_nil([]). 607make_string("string"). 608make_struct(f(1,2,3)). 609make_list([1,2,3]). 610make_var(_). 611 612% The following hack is to make this file compile even when we 613% don't support bignum/rationals. Fail at runtime instead. 614 615make_rational(X) :- number_string(X, "1_1"). 616make_bignum(X) :- number_string(X, "111111111111111111111111111111111111111111111111111"). 617make_negrational(X) :- number_string(X, "-1_1"). 618make_negbignum(X) :- number_string(X, "-111111111111111111111111111111111111111111111111111"). 619 620