570 lines
19 KiB
Scheme
570 lines
19 KiB
Scheme
|
;;; 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<70>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 "*+#'~,;:.-_<>|!<21>$%&/()=?\"\\[]{}\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<70>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 "*+#'~,;:.-_<>|!<21>$%&/()=?\"\\[]{}\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<70>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<70>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 "*+#'~,;:.-_<>|!<21>$%&/()=?\"\\[]{}\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<70>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<70>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 "*+#'~,;:.-_<>|!<21>$%&/()=?\"\\[]{}\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<70>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 "*+#'~,;:.-_<>|!<21>$%&/()=?\"\\[]{}\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
|
|||
|
|
"*+#'~,;:.-_<>|!<21>$%&/()=?\"\\[]{}"))
|
|||
|
|
(set! read (cons 'second-clause read)))
|
|||
|
|
(range (when (equal? line
|
|||
|
|
"expr-test zu pr<70>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<70>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 "*+#'~,;:.-_<>|!<21>$%&/()=?\"\\[]{}\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
|
|||
|
|
"*+#'~,;:.-_<>|!<21>$%&/()=?\"\\[]{}"))
|
|||
|
|
(set! read (cons 'second-clause read)))
|
|||
|
|
(:range (when (equal? line
|
|||
|
|
"expr-test zu pr<70>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<70>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 "*+#'~,;:.-_<>|!<21>$%&/()=?\"\\[]{}\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
|
|||
|
|
"*+#'~,;:.-_<>|!<21>$%&/()=?\"\\[]{}"))
|
|||
|
|
(set! read (cons 'second-clause read)))
|
|||
|
|
(range: (when (equal? line
|
|||
|
|
"expr-test zu pr<70>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<70>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 "*+#'~,;:.-_<>|!<21>$%&/()=?\"\\[]{}\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
|
|||
|
|
"*+#'~,;:.-_<>|!<21>$%&/()=?\"\\[]{}"))
|
|||
|
|
(set! read (cons 'second-clause read)))
|
|||
|
|
(:range: (when (equal? line
|
|||
|
|
"expr-test zu pr<70>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<70>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 "*+#'~,;:.-_<>|!<21>$%&/()=?\"\\[]{}\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<70>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 "*+#'~,;:.-_<>|!<21>$%&/()=?\"\\[]{}\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<70>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 "*+#'~,;:.-_<>|!<21>$%&/()=?\"\\[]{}\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<70>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 "*+#'~,;:.-_<>|!<21>$%&/()=?\"\\[]{}\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<70>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 "*+#'~,;:.-_<>|!<21>$%&/()=?\"\\[]{}\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)))))))))
|