postpone undo/redo works, test added

parent 9ce6893c
......@@ -195,7 +195,6 @@
(set! *i* (+ *i* 1))))
(define (postpone ss p cc v s)
(pk `(postpone ,(fluid-ref *n*) ,(length (fluid-ref *conts*))))
(if (< (gp-lookup v ss) (fluid-ref *limit*))
(if (< (fluid-ref *n*) (fluid-ref *max-limit*))
(cc ss p)
......
......@@ -340,7 +340,7 @@ SCM manage_dyn_wind(SCM obj, SCM K, SCM *rguard) {
temp = scm_fluid_ref(var);
scm_fluid_set_x(var, val);
}
vnew[D_FLUID_VAR] = temp;
vnew[D_FLUID_VAL] = temp;
return vnew_;
}
......
(use-modules (logic guile-log))
(use-modules (logic guile-log postpone))
(define-module (undoredo)
:use-module (logic guile-log)
:use-module (logic guile-log postpone)
:use-module (test-suite lib))
(define a '(((1 2) (3 4)) ((5 6) (7 8)) ((9 10) (11 12))))
......@@ -24,6 +26,11 @@
(u (<cut> (<=> x u)))))
(<run> 100 (x)
(postpone-frame 1 1.0 100)
(f x a))
\ No newline at end of file
(define (p-test)
(<run> 100 (x)
(postpone-frame 1 1.0 100)
(f x a)))
(with-test-prefix "guile-log, postpone test"
(pass-if "postpone/1"
(equal? (p-test) '(3 4 1 2 7 8 5 6 11 12 9 10))))
(define-module (undoredo)
:use-module (logic guile-log)
:use-module (logic guile-log postpone)
:use-module (test-suite lib))
(<define> (f x n m)
......@@ -357,6 +358,81 @@
(<continue>))))
(equal? a b)))
(define ap '(((1 2) (3 4)) ((5 6) (7 8)) ((9 10) (11 12))))
(<define> (g1 x a)
(<match> () (a)
(() (<cut> <fail>))
((u . v)
(<and>
(postpone 10 1)
(if (let ((u (<scm> u))) (and (number? u) (= u 5)))
(<stall>)
<cc>)
(f1 x a)))
((u . v)
(<cut> <fail>))
(u (<cut> (<=> x u)))))
(<define> (f1 x a)
(<match> () (a)
(() (<cut> <fail>))
((u . v)
(<or-i> (g1 x u) (f1 x v)))
((u . v) (<cut> <fail>))
(u (<cut> (<=> x u)))))
(<define> (g2 x a)
(<match> () (a)
(() (<cut> <fail>))
((u . v)
(<and>
(postpone 10 1)
(f2 x a)))
((u . v)
(<cut> <fail>))
(u (<cut> (<=> x u)))))
(<define> (f2 x a)
(<match> () (a)
(() (<cut> <fail>))
((u . v)
(<or-i> (g2 x u) (f2 x v)))
((u . v) (<cut> <fail>))
(u (<cut> (<=> x u)))))
(define (postpone-test-1)
(<run> 100 (x)
(<with-generators> ((i 0))
(postpone-frame 1 1.0 100)
(f2 x ap)
(<next-generator-value> + i 1)
(if (= i 5) (<stall>) <cc>)))
(let* ((state (<state-ref>))
(a (<continue>))
(b (begin
(<state-set!> state)
(<continue>))))
(equal? a b)))
(define (postpone-test-2)
(<run> 100 (x)
(postpone-frame 1 1.0 100)
(f1 x ap))
(let* ((state (<state-ref>))
(a (<continue>))
(b (begin
(<state-set!> state)
(<continue>))))
(equal? a b)))
(with-test-prefix "guile-log, interleaving undo/redo"
(pass-if "or/1"
......@@ -388,5 +464,11 @@
(pass-if "fold-test-2"
(//-test-3))
(pass-if "fold-test-3"
(//-test-3)))
(//-test-3))
(pass-if "postpone-test-1"
(postpone-test-1))
(pass-if "postpone-test-2"
(postpone-test-2)))
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment