Skip to content
Permalink
Branch: master
Find file Copy path
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
211 lines (177 sloc) 6.13 KB
;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CLAWK-TEST; Base: 10 -*-
(in-package :CLAWK-TEST)
;;;
;;; Various tests, based on translations of AWK examples from the AWK
;;; book
;;;
; Chapter 1, page 1, example 1
; Print all employees that have worked this week
;
; $3 > 0 { print $1 $2 $3 }
;
(defun test-1-1-1 (&optional (filename "emp.data"))
(for-file-lines (filename)
(with-fields ((name payrate hrsworked))
(when ($> hrsworked 0)
($print name payrate hrsworked)))))
; alternatively like this
(defun test-1-1-2 (&optional (filename "emp.data"))
(for-file-fields (filename (name payrate hrsworked))
(when ($> hrsworked 0)
($print name payrate hrsworked))))
; or this
(defun test-1-1-3 (&optional (filename "emp.data"))
(for-file-fields (filename)
(when ($> $3 0) ($print $1 $2 $3))))
; or even like this
(defawk test-1-1-4 ()
"Print out the employees that have worked this week."
(($> $3 0) ($print $1 $2 $3)))
(defun test-1-2 (&optional (filename "emp.data"))
(for-file-lines (filename)
(with-fields ((name payrate hrsworked))
(when ($zerop hrsworked)
($print name payrate hrsworked)))))
;;; also awk-like
(defawk test-1-6 ()
(t ($print *NR* $0)))
(defun test-1-7 (&optional (filename "emp.data"))
(for-file-lines (filename)
(with-fields ((name payrate hrsworked))
($print "total pay for" name "is" ($* payrate hrsworked)))))
(defun test-1-9 (&optional (filename "emp.data"))
(for-file-lines (filename inf line)
(with-fields ((name payrate hrsworked))
(declare (ignore name hrsworked))
(when ($>= payrate 5)
($print line)))))
; as close to the original awk as possible
(defawk test-1-11-1 ()
((/= *NF* 3) ($print $0 "number of fields is not equal to 3"))
(($< $2 3.35) ($print $0 "rate is below minimum wage"))
(($> $2 10) ($print $0 "rate exceeds $10 per hour"))
(($< $3 0) ($print $0 "negative hours worked"))
(($> $3 60) ($print $0 "too many hours worked")) )
; as close to the original awk as possible
(defawk test-1-11-2 ()
(BEGIN ($print "NAME RATE HOURS")
($print))
(t ($print $0)) ) ; empty condition
(defun test-1-12-1 (&optional (filename "emp.data") &aux (emp 0))
(for-file-lines (filename)
(with-fields ((name payrate hrsworked))
(declare (ignore name payrate))
(when ($> hrsworked 15)
(incf emp))))
($print emp "employees worked more than 15 hours"))
(defawk test-1-12-3 (&aux (pay 0))
(t (incf pay ($* $2 $3)))
(END ($print *NR* "employees")
($print "total pay is" pay)
($print "average pay is" (/ pay *NR*))))
(defun sample (filename &aux (pay 0) (nr 0))
(for-file-fields (filename (name payrate hrsworked))
(declare (ignore name))
(incf pay (* (num payrate) (num hrsworked)))
(incf nr) )
(format t "~%~D employees" nr)
(format t "~%total pay is ~F" pay)
(format t "~%average pay is ~F" (/ pay nr)) )
(defun test-1-12-4 (&optional (filename "emp.data") &aux maxrate maxemp)
(for-file-lines (filename)
(with-fields ((name payrate hrsworked))
(declare (ignore hrsworked))
(when ($> payrate maxrate)
(setq maxrate payrate maxemp name))))
($print "highest hourly rate:" maxrate "for" maxemp))
(defun test-1-13-1 (&optional (filename "emp.data") &aux names)
(for-file-lines (filename)
(with-fields ((name payrate hrsworked))
(declare (ignore payrate hrsworked))
(setq names ($++ names name " "))))
($print names))
(defun test-1-13-2 (&optional (filename "emp.data") &aux last)
"Print last line"
(for-file-lines (filename inf line)
(setq last line))
($print last))
(defun test-1-14-1 (&optional (filename "emp.data"))
(for-file-lines (filename)
(with-fields ((name payrate hrsworked))
(declare (ignore payrate hrsworked))
($print name ($length name)))))
(defun test-1-14-2 (filename &aux (nc 0) (nw 0))
"Count lines, words, and characters"
(setq *NR* 0) ; the low-level macros don't do this for you
(for-file-lines (filename inf line)
(with-fields ((&rest rest))
(declare (ignore rest))
(incf nc (1+ (length line)))
(incf nw *NF*)))
($print *NR* "lines," nw "words," nc "characters"))
(defun test-1-14-3 (&optional (filename "emp.data") &aux (n 0) (pay 0))
(for-file-lines (filename)
(with-fields ((name payrate hrsworked))
(declare (ignore name))
(when ($> payrate 6)
(incf n)
(incf pay ($* payrate hrsworked)))))
(if (> n 0)
($print n "employees, total pay is" pay "average pay is" (/ pay n))
($print "no employees are paid more than $6/hour")))
; doesn't use emp.data
(defun test-1-15 (filename)
"Input lines: amount rate years"
(for-file-lines (filename inf line)
(with-fields ((&optional amount rate years))
($print line)
(loop for i from 1 by 1
while ($<= i years)
do (format t "~%~t~,2F" ($* amount ($expt ($+ 1 rate) i)))))))
(defun test-1-16-2-1 (filename &aux lines)
"Print lines in reverse order"
(for-file-lines (filename inf line)
(push line lines))
(loop for line in lines
do ($print line)))
;; even more like the original awk, but not as quick
(defawk test-1-16-2-2 (&aux (lines ($array)))
"Print lines in reverse order"
(t (setf ($aref lines *NR*) $0))
(END (loop for i from *NR* above 0
do ($print ($aref lines i)))))
(defun test-1-17-3-1 (filename)
"Print the last field of every input line"
(for-file-lines (filename)
(with-fields ((&rest fields))
($print (elt fields (1- *NF*))))))
; even more like awk
(defawk test-1-17-3-2 ()
(t ($print ($n *NF*))))
;;;; Tests for bugs
(defawk test/1 ()
(t
(return-from test/1 (list $1 $2))))
(defawk test/2 ()
(BEGIN
(setf *FS* ","))
(t
(return-from test/2 (list $1 $2))))
#||
(assert
(equal (with-input-from-string (s " one two")
(test/1 s))
'("one" "two")))
(assert
(equal (with-input-from-string (s "one two")
(test/1 s))
'("one" "two")))
(assert
(equal (with-input-from-string (s "one, two ,")
(test/2 s))
'("one" " two ")))
(assert
(equal (with-input-from-string (s ", one, two")
(test/2 s))
'("" " one")))
||#
You can’t perform that action at this time.