Add more properties for ScaleValue

Author: SeungheonOh

plutus-core/plutus-core/test/Value/Spec.hs

@@ -188,6 +188,30 @@ prop_containsEnforcesPositivity v
       (BuiltinFailure{}, BuiltinFailure{}) -> property True
       _                                    -> property False
 
+scaleCorrectlyBound :: Integer -> Value -> Bool
+scaleCorrectlyBound factor val =
+  any
+    (\(_, _, V.unQuantity -> q) -> isNothing $ V.quantity $ q * factor)
+    $ V.toFlatList val
+
+prop_scaleBookKeeping :: Integer -> Value -> Property
+prop_scaleBookKeeping factor v =
+  case V.scaleValue factor v of
+    BuiltinSuccess r -> checkBookkeeping r
+    _                -> property $ scaleCorrectlyBound factor v
+
+prop_scaleByOneIsId :: Value -> Property
+prop_scaleByOneIsId v =
+  property $ case V.scaleValue 1 v of
+    BuiltinSuccess r -> r == v
+    _                -> scaleCorrectlyBound 1 v
+
+prop_negateInvolutive :: Value -> Property
+prop_negateInvolutive v =
+  property $ case V.scaleValue (-1) v >>= V.scaleValue (-1) of
+    BuiltinSuccess r -> r == v
+    _                -> scaleCorrectlyBound (-1) v
+
 prop_negateIsInverse :: Value -> Property
 prop_negateIsInverse v =
   let
@@ -196,22 +220,18 @@ prop_negateIsInverse v =
       V.unionValue v vInv
   in property $ case inverseUnion of
        BuiltinSuccess r -> r == V.empty
-       _                -> False
+       _                -> scaleCorrectlyBound (-1) v
 
 prop_oppositeScaleIsInverse :: Integer -> Value -> Property
 prop_oppositeScaleIsInverse c v =
   let
-    inverseUnion = do
+    scaledValue = do
       vInv <- V.scaleValue (negate c) v
       v' <- V.scaleValue c v
       V.unionValue v' vInv
-    correctlyBound =
-      any
-        (\(_, _, V.unQuantity -> q) -> isNothing $ V.quantity $ q * c)
-        $ V.toFlatList v
-  in property $ case inverseUnion of
+  in property $ case scaledValue of
        BuiltinSuccess r -> r == V.empty
-       _                -> correctlyBound
+       _                -> scaleCorrectlyBound c v
 
 prop_flatRoundtrip :: Value -> Property
 prop_flatRoundtrip v = Flat.unflat (Flat.flat v) === Right v
@@ -447,6 +467,18 @@ tests =
     , testProperty
         "unionValueDetectsOverflow"
         prop_unionValueDetectsOverflow
+    , testProperty
+        "scaleBookKeeping"
+        prop_scaleBookKeeping
+    , testProperty
+        "scaleByOneIsId"
+        prop_scaleByOneIsId
+    , testProperty
+        "scaleByOneIsId"
+        prop_scaleByOneIsId
+    , testProperty
+        "negateInvolutive"
+        prop_negateInvolutive
     , testProperty
         "negateIsInverse"
         prop_negateIsInverse