From c55451302afa47365232b6f6ef533a8b9984e8d4 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Mon, 3 May 2004 21:20:16 +0000 Subject: [PATCH] r9215: initial benchmark suite --- ChangeLog | 2 ++ clsql-tests.asd | 1 + tests/benchmarks.lisp | 74 +++++++++++++++++++++++++++++++++++++++++++ tests/package.lisp | 2 ++ tests/test-init.lisp | 74 ++++++++++++++++++++++++------------------- 5 files changed, 120 insertions(+), 33 deletions(-) create mode 100644 tests/benchmarks.lisp diff --git a/ChangeLog b/ChangeLog index 3b05dd4..1cdc8b7 100644 --- 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 f42b7f1..13a4c07 100644 --- 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 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 75bd8fa..02983a1 100644 --- 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 28ae587..87ae717 100644 --- 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) -- 2.34.1