;; Function To Be Tested: TY  (Programmer's Assistant Command)
;;
;; Source: Xerox Common Lisp Implementation Notes (Lyric Beta Release)
;;		CLtL, Section 20.2
;; Section: The Evaluator
;; Page: 29
;;
;; Created By:   John Park
;;
;; Creation Date: Feb 16, 1987
;;
;; Last Update:  Feb 27, 1987 
;;
;; Filed As:      {ERIS}<lispcore>test>exec>ty.u
;;
;;
;; Syntax:        TY &rest FILES
;;
;; Function Description: Print the contents of FILES in the exec window, hiding 
;; comments  
;; 
;; Argument(s):  FILES
;;			  
;; Returns:     See function description
;;
;; Constraints/Limitations: Due to the nature of Programmer's Assistant commands,
;; testing them will be accomplished by using the interlisp function bksysbuf 
;; in do-test form.  Comments are incorporated within  each command file. 
;; The do-test test setup is titled "TY-TEST-SETUP", which executes the command 
;; string. The do-test form within the command file will return T or "test "quote" 
;; failed in file "unknown". " This test file requires TEDIT package.  
;; The test result will be logged automatically in the following file:
;; {ERIS}<lispcore>test>exec>test.report

(DO-TEST 'TY-TEST-SETUP
	(PROGN 
		(SETQ TEST-RESULT "{ERIS}<LISPCORE>TEST>EXEC>TEST.REPORT")
		(DEFUN R-FORMAT (STATUS) 
			(FORMAT *OUTPUT* "~%COMMAND: TY ~%STATUS:  ~A  DATE:  ~A  TESTER:  ~A~%" STATUS (IL:DATE) IL:USERNAME))
		(SETQ MESS1 "Creating a file with comments in ({core}TY)...")
		(SETQ MESS2 "Displaying the Contents of a file without comments...")
		(SETQ MESS3 "Now do-test will determine if the file {core}TEST contains no comments as displayed by TY command")
	
		(DEFUN MESSAGE (MESS) (PROGN  
							    (PRINC MESS)
							    (SLEEP 1)
								(VALUES)
						  )
		)
				
		(MESSAGE MESS1)
		(SETQ TY-WINDOW (IL:CREATEW '(100 100 400 200)
		  				"TY WINDOW FOR TESTING"))
		(SETQ TY-STREAM 
			(IL:OPENTEXTSTREAM ";;;; Lisp Init File
;;; Set up the USER package.
(require 'calculus) ;I use CALCULUS a lot. Load it.
(use-package 'calculus) ;Get easy access to its exported symbols.
(require 'newtonian-mechanics) ;Ditto for NEWTONIAN-MECHANICS.
(use-package 'newtonia-mechanics)" TY-WINDOW))
		(IL:TEDIT.PUT TY-WINDOW '{CORE}TY)
		(CLOSE TY-STREAM)
		(IL:CLOSEW TY-WINDOW)
		(SETQ DO-LIST-CONTENTS 
			'("(require 'calculus)"
			"(use-package 'calculus)"
			"(require 'newtonian-mechanics)"
			"(use-package 'newtonia-mechanics)"))

		(SETQ TY-COMMAND-STRING 
"(MESSAGE MESS2)
(DRIBBLE '{CORE}TY-TEST)
TY {CORE}TY
(DRIBBLE)
(MESSAGE MESS3)
(SETQ NO-COMMENTS-FLG NIL) 
(SETQ X (OPEN '{CORE}TY-TEST))
(DO ((CNT 0 (1+ CNT))) 
	((= CNT 5) T) ; moves the pointer to 6th line
	(READ-LINE X))
(DOLIST  (Y DO-LIST-CONTENTS)
	(IF (STRING-EQUAL Y (READ-LINE X)) 
			(PUSH T NO-COMMENTS-FLG)
			(PUSH NIL NO-COMMENTS-FLG)
	)
)
(MAPCAR #'CLOSE (IL:OPENP))
(MAPCAR #'DELETE-FILE (IL:DIRECTORY '{CORE}))
(DO-TEST 'SEE-WITHOUT-COMMENT-TEST-RESULT
   	(PROG2 (SETQ *OUTPUT* (OPEN TEST-RESULT :DIRECTION :OUTPUT
		 		:IF-EXISTS  :APPEND))
            (IF (NOTANY #'NULL NO-COMMENTS-FLG)
				(PROGN (R-FORMAT 'SUCCESS) T)
				(PROGN (R-FORMAT 'FAIL) NIL))
             (CLOSE *OUTPUT*)
	)
)

")
		(IL:BKSYSBUF TY-COMMAND-STRING)
	)
)

STOP