diff --git a/src/Control/Abstract/Value.hs b/src/Control/Abstract/Value.hs index 322e1b15a..ec17da27f 100644 --- a/src/Control/Abstract/Value.hs +++ b/src/Control/Abstract/Value.hs @@ -1,17 +1,18 @@ -{-# LANGUAGE MultiParamTypeClasses, Rank2Types, TypeFamilies, TypeOperators, UndecidableInstances, GADTs, StandaloneDeriving #-} +{-# LANGUAGE GADTs, MultiParamTypeClasses, Rank2Types, StandaloneDeriving, TypeFamilies, TypeOperators, + UndecidableInstances #-} module Control.Abstract.Value where -import Control.Abstract.Addressable -import Control.Abstract.Analysis +import Control.Abstract.Addressable +import Control.Abstract.Analysis import qualified Data.Abstract.Environment as Env -import Data.Abstract.FreeVariables -import Data.Abstract.Number as Number -import Data.Abstract.Type as Type -import Data.Abstract.Value as Value -import Data.Scientific (Scientific) +import Data.Abstract.FreeVariables +import Data.Abstract.Number as Number +import Data.Abstract.Type as Type +import Data.Abstract.Value as Value +import Data.Scientific (Scientific) import qualified Data.Set as Set -import Prelude hiding (fail) -import Prologue +import Prelude hiding (fail) +import Prologue -- | This datum is passed into liftComparison to handle the fact that Ruby and PHP -- have built-in generalized-comparison ("spaceship") operators. If you want to @@ -142,6 +143,11 @@ data ValueExc v where ValueExc :: Prelude.String -> ValueExc Value StringExc :: Prelude.String -> ValueExc ByteString +instance Eq1 ValueExc where + liftEq _ (ValueExc a) (ValueExc b) = a == b + liftEq _ (StringExc a) (StringExc b) = a == b + liftEq _ _ _ = False + deriving instance Show (ValueExc v) instance Show1 ValueExc where liftShowsPrec _ _ = showsPrec diff --git a/src/Data/Abstract/Evaluatable.hs b/src/Data/Abstract/Evaluatable.hs index 5d5cb9701..5dbd0a465 100644 --- a/src/Data/Abstract/Evaluatable.hs +++ b/src/Data/Abstract/Evaluatable.hs @@ -24,6 +24,9 @@ import Prologue data Unspecialized a b where Unspecialized :: { getUnspecialized :: Prelude.String } -> Unspecialized value value +instance Eq1 (Unspecialized a) where + liftEq _ (Unspecialized a) (Unspecialized b) = a == b + deriving instance Eq (Unspecialized a b) deriving instance Show (Unspecialized a b) instance Show1 (Unspecialized a) where diff --git a/test/Analysis/Python/Spec.hs b/test/Analysis/Python/Spec.hs index ab0c92f6c..350462f27 100644 --- a/test/Analysis/Python/Spec.hs +++ b/test/Analysis/Python/Spec.hs @@ -36,11 +36,11 @@ spec = parallel $ do it "subclasses" $ do res <- evaluate' "subclass.py" - join (fst res) `shouldBe` Right (injValue (String "\"bar\"")) + fst res `shouldBe` Right (Right (Right (injValue (String "\"bar\"")))) it "handles multiple inheritance left-to-right" $ do res <- evaluate' "multiple_inheritance.py" - join (fst res) `shouldBe` Right (injValue (String "\"foo!\"")) + fst res `shouldBe` Right (Right (Right (injValue (String "\"foo!\"")))) where addr = Address . Precise diff --git a/test/Analysis/Ruby/Spec.hs b/test/Analysis/Ruby/Spec.hs index 8bdee6c28..8d2497d7d 100644 --- a/test/Analysis/Ruby/Spec.hs +++ b/test/Analysis/Ruby/Spec.hs @@ -28,7 +28,7 @@ spec = parallel $ do it "subclass" $ do res <- evaluate' "subclass.rb" - join (fst res) `shouldBe` Right (injValue (String "\"\"")) + fst res `shouldBe` Right (Right (Right (injValue (String "\"\"")))) where addr = Address . Precise