Remove CVS $Id$ keyword
[clsql.git] / tests / benchmarks.lisp
index c6b0be0cb7d5a7ac06b2c122b0a4b337dae0d6e0..372b81cca30d0b5683562b7416555f70ed04ab42 100644 (file)
@@ -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)
 
       :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)
     (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)))))