tests/benchmarks.lisp

   1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
   2 ;;;; ======================================================================
   3 ;;;; File:    benchmarks.lisp
   4 ;;;; Authors: Kevin Rosenberg
   5 ;;;; Created: 03/05/2004
   6 ;;;; Updated: $Id$
   7 ;;;;
   8 ;;;; Benchmark suite
   9 ;;;;
  10 ;;;; This file is part of CLSQL.
  11 ;;;;
  12 ;;;; CLSQL users are granted the rights to distribute and use this software
  13 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
  14 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
  15 ;;;; ======================================================================
  16
  17 (in-package #:clsql-tests)
  18
  19 (defun run-benchmarks-append-report-file (report-file)
  20   (run-function-append-report-file 'run-benchmarks report-file))
  21
  22 (clsql:def-view-class bench ()
  23   ((a :initarg :a
  24       :type integer)
  25    (b :initarg :b
  26       :type (string 100))
  27    (c :initarg :c
  28       :type float)))
  29
  30 (defun run-benchmarks (&key (report-stream *standard-output*) (sexp-report-stream nil) (count 10000))
  31   (let ((specs (read-specs))
  32         (*report-stream* report-stream)
  33         (*sexp-report-stream* sexp-report-stream))
  34     (unless specs
  35       (warn "Not running benchmarks because test configuration file is missing")
  36       (return-from run-benchmarks :skipped))
  37     (load-necessary-systems specs)
  38     (dolist (db-type +all-db-types+)
  39       (dolist (spec (db-type-spec db-type specs))
  40         (do-benchmarks-for-backend db-type spec count))))
  41   (values))
  42
  43 (defun do-benchmarks-for-backend (db-type spec count)
  44   (test-connect-to-database db-type spec)
  45   (write-report-banner "Benchmarks" db-type *report-stream*
  46                        (database-name-from-spec spec db-type))
  47
  48   (create-view-from-class 'bench)
  49   (benchmark-init)
  50   (benchmark-selects count)
  51   (drop-view-from-class 'bench))
  52
  53 (defun benchmark-init ()
  54   (dotimes (i 10)
  55     (execute-command "INSERT INTO BENCH (A,B,C) VALUES (123,'A Medium size string',3.14159)")))
  56
  57 (defun benchmark-selects (n)
  58   (let ((*trace-output* *report-stream*))
  59     (format *report-stream* "~&~%*** QUERY ***~%")
  60     (time
  61      (dotimes (i n)
  62        (query "SELECT * FROM BENCH")))
  63     (format *report-stream* "~&~%*** QUERY WITH RESULT-TYPES NIL ***~%")
  64     (time
  65      (dotimes (i n)
  66        (query "SELECT * FROM BENCH" :result-types nil)))
  67     (format *report-stream* "~&~%*** QUERY WITH FIELD-NAMES NIL ***~%")
  68     (time
  69      (dotimes (i n)
  70        (query "SELECT * FROM BENCH" :field-names nil)))
  71
  72     (with-dataset *ds-employees*
  73       (format *report-stream* "~&~%*** JOINED OBJECT QUERY RETRIEVAL IMMEDIATE ***~%")
  74       (time
  75        (dotimes (i (truncate n 10))
  76          (mapcar #'(lambda (ea) (slot-value ea 'address)) (select 'employee-address :flatp t))))
  77
  78       (format *report-stream* "~&~%*** JOINED OBJECT QUERY RETRIEVAL DEFERRED ***~%")
  79       (let* ((slotdef (find 'address (clsql-sys::class-slots (find-class 'employee-address))
  80                             :key #'clsql-sys::slot-definition-name))
  81              (dbi (when slotdef (clsql-sys::view-class-slot-db-info slotdef))))
  82         (setf (gethash :retrieval dbi) :deferred)
  83         (time
  84          (dotimes (i (truncate n 10))
  85            (mapcar #'(lambda (ea) (slot-value ea 'address)) (select 'employee-address :flatp t))))
  86         (setf (gethash :retrieval dbi) :immediate)))))