Coverage report: /home/ati/workspace/perec/persistence/set.lisp

KindCoveredAll%
expression56101 55.4
branch00nil
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
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)
8
 
9
 ;;;;;;;
10
 ;;; Set
11
 
12
 (defptype set (&optional sub-type)
13
   (declare (ignore sub-type))
14
   '(or list persistent-slot-set-container))
15
 
16
 ;; TODO: distinguish between set type and disjunct set type (the latter used in 1-n associations for example)
17
 (defptype disjunct-set (&optional sub-type)
18
   (declare (ignore sub-type))
19
   '(or list persistent-slot-set-container))
20
 
21
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;
22
 ;;; Lazy slot set container
23
 
24
 (defclass* persistent-slot-set-container (set-container)
25
   ((object)
26
    (slot)))
27
 
28
 (defmethod insert-item ((set persistent-slot-set-container) (item persistent-object))
29
   (bind ((slot (slot-of set)))
30
     (update-records (name-of (table-of slot))
31
                     (columns-of slot)
32
                     (object-writer (object-of set))
33
                     (id-column-matcher-where-clause item))))
34
 
35
 (defmethod delete-item ((set persistent-slot-set-container) (item persistent-object))
36
   (bind ((slot (slot-of set)))
37
     (update-records (name-of (table-of slot))
38
                     (columns-of slot)
39
                     '(nil nil)
40
                     (id-column-matcher-where-clause item))))
41
 
42
 (defmethod search-for-item ((set persistent-slot-set-container) (item persistent-object) &key &allow-other-keys)
43
   (not-yet-implemented))
44
 
45
 (defmethod size ((set persistent-slot-set-container))
46
   (bind ((slot (slot-of set)))
47
     (caar (execute (sql `(select (count *)
48
                           ,(name-of (table-of slot))
49
                           ,(id-column-matcher-where-clause (object-of set) (id-column-of slot))))))))
50
 
51
 (defmethod empty-p ((set persistent-slot-set-container))
52
   (= 0 (size set)))
53
 
54
 (defmethod empty! ((set persistent-slot-set-container))
55
   (delete-slot-set (object-of set) (slot-of set)))
56
 
57
 (defmethod list-of ((set persistent-slot-set-container))
58
   (restore-slot-set (object-of set) (slot-of set)))
59
 
60
 (defmethod (setf list-of) (new-value (set persistent-slot-set-container))
61
   (store-slot-set (object-of set) (slot-of set) new-value))
62
 
63
 (defmethod iterate-items ((set persistent-slot-set-container) fn)
64
   (mapc fn (list-of set)))
65
 
66
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
67
 ;;; Lazy persistent set with identity
68
 
69
 (defpclass persistent-set ()
70
   ())
71
 
72
 ;; TODO: implement persistent set with identity (needs a separate table just like m-n associations to store references)
73
 
74
 (defmethod insert-item ((set persistent-set) (item persistent-object))
75
   (not-yet-implemented))
76
 
77
 (defmethod delete-item ((set persistent-set) (item persistent-object))
78
   (not-yet-implemented))
79
 
80
 (defmethod search-for-item ((set persistent-set) (item persistent-object) &key &allow-other-keys)
81
   (not-yet-implemented))
82
 
83
 (defmethod size ((set persistent-set))
84
   (not-yet-implemented))
85
 
86
 (defmethod empty-p ((set persistent-set))
87
   (= 0 (size set)))
88
 
89
 (defmethod empty! ((set persistent-set))
90
   (not-yet-implemented))
91
 
92
 (defmethod list-of ((set persistent-set))
93
   (not-yet-implemented))
94
 
95
 (defmethod (setf list-of) (new-value (set persistent-set))
96
   (not-yet-implemented))
97
 
98
 (defmethod iterate-items ((set persistent-set) fn)
99
   (not-yet-implemented))