tests/benchmarks.lisp

   1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:     benchmarks.lisp
   6 ;;;; Purpose:  Time performance tests for CLSQL
   7 ;;;; Authors:  Kevin M. Rosenberg
   8 ;;;; Created:  March 5, 2004
   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
  18 (in-package #:clsql-tests)
  19
  20 (defun run-benchmarks-append-report-file (report-file)
  21   (run-function-append-report-file 'run-benchmarks report-file))
  22
  23 (clsql:def-view-class bench ()
  24   ((a :initarg :a
  25       :type integer)
  26    (b :initarg :b
  27       :type (string 100))
  28    (c :initarg :c
  29       :type float)))
  30
  31 (defun run-benchmarks (&key (report-stream *standard-output*) (sexp-report-stream nil) (count 10000))
  32   (let ((specs (read-specs))
  33         (*report-stream* report-stream)
  34         (*sexp-report-stream* sexp-report-stream))
  35     (unless specs
  36       (warn "Not running benchmarks because test configuration file is missing")
  37       (return-from run-benchmarks :skipped))
  38     (load-necessary-systems specs)
  39     (dolist (db-type +all-db-types+)
  40       (dolist (spec (db-type-spec db-type specs))
  41         (do-benchmarks-for-backend db-type spec count))))
  42   (values))
  43
  44 (defun do-benchmarks-for-backend (db-type spec count)
  45   (test-connect-to-database db-type spec)
  46   (write-report-banner "Benchmarks" db-type *report-stream*
  47                        (database-name-from-spec spec db-type))
  48
  49   (create-view-from-class 'bench)
  50   (benchmark-init)
  51   (benchmark-selects count)
  52   (drop-view-from-class 'bench))
  53
  54 (defun benchmark-init ()
  55   (dotimes (i 10)
  56     (execute-command "INSERT INTO BENCH (A,B,C) VALUES (123,'A Medium size string',3.14159)")))
  57
  58 (defun benchmark-selects (n)
  59   (let ((*trace-output* *report-stream*))
  60     (format *report-stream* "~&~%*** QUERY ***~%")
  61     (time
  62      (dotimes (i n)
  63        (query "SELECT * FROM BENCH")))
  64     (format *report-stream* "~&~%*** QUERY WITH RESULT-TYPES NIL ***~%")
  65     (time
  66      (dotimes (i n)
  67        (query "SELECT * FROM BENCH" :result-types nil)))
  68     (format *report-stream* "~&~%*** QUERY WITH FIELD-NAMES NIL ***~%")
  69     (time
  70      (dotimes (i n)
  71        (query "SELECT * FROM BENCH" :field-names nil)))
  72
  73     (with-dataset *ds-employees*
  74       (format *report-stream* "~&~%*** JOINED OBJECT QUERY RETRIEVAL IMMEDIATE ***~%")
  75       (time
  76        (dotimes (i (truncate n 10))
  77          (mapcar #'(lambda (ea) (slot-value ea 'address)) (select 'employee-address :flatp t))))
  78
  79       (format *report-stream* "~&~%*** JOINED OBJECT QUERY RETRIEVAL DEFERRED ***~%")
  80       (let* ((slotdef (find 'address (clsql-sys::class-slots (find-class 'employee-address))
  81                             :key #'clsql-sys::slot-definition-name))
  82              (dbi (when slotdef (clsql-sys::view-class-slot-db-info slotdef))))
  83         (setf (gethash :retrieval dbi) :deferred)
  84         (time
  85          (dotimes (i (truncate n 10))
  86            (mapcar #'(lambda (ea) (slot-value ea 'address)) (select 'employee-address :flatp t))))
  87         (setf (gethash :retrieval dbi) :immediate)))))