1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
5 ;;;; Name: benchmarks.lisp
6 ;;;; Purpose: Time performance tests for CLSQL
7 ;;;; Authors: Kevin M. Rosenberg
8 ;;;; Created: March 5, 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 ;;;; *************************************************************************
18 (in-package #:clsql-tests)
20 (defun run-benchmarks-append-report-file (report-file)
21 (run-function-append-report-file 'run-benchmarks report-file))
23 (clsql:def-view-class bench ()
31 (defun run-benchmarks (&key (report-stream *standard-output*) (sexp-report-stream nil) (count 10000))
32 (let ((specs (read-specs))
33 (*report-stream* report-stream)
34 (*sexp-report-stream* sexp-report-stream))
36 (warn "Not running benchmarks because test configuration file is missing")
37 (return-from run-benchmarks :skipped))
38 (load-necessary-systems specs)
39 (dolist (db-type +all-db-types+)
40 (dolist (spec (db-type-spec db-type specs))
41 (do-benchmarks-for-backend db-type spec count))))
44 (defun do-benchmarks-for-backend (db-type spec count)
45 (test-connect-to-database db-type spec)
46 (write-report-banner "Benchmarks" db-type *report-stream*
47 (database-name-from-spec spec db-type))
49 (create-view-from-class 'bench)
51 (benchmark-selects count)
52 (drop-view-from-class 'bench))
54 (defun benchmark-init ()
56 (execute-command "INSERT INTO BENCH (A,B,C) VALUES (123,'A Medium size string',3.14159)")))
58 (defun benchmark-selects (n)
59 (let ((*trace-output* *report-stream*))
60 (format *report-stream* "~&~%*** QUERY ***~%")
63 (query "SELECT * FROM BENCH")))
64 (format *report-stream* "~&~%*** QUERY WITH RESULT-TYPES NIL ***~%")
67 (query "SELECT * FROM BENCH" :result-types nil)))
68 (format *report-stream* "~&~%*** QUERY WITH FIELD-NAMES NIL ***~%")
71 (query "SELECT * FROM BENCH" :field-names nil)))
73 (with-dataset *ds-employees*
74 (format *report-stream* "~&~%*** JOINED OBJECT QUERY RETRIEVAL IMMEDIATE ***~%")
76 (dotimes (i (truncate n 10))
77 (mapcar #'(lambda (ea) (slot-value ea 'address)) (select 'employee-address :flatp t))))
79 (format *report-stream* "~&~%*** JOINED OBJECT QUERY RETRIEVAL DEFERRED ***~%")
80 (let* ((slotdef (find 'address (clsql-sys::class-slots (find-class 'employee-address))
81 :key #'clsql-sys::slot-definition-name))
82 (dbi (when slotdef (clsql-sys::view-class-slot-db-info slotdef))))
83 (setf (gethash :retrieval dbi) :deferred)
85 (dotimes (i (truncate n 10))
86 (mapcar #'(lambda (ea) (slot-value ea 'address)) (select 'employee-address :flatp t))))
87 (setf (gethash :retrieval dbi) :immediate)))))