test.sa
Generated by gen_html_sa_files from ICSI. Contact gomes@icsi.berkeley.edu for details
---------------------------> Sather 1.1 source file <--------------------------
-- Copyright (C) International Computer Science Institute, 1995. COPYRIGHT --
-- NOTICE: This code is provided "AS IS" WITHOUT ANY WARRANTY and is subject --
-- to the terms of the SATHER LIBRARY GENERAL PUBLIC LICENSE contained in --
-- the file "Doc/License" of the Sather distribution. The license is also --
-- available from ICSI, 1947 Center St., Suite 600, Berkeley CA 94704, USA. --
--------> Please email comments to sather-bugs@icsi.berkeley.edu. <----------
-- test.sa: Class for testing classes.
class TEST
class TEST is
-- To be included by a testing class. The test routine should
-- start with the call `class_name("CLASS_FOO");'. It should then
-- have calls to `test' or `unchecked_test' which actually perform
-- the test. It should end with `finish' to print out the results.
-- The results are sent to both `stderr' and `stdout' so you can
-- redirect output to a file and still see whether all tests were
-- passed. The routine being tested must return a string. The
-- basic classes all have routines named `str' to produce string
-- representations of themselves. A typical test might look something
-- like: `test("sum", (1+1).str, "2");'. The tests are numbered and
-- the failures are summarized at the end.
shared class_name_str:STR; -- The name of the tested class.
shared failures:FLIST{INT}; -- The tests which failed.
shared failure_docs:FLIST{STR}; -- The documentation of the failures.
shared test_number:INT; -- Which test.
shared checked_tests:INT;
class_name(nm:STR)
-- Specify the name of the class being tested. Must be called first.
is
class_name_str:=nm;
test_number:=1;
checked_tests:=0;
#OUT + "Test of class " + nm + ":\n\n"
end; -- class_name
test(doc_ds,does_ds,should_ds:$STR)
-- Perform the test with the description `doc', return value `does',
-- and desired return value `should'. Keep track of failures.
is
doc: STR := doc_ds.str; does: STR := does_ds.str;
should:STR := should_ds.str;
if (void(class_name_str)) then
#ERR + "Error in TEST class: \"class_name\" not called\n";
class_name_str := "!!!UNKNOWN_CLASS_NAME!!!";
test_number := 1;
checked_tests := 0;
end;
#OUT + " " + class_name_str + " Test ";
#OUT + test_number.str + " (" + doc + ") ";
if does.is_eq(should).not then
failures:=failures.push(test_number);
failure_docs:=failure_docs.push(doc);
#OUT + " Found problem!\n";
else
#OUT + " succeeded\n";
end;
#OUT + " Should = " + should + "\n";
#OUT + " Does = " + does + "\n\n";
test_number:=test_number+1;
checked_tests:=checked_tests+1;
end; -- test
raise_test(testname:$STR,testrout:ROUT:FMT,should:STR)
-- Performs the test with the desciption 'doc'. The routine
-- 'testrout' is expected to raise an exception with the string
-- representation 'should'.
is
protect
test( testname, testrout.call, "raise \""+should.str+"\"." );
when $STR then
test( testname, exception, should );
else
raise exception
end;
end; -- raisetest
unchecked_test(doc_ds,does_ds,should_ds:$STR)
-- Perform the test with the description `doc', return value `does',
-- and desired return value `should'. Don't keep track of failures.
is
doc: STR := doc_ds.str; does: STR := does_ds.str;
should:STR := should_ds.str;
#OUT + " " + class_name_str + " Test " + test_number.str +
" (" + doc + ")\n";
#OUT + " Should = " + should + "\n";
#OUT + " Does = " + does +"\n\n";
test_number:=test_number+1
end; -- unchecked_test
finish
-- Complete the testing on the current class.
is
if failures.is_empty then
-- Put on both ERR and OUT so one can avoid looking
-- if one wants.
-- we don't want to print hundreds of 'passed' lines.
-- #ERR + "Class " + class_name_str +
-- " passed all " + checked_tests + " checkable tests.\n";
#ERR + class_name_str + ' ';
#OUT + "OUT: Class " + class_name_str +
" passed all " + checked_tests + " checkable tests.\n"
else
loop
f1::=failures.elt!.str;
f2::=failure_docs.elt!;
msg::="Class "+class_name_str+" failed test "+f1+" ("+f2+")\n";
#ERR + "\n" + msg;
#OUT + "OUT: " + msg;
end;
end
end; -- finish
end; -- class TEST
class TEST_TEST
class TEST_TEST is
-- Test of `TEST'.
include TEST;
main is
-- Test of `TEST'.
class_name("TEST");
test("A good test", "good", "good");
test("A bad test", "good", "bad");
raise_test("A raise test", bind(raising), "an exception");
unchecked_test("Unchecked test", "anything", "anything");
finish;
end; -- main
raising: STR
is
raise "an exception"
end; -- raising
end; -- class TEST_TEST