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*)
47 (create-view-from-class 'bench)
49 (benchmark-selects count)
50 (drop-view-from-class 'bench))
52 (defun benchmark-init ()
54 (execute-command "INSERT INTO BENCH (A,B,C) VALUES (123,'A Medium size string',3.14159)")))
56 (defun benchmark-selects (n)
57 (let ((*trace-output* *report-stream*))
58 (format *report-stream* "~&~%*** QUERY ***~%")
61 (query "SELECT * FROM BENCH")))
62 (format *report-stream* "~&~%*** QUERY WITH RESULT-TYPES NIL ***~%")
65 (query "SELECT * FROM BENCH" :result-types nil)))
66 (format *report-stream* "~&~%*** QUERY WITH FIELD-NAMES NIL ***~%")
69 (query "SELECT * FROM BENCH" :field-names nil)))
70 (format *report-stream* "~&~%*** JOINED OBJECT QUERY RETRIEVAL IMMEDIATE ***~%")
72 (dotimes (i (truncate n 10))
73 (mapcar #'(lambda (ea) (slot-value ea 'address)) (select 'employee-address :flatp t))))
75 (format *report-stream* "~&~%*** JOINED OBJECT QUERY RETRIEVAL DEFERRED ***~%")
76 (let* ((slotdef (find 'address (clsql-sys::class-slots (find-class 'employee-address))
77 :key #'clsql-sys::slot-definition-name))
78 (dbi (when slotdef (clsql-sys::view-class-slot-db-info slotdef))))
79 (setf (gethash :retrieval dbi) :deferred)
81 (dotimes (i (truncate n 10))
82 (mapcar #'(lambda (ea) (slot-value ea 'address)) (select 'employee-address :flatp t))))
83 (setf (gethash :retrieval dbi) :immediate))))