X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=tests%2Fbenchmarks.lisp;h=372b81cca30d0b5683562b7416555f70ed04ab42;hp=c6b0be0cb7d5a7ac06b2c122b0a4b337dae0d6e0;hb=d2d49ab13c98bc7a1819a0fd3968268a5567bdc3;hpb=131603d1f5661779b00c5cfa79ecceace1078b1d diff --git a/tests/benchmarks.lisp b/tests/benchmarks.lisp index c6b0be0..372b81c 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: 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) @@ -26,24 +27,24 @@ :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*) + (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::class-slots (find-class 'employee-address)) - :key #'clsql::slot-definition-name)) - (dbi (when slotdef (clsql::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)))) + + (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)))))