Coverage report: /home/runner/work/geb/geb/test/mixins.lisp

KindCoveredAll%
expression236239 98.7
branch1734 50.0
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 (in-package :geb-test)
2
 
3
 (define-test geb-mixins :parent geb-test-suite)
4
 
5
 (defclass subclass-test (so1 distribute) ())
6
 
7
 (define-test equalp-substobj :parent geb-mixins
8
   (obj-equalp so1 so1)
9
   (not (obj-equalp so1 so0))
10
   (obj-equalp so0 so0)
11
   (obj-equalp (coprod so1 so1) (coprod so1 so1))
12
   (not (obj-equalp (coprod so1 so0) (coprod so1 so1)))
13
   (obj-equalp (prod so1 so1) (prod so1 so1))
14
   (not (obj-equalp (prod so1 so0) (prod so1 so1)))
15
   (not (obj-equalp (prod so1 so1) (coprod so1 so1)))
16
   (obj-equalp (prod (prod so1 so1) so0) (prod (prod so1 so1) so0))
17
   (not (obj-equalp (prod (prod so1 so1) so0) (prod (coprod so1 so1) so0)))
18
   (and (c2mop:subclassp (type-of (make-instance 'subclass-test)) (type-of so1))
19
        (not (obj-equalp (make-instance 'subclass-test) so1))))
20
 
21
 ;; Note that here we are testing object equality without
22
 ;; considering intensional aspects. E.g. initial morphism
23
 ;; !: so0 -> so0 is different from id : 0 -> 0
24
 (define-test equalp-substmorph :parent geb-mixins
25
   (obj-equalp (init so1) (init so1))
26
   (not (obj-equalp (init so1) (init so0)))
27
   (obj-equalp (terminal so1) (terminal so1))
28
   (not (obj-equalp (terminal so1) (terminal so0)))
29
   (obj-equalp (mcase (terminal so1) (terminal so1))
30
               (mcase (terminal so1) (terminal so1)))
31
   (not (obj-equalp (mcase (terminal so1) so1)
32
                    (mcase (terminal so1) (terminal so1))))
33
   (obj-equalp (distribute so1 so1 so1)
34
               (distribute so1 so1 so1))
35
   (not (obj-equalp (distribute so1 so1 so1)
36
                    (distribute so1 so0 so0)))
37
   (obj-equalp (pair (init so1) (init so1))
38
               (pair (init so1) (init so1)))
39
   (not (obj-equalp (pair (init so1) so0)
40
                    (pair (init so1) (init so0))))
41
   (obj-equalp (->left so1 so1)
42
               (->left so1 so1))
43
   (not (obj-equalp (->left so1 so1)
44
                    (->left so1 so0)))
45
   (obj-equalp (->right so1 so1)
46
               (->right so1 so1))
47
   (not (obj-equalp (->right so1 so1)
48
                    (->right so1 so0)))
49
   (obj-equalp (<-left so1 so1)
50
               (<-left so1 so1))
51
   (not (obj-equalp (<-left so1 so1)
52
                    (<-left so1 so0)))
53
   (obj-equalp (<-right so1 so1)
54
               (<-right so1 so1))
55
   (not (obj-equalp (<-right so1 so1)
56
                    (<-right so1 so0)))
57
   (not (obj-equalp (<-right so1 so1)
58
                    (<-left so1 so1))))