X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=tests%2Fbenchmarks.lisp;h=a39f49b036f45d7e92ceaceef462aa0977195430;hb=dfb6230f04c4c2129b89d1d421c01bbc3f9fd57f;hp=3802d5c0880d0dbb4d6c154e896813c54b688b4d;hpb=63e4d6376762153f80b13050323ddec364e26eb7;p=clsql.git diff --git a/tests/benchmarks.lisp b/tests/benchmarks.lisp index 3802d5c..a39f49b 100644 --- a/tests/benchmarks.lisp +++ b/tests/benchmarks.lisp @@ -3,7 +3,7 @@ ;;;; File: benchmarks.lisp ;;;; Authors: Kevin Rosenberg ;;;; Created: 03/05/2004 -;;;; Updated: $Id: test-init.lisp 9212 2004-05-03 18:44:03Z kevin $ +;;;; Updated: $Id$ ;;;; ;;;; Benchmark suite ;;;; @@ -26,18 +26,18 @@ :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)) + (*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)))) + (do-benchmarks-for-backend db-type spec count)))) (values)) (defun do-benchmarks-for-backend (db-type spec count) @@ -68,12 +68,17 @@ (time (dotimes (i n) (query "SELECT * FROM BENCH" :field-names nil))) - (format *report-stream* "~&~%*** OBJECT QUERY ***~%") + (format *report-stream* "~&~%*** JOINED OBJECT QUERY RETRIEVAL IMMEDIATE ***~%") (time - (dotimes (i n) + (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))))