1 files changed, 55 insertions, 1 deletions
diff --git a/source/Test/Unit/Semantic.hs b/source/Test/Unit/Semantic.hs
index 4a22f08..160735c 100644
--- a/source/Test/Unit/Semantic.hs
+++ b/source/Test/Unit/Semantic.hs
@@ -19,6 +19,7 @@ import Syntax.Abstract qualified as Raw
 
 import Data.ByteString (ByteString)
 import Data.List qualified as List
+import Data.Map.Strict qualified as Map
 import Test.Tasty
 import Test.Tasty.HUnit
 
@@ -32,6 +33,8 @@ unitTests =
             roundTripsSemanticState
         , testCase "round-trips exact semantic global keys"
             roundTripsSemanticGlobalKeys
+        , testCase "round-trips canonical structure descriptors"
+            roundTripsStructureDescriptors
         , testCase "keys exact proof and module inputs"
             keysExactInputs
         ]
@@ -102,7 +105,11 @@ roundTripsSemanticGlobalKeys = do
                     first : rest ->
                         Semantic.semanticGlobalBinding
                             first
-                            (Semantic.TransparentExpansion target)
+                            (Semantic.ContextualTransparentExpansion
+                                target
+                                (Map.singleton
+                                    (Raw.StructSymbol "operation")
+                                    target))
                             : [ Semantic.semanticGlobalBinding
                                     key
                                     (Semantic.GlobalReference target)
@@ -129,6 +136,53 @@ roundTripsSemanticGlobalKeys = do
                 (Semantic.semanticEnvironmentDelta [first, first])
         _ -> assertFailure "semantic key fixture is unexpectedly empty"
 
+roundTripsStructureDescriptors :: Assertion
+roundTripsStructureDescriptors = do
+    fixture <- makeFixture
+    let structurePhrase marker word =
+            Semantic.semanticStructurePhrase
+                (Raw.LexicalItemSgPl
+                    (Raw.SgPl
+                        (Raw.TokenCons (Raw.Word word) Raw.End)
+                        (Raw.TokenCons (Raw.Word (word <> "s")) Raw.End))
+                    marker)
+        base = structurePhrase "onesorted_structure" "base"
+        child = structurePhrase "ordered_structure" "ordered"
+        object =
+            Identity.intrinsicObjectId
+                (fixtureTheory fixture)
+                Core.Empty
+                Core.TySet
+        operation =
+            Semantic.semanticStructureOperation
+                (Raw.StructSymbol "carrier")
+                object
+    descriptor <- expectRight
+        (Semantic.semanticStructureDescriptor
+            child
+            (Just object)
+            [base]
+            [operation])
+    delta <- expectRight
+        (Semantic.semanticEnvironmentWithStructures [] [descriptor])
+    assertEqual
+        "structure environment cache round trip"
+        (Right delta)
+        (decodeCache
+            Semantic.getSemanticEnvironmentDeltaCache
+            (encodeCache
+                (Semantic.putSemanticEnvironmentDeltaCache delta)))
+    assertEqual
+        "duplicate local operation is rejected"
+        (Left
+            (Semantic.DuplicateSemanticStructureOperation
+                (Raw.StructSymbol "carrier")))
+        (Semantic.semanticStructureDescriptor
+            child
+            (Just object)
+            [base]
+            [operation, operation])
+
 keysExactInputs :: Assertion
 keysExactInputs = do
     fixture <- makeFixture