(defvar test-pattern nil)
(defvar test-start nil)

(defun test-filter (process string printer)
  (push (cons (floor (- (float-time) test-start))
	      (length string)) test-pattern)
  (princ string printer))

(defun test-predicate (a b)
  (if (equal (car a) (car b))
      (< (cdr a) (cdr b))
    (< (car a) (car b))))

(defun make-test (printer &optional finish)
  (interactive (let ((buffer (get-buffer-create "*test*")))
		  (switch-to-buffer buffer)
		  (erase-buffer)
		  (list buffer)))
  (setq test-pattern nil test-start (float-time))
  (let ((process (start-process
		  "test" (and (bufferp printer) printer) "sh"
		  "-c" "od -v /dev/zero|dd bs=1 count=100k")))
    (set-process-filter process `(lambda (process string)
				   (test-filter process string
						',printer)))
    (set-process-sentinel process `(lambda (process string)
				     (test-sentinel process string
						    ',printer ',finish)))
    process))

(defun test-sentinel (process string printer finish)
  (princ string printer)
  (delete-process process)
  (setq test-pattern (sort test-pattern #'test-predicate))
  (let (elt lastelt lastcount)
    (while
	(prog1
	    (setq elt (pop test-pattern))
	  (if (equal lastelt elt)
	      (when lastelt (setq lastcount (1+ lastcount)))
	    (when lastelt
	      (princ (format "%4d blocks with size %4d\n"
			     lastcount (cdr lastelt)) printer))
	    (setq lastcount 1)))
      (when (not (eq (car lastelt) (car elt)))
	(princ (format "Time:%3d\n" (car elt)) printer))
      (setq lastelt elt)))
  (if finish (funcall finish)))