IntersectMBO · teodanciu · Feb 1, 2025
@@ -56,15 +56,15 @@ prop_shouldFailMapWithDupKeys :: Property
 prop_shouldFailMapWithDupKeys =
   forAllBlind genDuplicateAssocListEncoding $
     \mapEncoding ->
-      let trip = Trip id (decCBOR @(Map Int Int)) (dropCBOR (Proxy @(Map Int Int)))
+      let trip = Trip id (decCBOR @(Map Int Int)) (dropCBOR (Proxy @(Map Int Int))) True
        in property $ embedTripRangeFailureExpectation trip (natVersion @9) maxBound mapEncoding
 
 -- | Starting in version 9, do not accept duplicates in CBOR sets
 prop_shouldFailSetWithDupKeys :: Property
 prop_shouldFailSetWithDupKeys =
   forAllBlind genDuplicateListEncoding $
     \setEncoding ->
-      let trip = Trip id (decCBOR @(Set Int)) (dropCBOR (Proxy @(Set Int)))
+      let trip = Trip id (decCBOR @(Set Int)) (dropCBOR (Proxy @(Set Int))) True
        in property $ embedTripRangeFailureExpectation trip (natVersion @9) maxBound setEncoding
 
 spec :: Spec

@@ -37,10 +37,10 @@ prop_setWithNoDuplicatesAndTag :: Property
 prop_setWithNoDuplicatesAndTag =
   forAllBlind genUniqueListEncoding $
     \(s, setEncoder) ->
-      let trip = Trip id (decCBOR @(Set.Set Int)) (dropCBOR (Proxy @(Set.Set Int)))
+      let trip = Trip id (decCBOR @(Set.Set Int)) (dropCBOR (Proxy @(Set.Set Int))) True
        in property $
             forM_ [(natVersion @9) .. maxBound] $
-              \v -> embedTripExpectation v v trip (\s' _ -> (s' `shouldBe` s)) setEncoder
+              \v -> embedTripExpectation v v trip (\s' _ -> s' `shouldBe` s) setEncoder
 
 spec :: Spec
 spec = do

