/ test /
/test/suite.lisp
 1 ;; -*- mode: Lisp; Syntax: Common-Lisp; -*-
 2 ;;;
 3 ;;; Copyright (c) 2006 by the authors.
 4 ;;;
 5 ;;; See LICENCE for details.
 6 
 7 (in-package :cl-perec-test)
 8 
 9 (defun drop-all-test-tables ()
10   (with-transaction
11     (mapc #L(drop-table !1 :cascade #t)
12           (collect-if #L(starts-with-subseq "_" !1)
13                       (list-tables)))))
14 
15 (defmacro with-and-without-caching-slot-values (&body forms)
16   `(progn
17     (without-caching-slot-values
18       ,@forms)
19     (with-caching-slot-values
20       ,@forms)))
21 
22 (defmacro with-two-transactions (form-1 &body forms-2)
23   `(let ((-instance-
24           (with-transaction
25             ,form-1)))
26     (with-transaction
27       (revive-instance -instance-)
28       ,@forms-2)))
29 
30 (defmacro with-one-and-two-transactions (form-1 &body forms-2)
31   `(progn
32     (with-transaction
33       (let ((-instance- ,form-1))
34         (declare (ignorable -instance-))
35         ,@forms-2))
36     (with-two-transactions ,form-1 ,@forms-2)))
37 
38 (defun retest ()
39   (drop-all-test-tables)
40   (clear-compiled-query-cache)
41   ;; TODO should take care of possible remaining persistent-object-hs
42   (mapc (lambda (elememnt)
43           (awhen (primary-table-of elememnt)
44             (invalidate-computed-slot it 'ensure-exported))
45           (when (typep elememnt 'persistent-class)
46             (awhen (direct-instances-identity-view-of elememnt)
47               (invalidate-computed-slot it 'ensure-exported))
48             (awhen (direct-instances-data-view-of elememnt)
49               (invalidate-computed-slot it 'ensure-exported))
50             (awhen (all-instances-identity-view-of elememnt)
51               (invalidate-computed-slot it 'ensure-exported))
52             (awhen (all-instances-data-view-of elememnt)
53               (invalidate-computed-slot it 'ensure-exported))))
54         (append (hash-table-values *persistent-classes*)
55                 (hash-table-values *persistent-associations*)))
56   (test))
57 
58 ;; use some unnecessary explicit package prefixing for clarity
59 (def class* transaction-mixin/test (cl-perec:transaction-mixin)
60   ())
61 
62 (def class* postgresql-postmodern/test (cl-perec:database-mixin cl-rdbms:postgresql-postmodern)
63   ())
64 
65 (def method transaction-mixin-class list ((self postgresql-postmodern/test))
66   'transaction-mixin/test)
67 
68 (defsuite* (test :in root-suite))
69 
70 (defsuite* (test/persistence :in test))
71 
72 (defsuite* (test/query :in test))
73 
74 (defsuite* (test/dimensional :in test))
75 
76 ;; test dimension
77 (def pclass* dimension-test ()
78   ())
79 
80 (def dimension test :type dimension-test)
81 
82 (defixture test-dimension-fixture
83   (with-transaction
84     (purge-instances 'dimension-test)
85     (make-instance 'dimension-test)
86     (make-instance 'dimension-test)
87     (make-instance 'dimension-test)))
88 
89 (defmacro with-setup (fixture &body body)
90   (if fixture
91       `(progn
92         (funcall ',fixture)
93         ,@body)
94       `(progn
95         ,@body)))