;;; Test for the function in section 8.2 of the scsh-manual "awk"
;;; Author: Christoph Hetz

;; for  testing: (certainly the path will be an other on other systems...)

;; ,open define-record-types handle
;; ,config ,load C:/cygwin/home/mephisto/cvs_scsh/scsh/scsh/test/test-packages.scm
;; ,load C:/cygwin/home/mephisto/cvs_scsh/scsh/scsh/test/test-base.scm
;; load this file
;; (test-all)



;; *** basic help-functions ***

(define ascii->string
  (lambda (i)
    (list->string (list (ascii->char i)))))

(define char->string
  (lambda (ch)
    (list->string (list ch))))

(define reverse-string
  (lambda (str)
    (list->string (reverse (string->list str)))))


;; *** help-functions ***

(define str-palindrom?
  (lambda (str)
    (equal? str (reverse-string str))))

(define int-palindrom?
  (lambda (i)
    (str-palindrom? (number->string i))))

;; *** tests ***

;; --- is the <counter> incremented correct ---

(add-test! 'counter-inc-test 'awk
	   (lambda ()
	     (let ((read '())
		   (tmp-file (create-temp-file)))
	       (call-with-output-file tmp-file
		 (lambda (out-port)
		   (let loop ((i 0))
		     (if (not (= 9 i))
			 (begin
			   (write "test-zeile\n"  out-port)
			   (loop (+ i 1)))))))

	       (call-with-input-file tmp-file 
		 (lambda (in-port)
		   (awk (read-line in-port) (line) counter ()
			(#t (set! read (cons counter read))))))
	       (delete-file tmp-file)
	       (equal? read '(10 9 8 7 6 5 4 3 2 1)))))

;; --- does the "int-test" work properly ---

(add-test! 'int-test-test 'awk
	   (lambda ()
	     (let ((read '())
		   (tmp-file (create-temp-file)))
	       (call-with-output-file tmp-file
		 (lambda (out-port)
		   (let loop ((i 0))
		     (if (not (= 20 i))
			 (begin
			   (write "test-zeile\n"  out-port)
			   (loop (+ i 1)))))))
	       (call-with-input-file tmp-file
		 (lambda (in-port)
		   (awk (read-line in-port) (line) counter ()
			(1 (set! read (cons 1 read)))
			(2 (set! read (cons 2 read)))
			(3 (set! read (cons 3 read)))
			(4 (set! read (cons 4 read)))
			(5 (set! read (cons 5 read)))
			(6 (set! read (cons 6 read)))
			(7 (set! read (cons 7 read)))
			(8 (set! read (cons 8 read)))
			(9 (set! read (cons 9 read)))
			(0 (set! read (cons 0 read))))))
	       (delete-file tmp-file)
	       (equal? read '(9 8 7 6 5 4 3 2 1)))))

;; --- big line ---

(add-test! 'read-one-mb-line-from-file 'awk
	   (lambda ()
	     (let ((one-kb-line (let loop ((i 0))
				  (if (= 1024 i)
				      ""
				      (string-append "a" (loop (+ i 1))))))
		   (tmp-file (create-temp-file))
		   (read '()))
	       
	       (call-with-output-file tmp-file
		 (lambda (out-port)
		   (let loop ((i 0))
		     (if (= 1024 i)
			 (write-string "" out-port)
			 (begin
			   (write-string one-kb-line out-port)
			   (loop (+ i 1)))))))
	       (call-with-input-file tmp-file
		 (lambda (in-port)
		   (awk (read-line in-port) (line) c ()
			(#t (begin
			      (set! read line))))))
	       (delete-file tmp-file)
	       (and (string? read)
		    (= (string-length read)  
		       (* 1024 1024))))))

;; --- special signs --- 

(add-test! 'read-special-signs 'awk
	   (lambda ()
	     (let (( strange-sign-line
		     (let loop ((i 0))
		       (if (= i 256)
			   ""
			   (if (= i 10)       ;; comes along with everything but line-feed
			       (loop (+ i 1))
			       (string-append (ascii->string i)
			   (loop (+ i 1)))))))
		   (tmp-file (create-temp-file))
		   (read '()))
	       (call-with-output-file tmp-file
		 (lambda (out-port)
		   (write-string strange-sign-line out-port)
		   (write-string "\n" out-port)))
	       (call-with-input-file tmp-file
		 (lambda (in-port)
		   (awk (read-line in-port) (line) ()
			(#t (set! read line)))))
	       (delete-file tmp-file)
	       (equal? read strange-sign-line))))

;; --- sre-expr-test ---

(add-test! 'sre-expr-test-test 'awk
	   (lambda ()
	     (let ((tmp-file (create-temp-file))
		   (read '()))
	       (call-with-output-file tmp-file
		 (lambda (out-port)
		   (write-string "ein paar testzeilen, um\n" out-port)
		   (write-string "sre-expr-test zu prüfen:\n" out-port)
		   (write-string "EINE ZEILE GRO/3...\n" out-port)
		   (write-string "eine zeile klein...\n" out-port)
		   (write-string "eine zeile mit zeichen...\n" out-port)
		   (write-string "*+#'~,;:.-_<>|!§$%&/()=?\"\\[]{}\n" out-port)))
	       (call-with-input-file tmp-file
		 (lambda (in-port)
		   (awk (read-line in-port) (line) ()
			(("sre" "zu") (set! read (cons 'sre-zu read)))
			("eine" (set! read (cons 'eine read)))
			("EINE" (set! read (cons 'EINE read)))
			((* "3") (set! read (cons '*3 read)))
			((? "s") (set! read (cons '?s read)))
			((+ "+") (set! read (cons '++ read))))))
	       (delete-file tmp-file)
	       ;;           |z6         |z5                   |z4                   |z3           |z2             |z1             |
	       (equal? (list '++ '?s '*3 '?s '*3 'eine 'sre-zu '?s '*3 'eine 'sre-zu '?s '*3 'EINE '?s '*3 'sre-zu '?s '*3 'sre-zu)
		    read))))

;; --- when-test ---

(add-test! 'when-bool-exp-test-test 'awk
	   (lambda ()
	     (let ((tmp-file (create-temp-file))
		   (read '()))
	       (call-with-output-file tmp-file
		 (lambda (out-port)
		   (write-string "ein paar testzeilen, um\n" out-port)
		   (write-string "when-bool-expr-test zu prüfen:\n" out-port)
		   (write-string "EINE ZEILE GRO/3...\n" out-port)
		   (write-string "eine zeile klein...\n" out-port)
		   (write-string "eine zeile mit zeichen...\n" out-port)
		   (write-string "*+#'~,;:.-_<>|!§$%&/()=?\"\\[]{}\n" out-port)))
	       (call-with-input-file tmp-file
		 (lambda (in-port)
		   (awk (read-line in-port) (line) counter ()
			((when (= counter 1)) 
			 (set! read (cons 'first-clause read)))
			((when (equal? line 
				       "when-bool-expr-test zu prüfen:"))
			 (set! read (cons 'second-clause read)))
			((when (> counter 2))
			 (set! read (cons 'third-clause read))))))
	       (delete-file tmp-file)
	       (equal? read
		       (list 'third-clause 'third-clause 'third-clause 'third-clause 'second-clause 'first-clause)))))

;; --- expr-test-test ---

(add-test! 'expr-test-test 'awk
	   (lambda ()
	     (let ((tmp-file (create-temp-file))
		   (read '()))
	       (call-with-output-file tmp-file
		 (lambda (out-port)
		   (write-string "ein paar testzeilen, um\n" out-port)
		   (write-string "expr-test zu prüfen:\n" out-port)
		   (write-string "EINE ZEILE GRO/3...\n" out-port)
		   (write-string "eine zeile klein...\n" out-port)
		   (write-string "eine zeile mit zeichen...\n" out-port)
		   (write-string "*+#'~,;:.-_<>|!§$%&/()=?\"\\[]{}\n" out-port)))
	       (call-with-input-file tmp-file
		 (lambda (in-port)
		   (awk (read-line in-port) (line) counter ()
			("paar" (set! read (cons 'first-clause read)))
			((equal? line
				 "expr-test zu prüfen:")
			 (set! line (cons 'second-clause read)))
			((> counter 5)
			 (set! read (cons 'third-clause read)))
			((+ "3")                                  ;; makes problems here, but was ok in sre-xpr-test  ;;FIXXX it
			 (set! read (cons 'fourth-clause read))))))
	       (delete-file tmp-file)
	       (equal? read
		       (list 'third-clause 'fourth-clause 'second-clause 'first-clause)))))

;; --- several-bodys-in-clause-test --- 
;; XX to do: only for <test>s that were ok till now (int, when)

(add-test! 'several-bodys-in-clause-test 'awk
	   (lambda ()
	     (let ((tmp-file (create-temp-file))
		   (read '()))
	       (call-with-output-file tmp-file
		 (lambda (out-port)
		   (write-string "ein paar testzeilen, um\n" out-port)
		   (write-string "expr-test zu prüfen:\n" out-port)
		   (write-string "EINE ZEILE GRO/3...\n" out-port)
		   (write-string "eine zeile klein...\n" out-port)
		   (write-string "eine zeile mit zeichen...\n" out-port)
		   (write-string "*+#'~,;:.-_<>|!§$%&/()=?\"\\[]{}\n" out-port)))
	       (call-with-input-file tmp-file
		 (lambda (in-port)
		   (awk (read-line in-port) (line) counter ()
			(1 (set! read (cons 'clause-one-body-one read))
			   (set! read (cons 'clause-one-body-two read))
			   (set! read (cons 'clause-one-body-three read)))
			((when (equal? line
				       "eine zeile klein..."))
			 (set! read (cons 'clause-two-body-one read))
			 (set! read (cons 'clause-two-body-two read))
			 (set! read (cons 'clause-two-body-three read))))))
	       (delete-file tmp-file)
	       (equal? read
		       (list 'clause-two-body-three 'clause-two-body-two 'clause-two-body-one 
			     'clause-one-body-three 'clause-one-body-two 'clause-one-body-one)))))

;; --- range-wo-begin-wo-end-test --- 
;; XX to do: only ok <test>s ... s.u.

(add-test! 'range-wo-begin-wo-end-test 'awk
	   (lambda ()
	     (let ((tmp-file (create-temp-file))
		   (read '()))
	       (call-with-output-file tmp-file
		 (lambda (out-port)
		   (write-string "ein paar testzeilen, um\n" out-port)
		   (write-string "expr-test zu prüfen:\n" out-port)
		   (write-string "EINE ZEILE GRO/3...\n" out-port)
		   (write-string "eine zeile klein...\n" out-port)
		   (write-string "eine zeile mit zeichen...\n" out-port)
		   (write-string "*+#'~,;:.-_<>|!§$%&/()=?\"\\[]{}\n" out-port)))
	       (call-with-input-file tmp-file
		 (lambda (in-port)
		   (awk (read-line in-port) (line) counter ()
			(range 1 3 (set! read (cons 'first-clause read)))
			(range (when (equal? line 
					     "EINE ZEILE GRO/3..."))
			       (when (equal? line
					     "*+#'~,;:.-_<>|!§$%&/()=?\"\\[]{}"))
			       (set! read (cons 'second-clause read)))
			(range (when (equal? line
					     "expr-test zu prüfen:"))
			       4
			       (set! read (cons 'third-clause read))))))
	       (delete-file tmp-file)
	       (equal? read
		       (list 'second-clause 'second-clause 'third-clause 'first-clause)))))

;; --- range-w-begin-wo-end-test --- 
;; XX to do: only ok <test>s ... s.u.

(add-test! 'range-w-begin-wo-end-test 'awk
	   (lambda ()
	     (let ((tmp-file (create-temp-file))
		   (read '()))
	       (call-with-output-file tmp-file
		 (lambda (out-port)
		   (write-string "ein paar testzeilen, um\n" out-port)
		   (write-string "expr-test zu prüfen:\n" out-port)
		   (write-string "EINE ZEILE GRO/3...\n" out-port)
		   (write-string "eine zeile klein...\n" out-port)
		   (write-string "eine zeile mit zeichen...\n" out-port)
		   (write-string "*+#'~,;:.-_<>|!§$%&/()=?\"\\[]{}\n" out-port)))
	       (call-with-input-file tmp-file
		 (lambda (in-port)
		   (awk (read-line in-port) (line) counter ()
			(:range 1 3 (set! read (cons 'first-clause read)))
			(:range (when (equal? line 
					      "EINE ZEILE GRO/3..."))
				(when (equal? line
					      "*+#'~,;:.-_<>|!§$%&/()=?\"\\[]{}"))
				(set! read (cons 'second-clause read)))
			(:range (when (equal? line
					      "expr-test zu prüfen:"))
				4
				(set! read (cons 'third-clause read))))))
	       (delete-file tmp-file)
	       (equal? read
		       (list 'second-clause 'second-clause 'third-clause 'second-clause 'third-clause 'first-clause 'first-clause)))))

;; --- range-wo-begin-w-end-test --- 
;; XX to do: only ok <test>s ... s.u.

(add-test! 'range-wo-begin-w-end-test 'awk
	   (lambda ()
	     (let ((tmp-file (create-temp-file))
		   (read '()))
	       (call-with-output-file tmp-file
		 (lambda (out-port)
		   (write-string "ein paar testzeilen, um\n" out-port)
		   (write-string "expr-test zu prüfen:\n" out-port)
		   (write-string "EINE ZEILE GRO/3...\n" out-port)
		   (write-string "eine zeile klein...\n" out-port)
		   (write-string "eine zeile mit zeichen...\n" out-port)
		   (write-string "*+#'~,;:.-_<>|!§$%&/()=?\"\\[]{}\n" out-port)))
	       (call-with-input-file tmp-file
		 (lambda (in-port)
		   (awk (read-line in-port) (line) counter ()
			(range: 1 3 (set! read (cons 'first-clause read)))
			(range: (when (equal? line 
					      "EINE ZEILE GRO/3..."))
				(when (equal? line
					      "*+#'~,;:.-_<>|!§$%&/()=?\"\\[]{}"))
				(set! read (cons 'second-clause read)))
			(range: (when (equal? line
					      "expr-test zu prüfen:"))
			       4
			       (set! read (cons 'third-clause read))))))
	       (delete-file tmp-file)
	       (equal? read
		       (list 'second-clause 'second-clause 'third-clause 'second-clause 'third-clause 'first-clause 'first-clause)))))

;; --- range-w-begin-w-end-test --- 
;; XX to do: only ok <test>s ... s.u.

(add-test! 'range-w-begin-w-end-test 'awk
	   (lambda ()
	     (let ((tmp-file (create-temp-file))
		   (read '()))
	       (call-with-output-file tmp-file
		 (lambda (out-port)
		   (write-string "ein paar testzeilen, um\n" out-port)
		   (write-string "expr-test zu prüfen:\n" out-port)
		   (write-string "EINE ZEILE GRO/3...\n" out-port)
		   (write-string "eine zeile klein...\n" out-port)
		   (write-string "eine zeile mit zeichen...\n" out-port)
		   (write-string "*+#'~,;:.-_<>|!§$%&/()=?\"\\[]{}\n" out-port)))
	       (call-with-input-file tmp-file
		 (lambda (in-port)
		   (awk (read-line in-port) (line) counter ()
			(:range: 1 3 (set! read (cons 'first-clause read)))
			(:range: (when (equal? line 
					       "EINE ZEILE GRO/3..."))
				 (when (equal? line
					       "*+#'~,;:.-_<>|!§$%&/()=?\"\\[]{}"))
				 (set! read (cons 'second-clause read)))
			(:range: (when (equal? line
					       "expr-test zu prüfen:"))
				 4
				 (set! read (cons 'third-clause read))))))
	       (delete-file tmp-file)
	       (equal? read
		       (list 'second-clause 'second-clause 'third-clause 'second-clause 'third-clause 
			     'second-clause 'first-clause 'third-clause 'first-clause 'first-clause)))))

;; --- else-test ---

(add-test! 'else-test 'awk
	   (lambda ()
	     (let ((tmp-file (create-temp-file))
		   (read '()))
	       (call-with-output-file tmp-file
		 (lambda (out-port)
		   (write-string "ein paar testzeilen, um\n" out-port)
		   (write-string "expr-test zu prüfen:\n" out-port)
		   (write-string "EINE ZEILE GRO/3...\n" out-port)
		   (write-string "eine zeile klein...\n" out-port)
		   (write-string "eine zeile mit zeichen...\n" out-port)
		   (write-string "*+#'~,;:.-_<>|!§$%&/()=?\"\\[]{}\n" out-port)))
	       (call-with-input-file tmp-file
		 (lambda (in-port)
		   (awk (read-line in-port) (line) ()
			(1 (set! read (cons 'first-clause read)))
			(else (set! read (cons 'second-clause read)))
			(4 (set! read (cons 'third-clause read)))
			(5 (set! read (cons 'fourth-clause read)))
			(else (set! read (cons 'fifth-clause read))))))
	       (delete-file tmp-file)
	       (equal? read
		       (list 'fifth-clause 'second-clause 'fourth-clause 'second-clause 'third-clause  
			     'second-clause 'fifth-clause 'second-clause 'fifth-clause 'second-clause 
			     'fifth-clause 'first-clause)))))


;; --- test=>expr-test ---

(add-test! 'test=>expr-test 'awk
	   (lambda ()
	     (let ((tmp-file (create-temp-file))
		   (read '()))
	       (call-with-output-file tmp-file
		 (lambda (out-port)
		   (write-string "ein paar testzeilen, um\n" out-port)
		   (write-string "expr-test zu prüfen:\n" out-port)
		   (write-string "EINE ZEILE GRO/3...\n" out-port)
		   (write-string "eine zeile klein...\n" out-port)
		   (write-string "eine zeile mit zeichen...\n" out-port)
		   (write-string "*+#'~,;:.-_<>|!§$%&/()=?\"\\[]{}\n" out-port)))
	       (call-with-input-file tmp-file
		 (lambda (in-port)
		   (awk (read-line in-port) (line) counter ()
			(counter => (lambda (c)
				      (set! read (cons c read))))
			(#f  => (lambda (c)
				      (set! read (cons c read)))))))
	       (delete-file tmp-file)
	       (equal? read (list 6 5 4 3 2 1)))))


;; --- after-test ---

(add-test! 'after-test 'awk
	   (lambda ()
	     (let ((tmp-file (create-temp-file))
		   (read '()))
	       (call-with-output-file tmp-file
		 (lambda (out-port)
		   (write-string "ein paar testzeilen, um\n" out-port)
		   (write-string "expr-test zu prüfen:\n" out-port)
		   (write-string "EINE ZEILE GRO/3...\n" out-port)
		   (write-string "eine zeile klein...\n" out-port)
		   (write-string "eine zeile mit zeichen...\n" out-port)
		   (write-string "*+#'~,;:.-_<>|!§$%&/()=?\"\\[]{}\n" out-port)))
	       (set! read
		     (call-with-input-file tmp-file
		       (lambda (in-port)
			 (awk (read-line in-port) (line) ()
			      (1 (set! read 1))
			      (2 (set! read 2))
			      (after 'return)))))
	       (delete-file tmp-file)
	       (equal? read 'return))))


;; --- var-decl-test ---

(add-test! 'var-decl-test 'awk
	   (lambda ()
	     (let ((tmp-file (create-temp-file))
		   (read '()))
	       (call-with-output-file tmp-file
		 (lambda (out-port)
		   (write-string "ein paar testzeilen, um\n" out-port)
		   (write-string "expr-test zu prüfen:\n" out-port)
		   (write-string "EINE ZEILE GRO/3...\n" out-port)
		   (write-string "eine zeile klein...\n" out-port)
		   (write-string "eine zeile mit zeichen...\n" out-port)
		   (write-string "*+#'~,;:.-_<>|!§$%&/()=?\"\\[]{}\n" out-port)))
	       (call-with-input-file tmp-file
		 (lambda (in-port)
		   (awk (read-line in-port) (line) counter ((i 0)
							      (x 2)
							      (y 3))
			(1 (set! i (+ x y)))
			(2 (set! x (+ i y)))
			(3 (set! i (* i 2)))
			(4 (set! i (- i y)))
			(5 (set! i (* i x)))
			(6 (set! read i)))))
	       (delete-file tmp-file)
	       (= read 56))))


;; --- multiple-return-values-of-next-record-test ---

(add-test! 'multiple-return-values-of-next-record-test 'awk
	   (lambda ()
	     (let ((tmp-file (create-temp-file))
		   (read '()))
	       (call-with-output-file tmp-file
		 (lambda (out-port)
		   (write-string "ein paar testzeilen, um\n" out-port)
		   (write-string "expr-test zu prüfen:\n" out-port)
		   (write-string "EINE ZEILE GRO/3...\n" out-port)
		   (write-string "eine zeile klein...\n" out-port)
		   (write-string "eine zeile mit zeichen...\n" out-port)
		   (write-string "*+#'~,;:.-_<>|!§$%&/()=?\"\\[]{}\n" out-port)))
	       (call-with-input-file tmp-file
		 (lambda (in-port)
		   (awk ((lambda ()
			   (values (read-line in-port)1 2 'a 'b))) (line x y a b) counter ()
			(1 (set! read (cons x read)))
			(2 (set! read (cons y read)))
			(3 (set! read (cons a read)))
			(4 (set! read (cons b read))))))
	       (delete-file tmp-file)
	       (equal? read
		       (list 'b 'a 2 1)))))		 



;; --- awk-in-awk-test ---

(add-test! 'awk-in-awk-test 'awk
	   (lambda ()
	     (let ((tmp-file (create-temp-file))
		   (read '()))
	       (call-with-output-file tmp-file
		 (lambda (out-port)
		   (let loop ((i 1))
		     (if (= 10000 i)
			 (write-string (number->string i) out-port)
			 (begin
			   (write-string (number->string i) out-port)
			   (if (zero? (modulo i 100))
			       (write-string "\n" out-port)
			       (write-string " " out-port))
			   (loop (+ i 1)))))))
	       (call-with-input-file tmp-file
		 (lambda (in-port)
		   (awk (read-line in-port) (line) ()
			(#t (let ((tmp-file-1 (create-temp-file))
				  (l (string-length line)))
			      (call-with-output-file tmp-file-1
				(lambda (out-port)
				  (let loop ((i 0))
				    (if (= i l)
					(write-string "" out-port)
					(let ((ch (string-ref line i)))
					  (if (= 32 (char->ascii ch))
					      (write-string "\n" out-port)
					      (write-string (char->string ch) out-port))
					  (loop (+ i 1)))))))
			      (call-with-input-file tmp-file-1
				(lambda (in-port)
				  (awk (read-line in-port) (number-str) ()
				       ((str-palindrom? number-str) (set! read (cons number-str read))))))
			      (delete-file tmp-file-1))))))
	       (delete-file tmp-file)
	       (equal? read
		       (let loop ((i 10000))
			 (if (zero? i)
			     '()
			     (if (int-palindrom? i)
				 (cons (number->string i) (loop (- i 1)))
				 (loop (- i 1)))))))))