@@ -9,6 +9,7 @@
 
 module Test.Cardano.Ledger.Binary.Cddl (
   cddlRoundTripCborSpec,
+  cddlRoundTripCborNoFlatTermCompSpec,
   cddlRoundTripExpectation,
   cddlRoundTripAnnCborSpec,
   cddlRoundTripAnnExpectation,
@@ -130,11 +131,33 @@ cddlRoundTripCborSpec ::
   -- | Name of the CDDL variable to test
   T.Text ->
   SpecWith CddlData
-cddlRoundTripCborSpec version varName =
+cddlRoundTripCborSpec = cddlRoundTripCborSpecInternal @a True
+
+cddlRoundTripCborNoFlatTermCompSpec ::
+  forall a.
+  (HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR a) =>
+  -- | Serialization version
+  Version ->
+  -- | Name of the CDDL variable to test
+  T.Text ->
+  SpecWith CddlData
+cddlRoundTripCborNoFlatTermCompSpec = cddlRoundTripCborSpecInternal @a False
+
+cddlRoundTripCborSpecInternal ::
+  forall a.
+  (HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR a) =>
+  Bool ->
+  Version ->
+  T.Text ->
+  SpecWith CddlData
+cddlRoundTripCborSpecInternal flatTermComp version varName =
   let lbl = label $ Proxy @a
+      trip
+        | flatTermComp = cborTrip @a
+        | otherwise = cborTripNoFlatTermComp @a
    in it (T.unpack $ varName <> ": " <> lbl) $ \cddlData ->
         withCddlVarFile varName cddlData $
-          cddlRoundTripExpectation lbl version version (cborTrip @a)
+          cddlRoundTripExpectation lbl version version trip
 
 -- | Verify that random data generated is:
 --

@@ -9,6 +9,7 @@
 module Test.Cardano.Ledger.Binary.Cuddle (
   specWithHuddle,
   huddleRoundTripCborSpec,
+  huddleRoundTripCborNoFlatTermpCompSpec,
   huddleRoundTripAnnCborSpec,
   writeSpec,
 ) where
@@ -46,6 +47,7 @@ import Test.Cardano.Ledger.Binary.RoundTrip (
   RoundTripFailure (RoundTripFailure),
   Trip (..),
   cborTrip,
+  cborTripNoFlatTermComp,
   decodeAnnExtra,
   embedTripLabelExtra,
  )
@@ -86,9 +88,30 @@ huddleRoundTripCborSpec ::
   -- | Name of the CDDL rule to test
   T.Text ->
   SpecWith CuddleData
-huddleRoundTripCborSpec version ruleName =
+huddleRoundTripCborSpec = huddleRoundTripCborSpecInternal @a True
+
+huddleRoundTripCborNoFlatTermpCompSpec ::
+  forall a.
+  (HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR a) =>
+  -- | Serialization version
+  Version ->
+  -- | Name of the CDDL rule to test
+  T.Text ->
+  SpecWith CuddleData
+huddleRoundTripCborNoFlatTermpCompSpec = huddleRoundTripCborSpecInternal @a False
+
+huddleRoundTripCborSpecInternal ::
+  forall a.
+  (HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR a) =>
+  Bool ->
+  Version ->
+  T.Text ->
+  SpecWith CuddleData
+huddleRoundTripCborSpecInternal flatTermComp version ruleName =
   let lbl = label $ Proxy @a
-      trip = cborTrip @a
+      trip
+        | flatTermComp = cborTrip @a
+        | otherwise = cborTripNoFlatTermComp @a
    in it (T.unpack ruleName <> ": " <> T.unpack lbl) $
         \cddlData ->
           withGenTerm cddlData (Cuddle.Name ruleName) $

@@ -14,6 +14,7 @@ module Test.Cardano.Ledger.Binary.RoundTrip (
   -- * Spec
   roundTripSpec,
   roundTripCborSpec,
+  roundTripCborNoFlatTermCompSpec,
   roundTripAnnCborSpec,
   roundTripRangeSpec,
 
@@ -51,6 +52,7 @@ module Test.Cardano.Ledger.Binary.RoundTrip (
   Trip (..),
   mkTrip,
   cborTrip,
+  cborTripNoFlatTermComp,
 
   -- * Tripping functions
   roundTrip,
@@ -105,6 +107,12 @@ roundTripCborSpec ::
   Spec
 roundTripCborSpec = roundTripSpec (cborTrip @t)
 
+roundTripCborNoFlatTermCompSpec ::
+  forall t.
+  (Show t, Eq t, Arbitrary t, EncCBOR t, DecCBOR t) =>
+  Spec
+roundTripCborNoFlatTermCompSpec = roundTripSpec (cborTripNoFlatTermComp @t)
+
 -- | Tests the roundtrip property using QuickCheck generators for all possible versions
 -- starting with `shelleyProtVer`.
 roundTripAnnCborSpec ::
@@ -247,13 +255,14 @@ roundTripCborExpectation = roundTripExpectation (cborTrip @t @t)
 roundTripCborRangeExpectation ::
   forall t.
   (Show t, Eq t, EncCBOR t, DecCBOR t, HasCallStack) =>
+  Bool ->
   -- | From Version
   Version ->
   -- | To Version
   Version ->
   t ->
   Expectation
-roundTripCborRangeExpectation = roundTripRangeExpectation (cborTrip @t)
+roundTripCborRangeExpectation = roundTripRangeExpectation . cborTripInternal @t
 
 roundTripAnnExpectation ::
   (Show t, Eq t, ToCBOR t, DecCBOR (Annotator t), HasCallStack) =>
@@ -406,15 +415,22 @@ data Trip a b = Trip
   { tripEncoder :: a -> Encoding
   , tripDecoder :: forall s. Decoder s b
   , tripDropper :: forall s. Decoder s ()
+  , flatTermComp :: Bool
   }
 
 cborTrip :: forall a b. (EncCBOR a, DecCBOR b) => Trip a b
-cborTrip = Trip encCBOR decCBOR (dropCBOR (Proxy @b))
+cborTrip = cborTripInternal True
+
+cborTripNoFlatTermComp :: forall a b. (EncCBOR a, DecCBOR b) => Trip a b
+cborTripNoFlatTermComp = cborTripInternal False
+
+cborTripInternal :: forall a b. (EncCBOR a, DecCBOR b) => Bool -> Trip a b
+cborTripInternal = Trip encCBOR decCBOR (dropCBOR (Proxy @b))
 
 -- | Construct a `Trip` using encoder and decoder, with dropper set to the decoder which
 -- drops the value
 mkTrip :: forall a b. (a -> Encoding) -> (forall s. Decoder s b) -> Trip a b
-mkTrip encoder decoder = Trip encoder decoder (() <$ decoder)
+mkTrip encoder decoder = Trip encoder decoder (() <$ decoder) True
 
 -- | Check that serialization followed by deserialization of the value produces the same
 -- value back. We also check that re-serialization is idempotent. In other words, we
@@ -444,7 +460,7 @@ roundTripTwiddled ::
   Gen (Either RoundTripFailure t)
 roundTripTwiddled version x = do
   tw <- twiddle version x
-  pure (roundTrip version (Trip (const (encodeTerm tw)) decCBOR (dropCBOR (Proxy @t))) x)
+  pure (roundTrip version (Trip (const (encodeTerm tw)) decCBOR (dropCBOR (Proxy @t)) True) x)
 
 roundTripAnn :: (ToCBOR t, DecCBOR (Annotator t)) => Version -> t -> Either RoundTripFailure t
 roundTripAnn v = embedTripAnn v v
@@ -514,7 +530,7 @@ embedTripLabelExtra ::
   Trip a b ->
   a ->
   Either RoundTripFailure (b, Plain.Encoding, BSL.ByteString)
-embedTripLabelExtra lbl encVersion decVersion (Trip encoder decoder dropper) s = result
+embedTripLabelExtra lbl encVersion decVersion (Trip encoder decoder dropper flatTermComp) s = result
   where
     mkFailure = RoundTripFailure encVersion decVersion encoding encodedBytes Nothing
     result =
@@ -531,7 +547,7 @@ embedTripLabelExtra lbl encVersion decVersion (Trip encoder decoder dropper) s =
                       -- Left $ mkFailure (Just $ "fromFlatTerm error:" <> err) Nothing Nothing
                       Right (val, encoding, encodedBytes)
                     Right valFromFlatTerm
-                      | val /= valFromFlatTerm ->
+                      | flatTermComp && val /= valFromFlatTerm ->
                           let errMsg =
                                 "Deserializing through FlatTerm produced a different "
                                   ++ "value then the regular deserializer did"

@@ -17,6 +17,7 @@ module Test.Cardano.Ledger.Core.Binary.RoundTrip (
 
   -- * Spec
   roundTripEraSpec,
+  roundTripEraNoFlatTermCompSpec,
   roundTripAnnEraSpec,
   roundTripEraTypeSpec,
   roundTripAnnEraTypeSpec,
@@ -56,6 +57,13 @@ roundTripEraSpec ::
 roundTripEraSpec =
   prop (show (typeRep $ Proxy @t)) $ roundTripEraExpectation @era @t
 
+roundTripEraNoFlatTermCompSpec ::
+  forall era t.
+  (Era era, Show t, Eq t, EncCBOR t, DecCBOR t, Arbitrary t, HasCallStack) =>
+  Spec
+roundTripEraNoFlatTermCompSpec =
+  prop (show (typeRep $ Proxy @t)) $ roundTripEraExpectationInternal @era @t False
+
 -- | Roundtrip CBOR testing for types and type families that implement
 -- EncCBOR/DecCBOR. Requires TypeApplication of an @@era@
 roundTripEraExpectation ::
@@ -64,7 +72,16 @@ roundTripEraExpectation ::
   t ->
   Expectation
 roundTripEraExpectation =
-  roundTripCborRangeExpectation (eraProtVerLow @era) (eraProtVerHigh @era)
+  roundTripEraExpectationInternal @era @t True
+
+roundTripEraExpectationInternal ::
+  forall era t.
+  (Era era, Show t, Eq t, EncCBOR t, DecCBOR t, HasCallStack) =>
+  Bool ->
+  t ->
+  Expectation
+roundTripEraExpectationInternal noFlatTermCompare =
+  roundTripCborRangeExpectation noFlatTermCompare (eraProtVerLow @era) (eraProtVerHigh @era)
 
 -- | QuickCheck property spec that uses `roundTripAnnEraExpectation`
 roundTripAnnEraSpec ::