;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; ======================================================================
-;;;; File: benchmarks.lisp
-;;;; Authors: Kevin Rosenberg
-;;;; Created: 03/05/2004
-;;;; Updated: $Id: test-init.lisp 9212 2004-05-03 18:44:03Z kevin $
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
;;;;
-;;;; Benchmark suite
+;;;; Name: benchmarks.lisp
+;;;; Purpose: Time performance tests for CLSQL
+;;;; Authors: Kevin M. Rosenberg
+;;;; Created: March 5, 2004
;;;;
;;;; This file is part of CLSQL.
;;;;
;;;; CLSQL users are granted the rights to distribute and use this software
;;;; as governed by the terms of the Lisp Lesser GNU Public License
;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
-;;;; ======================================================================
+;;;; *************************************************************************
+
(in-package #:clsql-tests)
:type (string 100))
(c :initarg :c
:type float)))
-
+
(defun run-benchmarks (&key (report-stream *standard-output*) (sexp-report-stream nil) (count 10000))
(let ((specs (read-specs))
- (*report-stream* report-stream)
- (*sexp-report-stream* sexp-report-stream))
+ (*report-stream* report-stream)
+ (*sexp-report-stream* sexp-report-stream))
(unless specs
(warn "Not running benchmarks because test configuration file is missing")
(return-from run-benchmarks :skipped))
(load-necessary-systems specs)
(dolist (db-type +all-db-types+)
(dolist (spec (db-type-spec db-type specs))
- (do-benchmarks-for-backend db-type spec count))))
+ (do-benchmarks-for-backend db-type spec count))))
(values))
(defun do-benchmarks-for-backend (db-type spec count)
- (test-connect-to-database db-type spec)
- (test-initialise-database)
- (write-report-banner "Benchmarks" db-type *report-stream*)
+ (test-setup-database db-type spec)
+ (write-report-banner "Benchmarks" db-type *report-stream*
+ (database-name-from-spec spec db-type))
(create-view-from-class 'bench)
(benchmark-init)
(time
(dotimes (i n)
(query "SELECT * FROM BENCH" :field-names nil)))
- (format *report-stream* "~&~%*** OBJECT QUERY ***~%")
- (time
- (dotimes (i n)
- (mapcar #'(lambda (ea) (slot-value ea 'address)) (select 'employee-address :flatp t))))
- ))
-
-
+ (with-dataset *ds-employees*
+ (format *report-stream* "~&~%*** JOINED OBJECT QUERY RETRIEVAL IMMEDIATE ***~%")
+ (time
+ (dotimes (i (truncate n 10))
+ (mapcar #'(lambda (ea) (slot-value ea 'address)) (select 'employee-address :flatp t))))
+ (format *report-stream* "~&~%*** JOINED OBJECT QUERY RETRIEVAL DEFERRED ***~%")
+ (let* ((slotdef (find 'address (clsql-sys::class-slots (find-class 'employee-address))
+ :key #'clsql-sys::slot-definition-name))
+ (dbi (when slotdef (clsql-sys::view-class-slot-db-info slotdef))))
+ (setf (gethash :retrieval dbi) :deferred)
+ (time
+ (dotimes (i (truncate n 10))
+ (mapcar #'(lambda (ea) (slot-value ea 'address)) (select 'employee-address :flatp t))))
+ (setf (gethash :retrieval dbi) :immediate)))))