Suppress CR in quiet mode, patch by Derek Fawcus.

[pforth] / fth / t_tools.fth

\ @(#) t_tools.fth 97/12/10 1.1\r
\ Test Tools for pForth\r
\\r
\ Based on testing tools from John Hayes\r
\ (c) 1993 Johns Hopkins University / Applied Physics Laboratory\r
\\r
\ Syntax was changed to avoid conflict with { -> and } for local variables.\r
\ Also added tracking of #successes and #errors.\r
\r
anew task-t_tools.fth\r
\r
decimal\r
\r
variable TEST-DEPTH\r
variable TEST-PASSED\r
variable TEST-FAILED\r
\r
: TEST{\r
        depth test-depth !\r
        0 test-passed !\r
        0 test-failed !\r
;\r
\r
\r
: }TEST\r
        test-passed @ 4 .r ."  passed, "\r
        test-failed @ 4 .r ."  failed." cr\r
;\r
\r
\r
VARIABLE actual-depth 		\ stack record\r
CREATE actual-results 20 CELLS ALLOT\r
\r
: empty-stack \ ( ... -- ) Empty stack.\r
   DEPTH dup 0>\r
   IF 0 DO DROP LOOP\r
   ELSE drop\r
   THEN ;\r
\r
CREATE the-test 128 CHARS ALLOT\r
\r
: ERROR 	\ ( c-addr u -- ) Display an error message followed by\r
		\ the line that had the error.\r
   TYPE the-test COUNT TYPE CR \ display line corresponding to error\r
   empty-stack 			\ throw away every thing else\r
;\r
\r
\r
: T{\r
	source the-test place\r
	empty-stack\r
;\r
\r
: }T{ 	\ ( ... -- ) Record depth and content of stack.\r
	DEPTH actual-depth ! 	\ record depth\r
	DEPTH 0\r
	?DO\r
		actual-results I CELLS + !\r
	LOOP \ save them\r
;\r
\r
: }T 	\ ( ... -- ) Compare stack (expected) contents with saved\r
		\ (actual) contents.\r
	DEPTH\r
	actual-depth @ =\r
	IF 	\ if depths match\r
		1 test-passed +!  \ assume will pass\r
		DEPTH 0\r
		?DO 			\ for each stack item\r
			actual-results I CELLS + @ \ compare actual with expected\r
			<>\r
			IF\r
				-1 test-passed +!\r
				1 test-failed +!\r
				S" INCORRECT RESULT: " error\r
				LEAVE\r
			THEN\r
		LOOP\r
	ELSE 				\ depth mismatch\r
		1 test-failed +!\r
		S" WRONG NUMBER OF RESULTS: " error\r
	THEN\r
;\r