models: Add word to force recomputation of model values

diff --git a/basis/models/models-docs.factor b/basis/models/models-docs.factor
index 57a0f59584095767f04532dfe1b5ded6b822a509..9207e3ac5170fc8b5f398b8b574460c4b186f8c4 100644 (file)
--- a/basis/models/models-docs.factor
+++ b/basis/models/models-docs.factor
@@ -46,6 +46,10 @@ HELP: deactivate-model
 { $description "Decrements the reference count of the model. If it reaches zero, this model is removed as a connection from all models registered as dependencies by " { $link add-dependency } "." }
 { $warning "Calls to " { $link activate-model } " and " { $link deactivate-model } " should be balanced to keep the reference counting consistent, otherwise " { $link model-changed } " might be called at the wrong time or not at all." } ;
 
+HELP: compute-model
+{ $values { "model" model } { "value" object} }
+{ $description "Activate and immediately deactivate the model, forcing recomputation of its value, which is returned. If the model is already activated, no dependencies are recalculated.  Useful when using models outside of gadget context or for testing." } ;
+
 HELP: model-changed
 { $values { "model" model } { "observer" object } }
 { $contract "Called to notify observers of a model that the model value has changed as a result of a call to " { $link set-model } ". Observers can be registered with " { $link add-connection } "." } ;

diff --git a/basis/models/models-tests.factor b/basis/models/models-tests.factor
index a24f96e0eb588b408bdc24f462f99320b6c57580..60f223a12db5063ec27ff5fee0620835de7a6c1f 100644 (file)
--- a/basis/models/models-tests.factor
+++ b/basis/models/models-tests.factor
@@ -1,5 +1,5 @@
-USING: arrays generic kernel math models models.product
-namespaces sequences assocs accessors tools.test ;
+USING: accessors arrays assocs generic kernel math models models.arrow
+models.product namespaces sequences tools.test ;
 IN: models.tests
 
 TUPLE: model-tester hit? ;
@@ -43,3 +43,7 @@ T{ model-tester f f } "tester" set
     T{ model-tester f f } clone V{ 5 } clone <model> 2dup add-connection
     [ pop-model ] [ value>> ] bi
 ] unit-test
+
+{ f } [ 46 <model> [ 1 + ] <arrow> value>> ] unit-test
+{ 47 } [ 46 <model> [ 1 + ] <arrow> compute-model ] unit-test
+{ 0 } [ 46 <model> [ 1 + ] <arrow> [ compute-model drop ] keep ref>> ] unit-test

diff --git a/basis/models/models.factor b/basis/models/models.factor
index 0fa5f2079e54ea9a4a43c5cd50f83eb9c1899d71..9a5967b1cc119fcd3b35dcddc8b877c18febac54 100644 (file)
--- a/basis/models/models.factor
+++ b/basis/models/models.factor
@@ -54,6 +54,9 @@ DEFER: remove-connection
         drop
     ] if ;
 
+: compute-model ( model -- value )
+    [ activate-model ] [ deactivate-model ] [ value>> ] tri ;
+
 GENERIC: model-changed ( model observer -- )
 
 : add-connection ( observer model -- )