r9215: initial benchmark suite

diff --git a/ChangeLog b/ChangeLog
index 3b05dd4a6bb1f23191712fc70a181f208d460416..1cdc8b72d4ad3b53753ba8be6e617b072b36f046 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -3,6 +3,8 @@
        for odbc/postgresql backend.
        * db-odbc/odbc-sql.lisp: Fix ATTRIBUTE-TYPE so that
        it can handle NIL values from the ODBC driver
+       * tests/benchmarks.lisp: New file with initial
+       benchmark suite
        
 3 May 2004 Kevin Rosenberg (kevin@rosenberg.net)
        * Version 2.10.8        

diff --git a/clsql-tests.asd b/clsql-tests.asd
index f42b7f103f26ec42068557bb51918ce32eb49eb5..13a4c07c855db37b5db46b0cc912e7bd16dd5bbc 100644 (file)
--- a/clsql-tests.asd
+++ b/clsql-tests.asd
@@ -32,6 +32,7 @@
              :components ((:file "package")
                           (:file "utils")
                           (:file "test-init")
+                          (:file "benchmarks")
                           (:file "test-time")
                           (:file "test-basic")
                           (:file "test-connection")

diff --git a/tests/benchmarks.lisp b/tests/benchmarks.lisp
new file mode 100644 (file)
index 0000000..8c3a0ce
--- /dev/null
+++ b/tests/benchmarks.lisp
@@ -0,0 +1,74 @@
+;;;; -*- 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 $
+;;;;
+;;;; Benchmark suite
+;;;;
+;;;; 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)
+
+(defun run-benchmarks-append-report-file (report-file)
+  (run-function-append-report-file 'run-benchmarks report-file))
+
+(clsql:def-view-class bench ()
+  ((a :initarg :a
+      :type integer)
+   (b :initarg :b
+      :type (string 100))
+   (c :initarg :c
+      :type float)))
+   
+(defun run-benchmarks (&key (report-stream *standard-output*) (sexp-report-stream nil) (count 1000))
+  (let ((specs (read-specs))
+       (*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))))
+  (values))
+
+(defun do-benchmarks-for-backend (db-type spec count)
+  (test-connect-to-database db-type spec)
+  (write-report-banner "Benchmarks" db-type *report-stream*)
+
+  (create-view-from-class 'bench)
+  (benchmark-init)
+  (benchmark-selects count)
+  (drop-view-from-class 'bench))
+
+(defun benchmark-init ()
+  (dotimes (i 100)
+    (execute-command "INSERT INTO BENCH (A,B,C) VALUES (123,'A Medium size string',3.14159)")))
+
+(defun benchmark-selects (n)
+  (let ((*trace-output* *report-stream*))
+    (format *report-stream* "~&~%*** QUERY ***~%")
+    (time
+     (dotimes (i n)
+       (query "SELECT * FROM BENCH")))
+    (format *report-stream* "~&~%*** QUERY WITH RESULT-TYPES NIL ***~%")
+    (time
+     (dotimes (i n)
+       (query "SELECT * FROM BENCH" :result-types nil)))
+    (format *report-stream* "~&~%*** QUERY WITH FIELD-NAMES NIL ***~%")
+    (time
+     (dotimes (i n)
+       (query "SELECT * FROM BENCH" :field-names nil)))
+    ))
+
+
+
+

diff --git a/tests/package.lisp b/tests/package.lisp
index 75bd8fa95dfecdc5ad2f9036f471ee710a15d622..02983a138410185a2da62e1ace4d36510cf1d338 100644 (file)
--- a/tests/package.lisp
+++ b/tests/package.lisp
@@ -21,6 +21,8 @@
   (:export 
    #:run-tests 
    #:run-tests-append-report-file
+   #:run-benchmarks 
+   #:run-benchmarks-append-report-file
    #:summarize-test-report
    #:test-initialise-database 
    #:test-connect-to-database

diff --git a/tests/test-init.lisp b/tests/test-init.lisp
index 28ae58709f3d37628accf4ecd7040ec5f5ed8e88..87ae7175e5c4fadae4539695a62aef216391ec79 100644 (file)
--- a/tests/test-init.lisp
+++ b/tests/test-init.lisp
@@ -340,20 +340,24 @@
 (defvar *error-count* 0)
 (defvar *error-list* nil)
 
-(defun run-tests-append-report-file (report-file)
-  (let* ((report-path (etypecase report-file
+(defun run-function-append-report-file (function report-file)
+    (let* ((report-path (etypecase report-file
                        (pathname report-file)
                        (string (parse-namestring report-file))))
         (sexp-report-path (make-pathname :defaults report-path
                                          :type "sexp")))
-  (with-open-file (rs report-path :direction :output
-                     :if-exists :append
+      (with-open-file (rs report-path :direction :output
+                         :if-exists :append
                      :if-does-not-exist :create)
-    (with-open-file (srs sexp-report-path :direction :output
-                        :if-exists :append
-                        :if-does-not-exist :create)
-      (run-tests :report-stream rs :sexp-report-stream srs)))))
-    
+       (with-open-file (srs sexp-report-path :direction :output
+                            :if-exists :append
+                            :if-does-not-exist :create)
+         (funcall function :report-stream rs :sexp-report-stream srs)))))
+
+(defun run-tests-append-report-file (report-file)
+  (run-function-append-report-file 'run-tests report-file))
+
+
 (defun run-tests (&key (report-stream *standard-output*) (sexp-report-stream nil))
   (let ((specs (read-specs))
        (*report-stream* report-stream)
@@ -374,35 +378,39 @@
     (when (db-type-spec db-type specs)
       (clsql:initialize-database-type :database-type db-type))))
 
-(defun do-tests-for-backend (db-type spec)
-  (test-connect-to-database db-type spec)
-
-  (unwind-protect
-      (multiple-value-bind (test-forms skip-tests)
-         (compute-tests-for-backend db-type *test-database-underlying-type*)
-       
-       (format *report-stream* 
-               "~&
+(defun write-report-banner (report-type db-type stream)
+  (format *report-stream* 
+         "~&
 ******************************************************************************
-***     CLSQL Test Suite begun at ~A
+***     CLSQL ~A begun at ~A
 ***     ~A
 ***     ~A on ~A
 ***     Database ~A backend~A.
 ******************************************************************************
-" 
-               (clsql-base:format-time 
-                nil 
-                (clsql-base:utime->time (get-universal-time)))
-               (lisp-implementation-type)
-               (lisp-implementation-version)
-               (machine-type)
-               db-type
-               (if (not (eq db-type *test-database-underlying-type*))
-                   (format nil " with underlying type ~A" 
-                           *test-database-underlying-type*)
-                 "")
-               )
-       
+"
+         report-type
+         (clsql-base:format-time 
+          nil 
+          (clsql-base:utime->time (get-universal-time)))
+         (lisp-implementation-type)
+         (lisp-implementation-version)
+         (machine-type)
+         db-type
+         (if (not (eq db-type *test-database-underlying-type*))
+             (format nil " with underlying type ~A" 
+                     *test-database-underlying-type*)
+             "")
+         ))
+
+(defun do-tests-for-backend (db-type spec)
+  (test-connect-to-database db-type spec)
+  
+  (unwind-protect
+       (multiple-value-bind (test-forms skip-tests)
+         (compute-tests-for-backend db-type *test-database-underlying-type*)
+        
+        (write-report-banner "Test Suite" db-type *report-stream*)
+        
        (test-initialise-database)
        
        (regression-test:rem-all-tests)