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 (write-report-banner "Benchmarks" db-type *report-stream*
46 (database-name-from-spec spec db-type))
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)))
72 (with-dataset *ds-employees*
73 (format *report-stream* "~&~%*** JOINED OBJECT QUERY RETRIEVAL IMMEDIATE ***~%")
75 (dotimes (i (truncate n 10))
76 (mapcar #'(lambda (ea) (slot-value ea 'address)) (select 'employee-address :flatp t))))
78 (format *report-stream* "~&~%*** JOINED OBJECT QUERY RETRIEVAL DEFERRED ***~%")
79 (let* ((slotdef (find 'address (clsql-sys::class-slots (find-class 'employee-address))
80 :key #'clsql-sys::slot-definition-name))
81 (dbi (when slotdef (clsql-sys::view-class-slot-db-info slotdef))))
82 (setf (gethash :retrieval dbi) :deferred)
84 (dotimes (i (truncate n 10))
85 (mapcar #'(lambda (ea) (slot-value ea 'address)) (select 'employee-address :flatp t))))
86 (setf (gethash :retrieval dbi) :immediate)))))