X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=tests%2Fbenchmarks.lisp;h=4e528908e6f3df98991a275f0ee2dbb660607399;hp=a39f49b036f45d7e92ceaceef462aa0977195430;hb=9fe9142259cca16202f35f66cbb35419752dd54d;hpb=e567409d9fff3f7231c2a0bb69b345e19de2b246 diff --git a/tests/benchmarks.lisp b/tests/benchmarks.lisp index a39f49b..4e52890 100644 --- a/tests/benchmarks.lisp +++ b/tests/benchmarks.lisp @@ -1,18 +1,19 @@ ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- -;;;; ====================================================================== -;;;; File: benchmarks.lisp -;;;; Authors: Kevin Rosenberg -;;;; Created: 03/05/2004 -;;;; Updated: $Id$ +;;;; ************************************************************************* +;;;; 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) @@ -41,9 +42,9 @@ (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) @@ -68,17 +69,19 @@ (time (dotimes (i n) (query "SELECT * FROM BENCH" :field-names nil))) - (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) + (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)))) - (setf (gethash :retrieval dbi) :immediate)))) + (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)))))