blob: af340cc7f9acba8ca21f05f24c35ae0eb08e220c (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
|
(define-module (tests scene)
#:use-module (catbird mode)
#:use-module (catbird node)
#:use-module (catbird scene)
#:use-module (oop goops)
#:use-module (srfi srfi-64)
#:use-module (tests utils))
(define-class <test-mode> (<major-mode>))
(with-tests "scene"
(let ((scene (make <scene>))
(node (make <node> #:name 'foo)))
(test-eq "add-to-scene"
(with-scene scene
(add-to-scene node)
(child-ref scene 'foo))
node))
(test-eq "initial major mode"
(class-of (major-mode (make <scene>)))
<nothing-mode>)
(test-group "replace-major-mode"
(test-eq "replacing does not add to the mode stack"
(let ((scene (make <scene>)))
(replace-major-mode scene (make <test-mode>))
(pop-major-mode scene)
(class-of (major-mode scene)))
<test-mode>)
(test-assert "exits previous mode, enters new one"
(let ((scene (make <scene>))
(entered? #f)
(exited? #f))
(define-class <mode1> (<major-mode>))
(define-class <mode2> (<major-mode>))
(define-method (on-exit (mode <mode1>))
(set! exited? #t))
(define-method (on-enter (mode <mode2>))
(set! entered? #t))
(replace-major-mode scene (make <mode1>))
(replace-major-mode scene (make <mode2>))
(and entered? exited?))))
(test-group "push-major-mode"
(test-eq "adds previous mode to the mode stack so it can be restored"
(let ((scene (make <scene>)))
(push-major-mode scene (make <test-mode>))
(pop-major-mode scene)
(class-of (major-mode scene)))
<nothing-mode>)
(test-assert "pauses the previous mode, enters new one"
(let ((scene (make <scene>))
(paused? #f)
(entered? #f))
(define-class <mode1> (<major-mode>))
(define-class <mode2> (<major-mode>))
(define-method (on-pause (mode <mode1>))
(set! paused? #t))
(define-method (on-enter (mode <mode2>))
(set! entered? #t))
(push-major-mode scene (make <mode1>))
(push-major-mode scene (make <mode2>))
(and paused? entered?))))
(test-group "pop-major-mode"
(test-eq "does nothing when there is no previous major mode"
(let ((scene (make <scene>)))
(pop-major-mode scene)
(class-of (major-mode scene)))
<nothing-mode>)
(test-assert "returns to previous major mode"
(let ((scene (make <scene>)))
(push-major-mode scene (make <test-mode>))
(and (eq? (class-of (major-mode scene)) <test-mode>)
(begin
(pop-major-mode scene)
(eq? (class-of (major-mode scene)) <nothing-mode>)))))))
|
