(FILECREATED "23-Sep-85 15:38:40" {DANTE}<SVERNON>TESTEXEC.;8
 5415   

      changes to:  (FNS ADD-TO-TEST-SUITE END-TEST-BLOCK)

      previous date: "20-Sep-85 10:12:37" {DANTE}<SVERNON>TESTEXEC.;7)


(* Copyright (c) 1985 by XEROX Corporation. All rights reserved.)

(PRETTYCOMPRINT TESTEXECCOMS)

(RPAQQ TESTEXECCOMS
 [(LISPXMACROS ET ITR ITS ST)
		     (VARS (TEST-SUITE-DATA NIL))
		     (FNS ADD-TO-TEST-SUITE END-TEST-BLOCK EXECUTE-TEST EXECUTE-TEST-GUTS 
			  EXECUTE-TEST-SUITE START-TEST-BLOCK TESTEXEC)
		     (DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
			       (ADDVARS (NLAMA)
					(NLAML ADD-TO-TEST-SUITE)
					(LAMA])

(ADDTOVAR LISPXMACROS
 (ET (END-TEST-BLOCK LISPXLINE))
		      (ITR (NILL))
		      (ITS (NILL))
		      (ST (START-TEST-BLOCK)))

(RPAQQ TEST-SUITE-DATA
 NIL)
(DEFINEQ

(ADD-TO-TEST-SUITE

  [NLAMBDA (SUITE-NAME)                                      (* edited: "23-Sep-85 15:34")

    [
SETQ
 SUITE-NAME (
CAR
 (
NLAMBDA.ARGS
 (
CONS
 SUITE-NAME NIL]
    (if
 (
AND
 SUITE-NAME (
LITATOM
 SUITE-NAME))
	then
 [
OR
 [
AND
 (
BOUNDP
 SUITE-NAME)
		      (
OR
 (
LISTP
 (
EVALV
 SUITE-NAME))
			  (
NULL
 (
EVALV
 SUITE-NAME]
		 (
PROG1
 (
SET
 SUITE-NAME NIL)
			(
MARKASCHANGED
 SUITE-NAME (
QUOTE
 VARS)
				       (if
 (
BOUNDP
 SUITE-NAME)
					   then
 (
QUOTE
 CHANGED)
					 else
 (
QUOTE
 DEFINED]
	     (
SETQ
 TEST-SUITE-DATA SUITE-NAME)
	     (
SETQ
 TEST-BLOCK-START (
CAAR
 LISPXHISTORY))
	     SUITE-NAME
      else
 (
ERROR
 SUITE-NAME "bad suite name"])

(END-TEST-BLOCK

  [LAMBDA (TEST-NAME)                                        (* edited: "23-Sep-85 15:35")

    (if
 (
AND
 (
LISTP
 TEST-NAME)
	     (
LITATOM
 (
CAR
 TEST-NAME))
	     (
EQP
 (
LENGTH
 TEST-NAME)
		  1))
	then
 (if
 TEST-SUITE-DATA
		 then
 (
PROG
 (COMMAND-LIST TEST-COMMANDS)
			    (
SETQ
 COMMAND-LIST (for
 I in
 (
CDAR
 LISPXHISTORY) until
 (
EQ
 I 
										 TEST-BLOCK-START)
						  collect
 (
COPY
 I)))
			    [
SETQ
 TEST-COMMANDS
			      (
CONS
 (
CAR
 TEST-NAME)
				    (
REVERSE
 (for
 I on
 COMMAND-LIST
						collect

						 (
PROGN
 [if
 (
AND
 (
EQ
 (
CAAAR
 I)
								     (
QUOTE
 ITS))
								 (
CDR
 I))
							    then
 (
RPLACA
 (
CDR
 I)
									 (
QUOTE
 (NIL)))
								 (
RPLACA
 I (
QUOTE
 (NIL)))
							  else
 (if
 (
AND
 (
EQ
 (
CAAAR
 I)
									    (
QUOTE
 ITR))
									(
CDR
 I))
								   then
 (
RPLACD
 (
CADR
 I)
										NIL)
									(
RPLACA
 I (
QUOTE
 (NIL]
							(
CONS
 (
CAAR
 I)
							      (
CDDAR
 I]
			    (
SET
 TEST-SUITE-DATA (
APPEND
 (
EVALV
 TEST-SUITE-DATA)
							 (
LIST
 TEST-COMMANDS)))
			    (
MARKASCHANGED
 TEST-SUITE-DATA (
QUOTE
 VARS)
					   (
QUOTE
 CHANGED))
			    (
SETQ
 TEST-BLOCK-START (
CAAR
 LISPXHISTORY))
			    (
RETURN
 (
QUOTE
 End-of-test-block)))
	       else
 (
ERROR
 (
QUOTE
 ET)
			   "no previous ADD-TO-TEST-SUITE"))
      else
 (
ERROR
 (
QUOTE
 ET)
		  "has no test name supplied"])

(EXECUTE-TEST

  [LAMBDA (SUITE TEST-NAME)                                  (* edited: "17-Sep-85 12:59")

    (
PROG
 (TEST)
          (
SETQ
 TEST (
ASSOC
 TEST-NAME SUITE))
          (if
 TEST
	      then
 (
RETURN
 (EXECUTE-TEST-GUTS
 (
CDR
 TEST)))
	    else
 (
ERROR
 TEST-NAME " is not a test name."])

(EXECUTE-TEST-GUTS

  [LAMBDA (TEST)                                             (* edited: "17-Sep-85 12:54")

    (
PROG
 (RESULT)
          (
RETURN
 (for
 STEP in
 TEST always
 (
PROGN
 (if
 (
CDAR
 STEP)
						      then
 (
LISPXUNREAD
 (
CDAR
 STEP)))
						  (
SETQ
 RESULT (
LISPXEVAL
 (
CAAR
 STEP)
									  LISPXID))
						  (if
 (
CDR
 STEP)
						      then
 (
EQUAL
 RESULT (
CADR
 STEP))
						    else
 T])

(EXECUTE-TEST-SUITE

  [LAMBDA (SUITE)                                            (* edited: "20-Sep-85 10:12")

    (for
 TEST in
 SUITE always
 (
PROGN
 (PRINTOUT T "Executing " (
CAR
 TEST)
					       T)
				     (
PROG
 (RESULT)
				           (
SETQ
 RESULT (EXECUTE-TEST-GUTS
 (
CDR
 TEST)))
				           (if
 (
NOT
 RESULT)
					       then
 (PRINTOUT T (
CAR
 TEST)
							      " got an error." T))
				           (
RETURN
 RESULT])

(START-TEST-BLOCK

  [LAMBDA NIL                                                (* scv "30-Aug-85 14:56")

    (if
 TEST-SUITE-DATA
	then
 (
SETQ
 TEST-BLOCK-START (
CAAR
 LISPXHISTORY))
	     (
QUOTE
 Start-of-test-block)
      else
 (
ERROR
 (
QUOTE
 ST)
		  "no previous ADD-TO-TEST-SUITE"])

(TESTEXEC

  [LAMBDA NIL                                                (* scv "30-Aug-85 10:16")

    (
PROG
 (LISPXID)
          (
SETQ
 LISPXID (
QUOTE
 -))
          (
RESETVARS
 (READBUF READBUFSOURCE REREADFLG)
		 LP  (
PROMPTCHAR
 LISPXID T LISPXHISTORY)
		     (
ERSETQ
 (
LISPX
 (
LISPXREAD
 T T)
				    LISPXID))
		     (
GO
 LP])
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA
 )

(ADDTOVAR NLAML
 ADD-TO-TEST-SUITE)

(ADDTOVAR LAMA
 )
)
(PUTPROPS TESTEXEC COPYRIGHT ("XEROX Corporation" 1985))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (830 5187 (ADD-TO-TEST-SUITE 840 . 1612) (END-TEST-BLOCK 1614 . 3192) (EXECUTE-TEST 3194
 . 3532) (EXECUTE-TEST-GUTS 3534 . 4011) (EXECUTE-TEST-SUITE 4013 . 4497) (START-TEST-BLOCK 4499 . 
4818) (TESTEXEC 4820 . 5185)))))
STOP