blob: 4e528908e6f3df98991a275f0ee2dbb660607399 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
|
;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
;;;; 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)
(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 10000))
(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-setup-database db-type spec)
(write-report-banner "Benchmarks" db-type *report-stream*
(database-name-from-spec spec db-type))
(create-view-from-class 'bench)
(benchmark-init)
(benchmark-selects count)
(drop-view-from-class 'bench))
(defun benchmark-init ()
(dotimes (i 10)
(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)))
(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))))
(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)))))
|
