Coverage report: /home/runner/work/geb/geb/test/gui/graphing.lisp

KindCoveredAll%
expression127129 98.4
branch00nil
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-gui-graphing :parent geb-gui)
4
 
5
 
6
 (define-test notes-work :parent geb-gui-graphing
7
   (let (;; don't want to clutter the allocation globally, so we don't
8
         ;; define it globally.
9
         (node-merge-1
10
           (graphize
11
            geb-bool:bool
12
            (cons-note (make-squash
13
                        :value (graphize geb-bool:bool nil))
14
                       (cons-note (make-note
15
                                   :value (graphize geb-bool:bool nil)
16
                                   :from geb-bool:bool
17
                                   :note "π₂")
18
                                  nil))))
19
         (node-merge-all
20
           (graphize
21
            geb-bool:bool
22
            (cons-note (make-squash
23
                        :value (graphize geb-bool:bool nil))
24
                       (cons-note (make-squash
25
                                   :value (graphize geb-bool:bool nil))
26
                                  nil))))
27
         (population
28
           (hash-table-count (geb.mixins::meta (make-instance 'node))))
29
         (node
30
           (graphize
31
            geb-bool:bool
32
            (cons-note (make-note
33
                        :value (graphize geb-bool:bool nil)
34
                        :from geb-bool:bool
35
                        :note "π₂")
36
                       (cons-note (make-note
37
                                   :value (graphize geb-bool:bool nil)
38
                                   :from geb-bool:bool
39
                                   :note "π₂")
40
                        nil)))))
41
     (format t "~A ~A" population (hash-table-count (geb.mixins::meta node)))
42
     (is >=
43
         ;; with how it works now it's actually 5! but we just need to
44
         ;; check for 2
45
         (+ 2 population)
46
         (hash-table-count (geb.mixins::meta node))
47
         "By inserting these nodes we should have increased the
48
          hashtable by at least two slots")
49
 
50
     (is equalp
51
         (~> node-merge-1
52
             geb-gui.graphing::children
53
             car geb-gui.graphing::children)
54
         nil
55
         "Merging should remove the extra indirection")
56
 
57
     (is equalp
58
         (~> node-merge-all geb-gui.graphing::children)
59
         nil
60
         "All should be merged into one")))
61
 
62
 (define-test composition-works :parent geb-gui-graphing
63
   (let* ((term (comp (<-left so1 so1) (init geb-bool:bool)))
64
          (node
65
            (graphize term nil)))
66
     (is obj-equalp (dom term) (geb-gui.graphing::value node)
67
         "We should be displaying the dom of the first term")
68
     (is obj-equalp
69
         (~> node geb-gui.graphing::children car
70
             geb-gui.graphing::children car
71
             geb-gui.graphing::representation)
72
         so1
73
         "The stack should work and remove the redundant 1 + 1")))
74
 
75
 (define-test composition-with-notes-behaves :parent geb-gui-graphing
76
   (let* ((term (comp (<-left so1 so1) (init geb-bool:bool)))
77
          (node-merge-all
78
            (graphize
79
             term
80
             (cons-note (make-squash :value (graphize geb-bool:bool nil))
81
                        (cons-note (make-note
82
                                    :value (graphize geb-bool:bool nil)
83
                                    :from geb-bool:bool
84
                                    :note "π₂")
85
                                   nil)))))
86
     (is equalp
87
         (~> node-merge-all
88
             ;; so0
89
             geb-gui.graphing::children car
90
             ;; bool
91
             geb-gui.graphing::children car
92
             ;; so1
93
             geb-gui.graphing::children car
94
             ;; nil
95
             geb-gui.graphing::children)
96
         nil
97
         "The nodes should collapse")))
98
 ������������