From: Antti Villberg <antti.villberg@semantum.fi>
Date: Sun, 7 May 2017 06:41:46 +0000 (+0300)
Subject: InstanceOf tester (VP.Test)
X-Git-Tag: v1.29.0~70^2~6
X-Git-Url: https://gerrit.simantics.org/r/gitweb?p=simantics%2Fplatform.git;a=commitdiff_plain;h=02b839782670538923022aaa790cbc6b43ee5bdf

InstanceOf tester (VP.Test)

refs #7192

Change-Id: Ife996f7b8dfa7d302877aef7dfad7f4bc711211d
---

diff --git a/bundles/org.simantics.modeling.ontology/graph/ModelingViewpoint.pgraph b/bundles/org.simantics.modeling.ontology/graph/ModelingViewpoint.pgraph
index 7e572df9f..e71c13997 100644
--- a/bundles/org.simantics.modeling.ontology/graph/ModelingViewpoint.pgraph
+++ b/bundles/org.simantics.modeling.ontology/graph/ModelingViewpoint.pgraph
@@ -29,7 +29,7 @@ MOD.SCLAction <T ACT.Action
 MOD.SCLDropAction <T ACT.Action
   --> MOD.SCLDropAction.action ==> "Resource -> Dynamic -> Integer -> <Proc> ()" <R L0.HasProperty : L0.FunctionalRelation 
 
-MOD.SCLTest <T ACT.Action
+MOD.SCLTest <T VP.Test
   --> MOD.SCLTest.test ==> "Resource -> <ReadGraph> Boolean" <R L0.HasProperty : L0.FunctionalRelation 
 
 // Legacy ModelingBrowseContext
@@ -659,6 +659,15 @@ MOD.InstantiateUnder <T MOD.SCLAction
 ACTIONS.InstantiateUnder
   @MOD.sclAction "instantiateUnderAction self"
 
+MOD.InstanceOfTest <T MOD.SCLTest
+  >-- MOD.InstanceOfTest.HasType --> L0.Type <R L0.IsRelatedTo : L0.TotalFunction
+  @MOD.sclAssertion MOD.SCLTest.test "instanceOfTest self" "Resource -> <Proc> Boolean"
+
+MOD.instanceOfTest : L0.Template
+    @template %test %type
+        %test : MOD.InstanceOfTest
+          MOD.InstanceOfTest.HasType %type
+
 TESTS = MAC.Tests : L0.Library
 TESTS.IsNotPublished
   @MOD.sclTest "isNotPublished"
diff --git a/bundles/org.simantics.modeling.ui/scl/Simantics/Testing/BrowseContext.scl b/bundles/org.simantics.modeling.ui/scl/Simantics/Testing/BrowseContext.scl
index 3edb179fc..cd4e9755d 100644
--- a/bundles/org.simantics.modeling.ui/scl/Simantics/Testing/BrowseContext.scl
+++ b/bundles/org.simantics.modeling.ui/scl/Simantics/Testing/BrowseContext.scl
@@ -1,4 +1,4 @@
-import "Simantics/DB"
+import "Simantics/Variables"
 import "Map" as Map
 import "Simantics/Testing/BuiltinKeys"
 
@@ -126,3 +126,7 @@ createBrowseContext resource = do
 importJava "org.simantics.browsing.ui.common.NodeContextBuilder" where
     buildWithInput :: a -> <Proc> NodeContext
 
+instanceOfTest :: Variable -> <ReadGraph> (Resource -> <ReadGraph> Boolean)
+instanceOfTest self = do
+  typeResource = singleObject (represents $ parent self) MOD.InstanceOfTest.HasType
+  (\r -> isInstanceOf r typeResource) 
diff --git a/bundles/org.simantics.modeling/scl/Simantics/All.scl b/bundles/org.simantics.modeling/scl/Simantics/All.scl
index 07f8a0464..00d6980cf 100644
--- a/bundles/org.simantics.modeling/scl/Simantics/All.scl
+++ b/bundles/org.simantics.modeling/scl/Simantics/All.scl
@@ -31,4 +31,5 @@ include "SWT/All"
 include "Simantics/UI"
 include "Simantics/SelectionView"
 include "Simantics/Formatting"
-include "Simantics/Action"
\ No newline at end of file
+include "Simantics/Action"
+include "Simantics/Testing/BrowseContext"
\ No newline at end of file