← Back to branch summary

~ubuntu-branches/ubuntu/vivid/cl-csv/vivid-proposed

« back to all changes in this revision

Viewing changes to tests/speed.lisp

  • Committer: Package Import Robot
  • Author(s): Dimitri Fontaine
  • Date: 2014-08-04 19:57:54 UTC
  • mfrom: (1.1.2)
  • Revision ID: package-import@ubuntu.com-20140804195754-vo64b5r1daxwg8ld
Tags: 20140211-1
Quicklisp release update.

Show diffs side-by-side

added added

removed removed

Lines of Context:
tests/speed.lisp
 
1
(defpackage :cl-csv-test.speed-tests
 
2
  (:use :cl :cl-user :cl-csv :lisp-unit2 :iter))
 
3
 
 
4
(in-package :cl-csv-test.speed-tests)
 
5
 
 
6
(defun run-speed-tests ()
 
7
  (lisp-unit2:run-tests
 
8
   :package :cl-csv-test.speed-tests
 
9
   :name :cl-csv-speed-tests
 
10
   :run-contexts #'lisp-unit2:with-summary-context))
 
11
 
 
12
(defun log-time (&optional (time (get-universal-time)) stream)
 
13
  "returns a date as ${mon}/${d}/${y} ${h}:${min}:{s}, defaults to get-universal-time"
 
14
  (multiple-value-bind ( s min h  )
 
15
      (decode-universal-time time)
 
16
    (format stream "~2,'0d:~2,'0d:~2,'0d "  h min s)))
 
17
 
 
18
(defun test-log (message &rest args)
 
19
  (format *standard-output* "~&")
 
20
  (log-time (get-universal-time) *standard-output*)
 
21
  (apply #'format *standard-output* message args)
 
22
  (format *standard-output* "~%"))
 
23
 
 
24
(eval-when (:compile-toplevel :load-toplevel :execute)
 
25
  (defmacro log-around ((log-name message &rest args) &body body)
 
26
    "Logs the beginning and end of a body.  ARGS are evaluated twice"
 
27
    (let  ((gmessage (gensym "GMESSAGE-")))
 
28
      `(let ((,gmessage ,message))
 
29
         (flet ((msg (&optional tag)
 
30
                  (format nil "~A ~a"
 
31
                          tag ,gmessage)))
 
32
           (,log-name (msg "BEGIN") ,@args)
 
33
           (multiple-value-prog1
 
34
               (progn ,@body)
 
35
             (,log-name (msg "  END") ,@args))))))
 
36
 
 
37
  (defmacro time-and-log-around ((log-name message &rest args) &body body)
 
38
    "Logs the beginning and end of a body.  ARGS are evaluated twice"
 
39
    (let  ((trace-output (gensym "TRACE-OUTPUT-")))
 
40
      `(let (,trace-output) ;;leave nil so the first log call doesn't print an extra newline
 
41
         (log-around (,log-name ,(concatenate 'string message "~@[~%~a~]") ,@args ,trace-output)
 
42
           (setf ,trace-output
 
43
                 (make-array 10 :element-type 'character :adjustable T :fill-pointer 0))
 
44
           (with-output-to-string (*trace-output* ,trace-output)
 
45
             (time (progn ,@body))))))))
 
46
 
 
47
(defparameter +test-big-file+
 
48
  (asdf:system-relative-pathname :cl-csv "tests/long-test.csv"))
 
49
 
 
50
(define-test write-big-file ()
 
51
  (let ((n 120000))
 
52
    (time-and-log-around (test-log "write large file test")
 
53
      (with-open-file (s +test-big-file+ :direction :output :if-exists :supersede )
 
54
        (iter (for i from 0 to n)
 
55
          (write-csv-row '("Russ" "Tyndall" "Software Developer's, \"Position\""
 
56
                           "26.2" "1" "further columns" "even" "more" "data")
 
57
                         :stream s))))))
 
58
 
 
59
(define-test count-big-file-csv-rows ()
 
60
  (let ((cnt 0))
 
61
    (time-and-log-around (test-log "read large file test")
 
62
      (read-csv +test-big-file+
 
63
                :row-fn (lambda (r) (declare (ignore r))
 
64
                          (incf cnt))
 
65
                ))
 
66
    cnt))
 
67
 
 
68
(define-test read-by-line-and-buffer (:tags '(cl-csv-test::read-until))
 
69
  (let ((cnt 0) (cnt2 0) (cnt3 0))
 
70
    (time-and-log-around (test-log "read large file by lines")
 
71
      (let ( line)
 
72
        (cl-csv::with-csv-input-stream (s +test-big-file+ )
 
73
          (handler-case
 
74
              (loop while (setf line (read-line s))
 
75
                    do (incf cnt))
 
76
            (end-of-file (c) (declare (ignore c)))))))
 
77
 
 
78
    (time-and-log-around (test-log "read large file by buffer")
 
79
      (cl-csv::with-csv-input-stream (s +test-big-file+ )
 
80
        (iter
 
81
          (with buffer = (make-array 80 :element-type 'character ))
 
82
          (with fill)
 
83
          (handler-case (setf fill (read-sequence buffer s))
 
84
            (end-of-file () (finish)))
 
85
          (incf cnt2)
 
86
          (while (= 80 fill))
 
87
          )))
 
88
 
 
89
    (time-and-log-around (test-log "read large file by read-into-buffer-until")
 
90
      (cl-csv::with-csv-input-stream (s +test-big-file+ )
 
91
        (let ((buffer (make-string cl-csv::*buffer-size*)))
 
92
          (handler-case
 
93
              (loop
 
94
                while (plusp (cl-csv::read-into-buffer-until buffer s))
 
95
                do (incf cnt3))
 
96
            (end-of-file (c) (declare (ignore c)))))))
 
97
 
 
98
    (format lisp-unit2:*test-stream*
 
99
            "~@:_ lines:~D , buffers:~D, buffered-lines:~D~@:_"
 
100
            cnt cnt2 cnt3)))
 
101
 
 
102
(define-test collect-big-file-csv-rows ()
 
103
  (time-and-log-around (test-log "read large file test")
 
104
    (read-csv +test-big-file+))
 
105
  nil ; so we dont print 10m to the repl
 
106
  )
 
107
 
 
108
(defun process-csv2 (csv-name process-function )
 
109
  (let ( collector )
 
110
    (labels ((row-processor (row)
 
111
               (let ((result (funcall process-function row)))
 
112
                 (when result
 
113
                   (push result collector)))))
 
114
      (cl-csv:read-csv csv-name :row-fn #'row-processor)
 
115
      collector)))
 
116
 
 
117
(defun return-blanks2 (filename)
 
118
  (labels ((row-checker (row &aux (6th (sixth row)) )
 
119
             (if (string-equal 6th "")
 
120
                 (list (first row) (sixth row)))))
 
121
    (process-csv2 filename #'row-checker)))
 
122
 
 
123
(defun test-pnathan-code2 ()
 
124
  (time-and-log-around (test-log "test-pnathan2 read")
 
125
    (return-blanks2 +test-big-file+)))
 
126
 
 
127
;; (test-pnathan-code)
 
128
;; 15:57:18 BEGIN test-pnathan read
 
129
;; 15:57:21   END test-pnathan read
 
130
;; Evaluation took:
 
131
;;   3.480 seconds of real time
 
132
;;    3.390000 seconds of total run time (3.200000 user, 0.190000 system)
 
133
;;    [ Run times consist of 0.170 seconds GC time, and 3.220 seconds non-GC time. ]
 
134
;;    97.41% CPU
 
135
;;    8,678,145,157 processor cycles
 
136
;;    229,327,728 bytes consed
 
137