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