1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; ======================================================================
3 ;;;; File: benchmarks.lisp
4 ;;;; Authors: Kevin Rosenberg
5 ;;;; Created: 03/05/2004
10 ;;;; This file is part of CLSQL.
12 ;;;; CLSQL users are granted the rights to distribute and use this software
13 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
14 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
15 ;;;; ======================================================================
17 (in-package #:clsql-tests
)
19 (defun run-benchmarks-append-report-file (report-file)
20 (run-function-append-report-file 'run-benchmarks report-file
))
22 (clsql:def-view-class bench
()
30 (defun run-benchmarks (&key
(report-stream *standard-output
*) (sexp-report-stream nil
) (count 10000))
31 (let ((specs (read-specs))
32 (*report-stream
* report-stream
)
33 (*sexp-report-stream
* sexp-report-stream
))
35 (warn "Not running benchmarks because test configuration file is missing")
36 (return-from run-benchmarks
:skipped
))
37 (load-necessary-systems specs
)
38 (dolist (db-type +all-db-types
+)
39 (dolist (spec (db-type-spec db-type specs
))
40 (do-benchmarks-for-backend db-type spec count
))))
43 (defun do-benchmarks-for-backend (db-type spec count
)
44 (test-connect-to-database db-type spec
)
45 (test-initialise-database)
46 (write-report-banner "Benchmarks" db-type
*report-stream
*)
48 (create-view-from-class 'bench
)
50 (benchmark-selects count
)
51 (drop-view-from-class 'bench
))
53 (defun benchmark-init ()
55 (execute-command "INSERT INTO BENCH (A,B,C) VALUES (123,'A Medium size string',3.14159)")))
57 (defun benchmark-selects (n)
58 (let ((*trace-output
* *report-stream
*))
59 (format *report-stream
* "~&~%*** QUERY ***~%")
62 (query "SELECT * FROM BENCH")))
63 (format *report-stream
* "~&~%*** QUERY WITH RESULT-TYPES NIL ***~%")
66 (query "SELECT * FROM BENCH" :result-types nil
)))
67 (format *report-stream
* "~&~%*** QUERY WITH FIELD-NAMES NIL ***~%")
70 (query "SELECT * FROM BENCH" :field-names nil
)))
71 (format *report-stream
* "~&~%*** JOINED OBJECT QUERY RETRIEVAL IMMEDIATE ***~%")
73 (dotimes (i (truncate n
10))
74 (mapcar #'(lambda (ea) (slot-value ea
'address
)) (select 'employee-address
:flatp t
))))
76 (format *report-stream
* "~&~%*** JOINED OBJECT QUERY RETRIEVAL DEFERRED ***~%")
77 (let* ((slotdef (find 'address
(clsql-sys::class-slots
(find-class 'employee-address
))
78 :key
#'clsql-sys
::slot-definition-name
))
79 (dbi (when slotdef
(clsql-sys::view-class-slot-db-info slotdef
))))
80 (setf (gethash :retrieval dbi
) :deferred
)
82 (dotimes (i (truncate n
10))
83 (mapcar #'(lambda (ea) (slot-value ea
'address
)) (select 'employee-address
:flatp t
))))
84 (setf (gethash :retrieval dbi
) :immediate
))))