Disable incorrect properties, fixes #3037.

haskell · Feb 1, 2016 · a392e79 · a392e79
1 parent 37192ad
commit a392e79
Show file tree

Hide file tree

Showing 3 changed files with 54 additions and 20 deletions.
diff --git a/Cabal/Distribution/Version.hs b/Cabal/Distribution/Version.hs
@@ -161,7 +161,7 @@ instance Binary Version where
 {-# DEPRECATED UnionVersionRanges
     "Use 'unionVersionRanges', 'foldVersionRange' or 'asVersionIntervals'" #-}
 {-# DEPRECATED IntersectVersionRanges
-    "Use 'intersectVersionRanges', 'foldVersionRange' or 'asVersionIntervals'" #-}
+    "Use 'intersectVersionRanges', 'foldVersionRange' or 'asVersionIntervals'"#-}
 
 -- | The version range @-any@. That is, a version range containing all
 -- versions.

diff --git a/Cabal/tests/UnitTests.hs b/Cabal/tests/UnitTests.hs
@@ -9,7 +9,7 @@ import qualified UnitTests.Distribution.Compat.ReadP
 import qualified UnitTests.Distribution.Simple.Program.Internal
 import qualified UnitTests.Distribution.Utils.NubList
 import qualified UnitTests.Distribution.System
-import qualified UnitTests.Distribution.Version (versionTests, parseTests)
+import qualified UnitTests.Distribution.Version (versionTests)
 
 tests :: TestTree
 tests = testGroup "Unit Tests" $
@@ -24,7 +24,7 @@ tests = testGroup "Unit Tests" $
     , testGroup "Distribution.System"
         UnitTests.Distribution.System.tests
     , UnitTests.Distribution.Version.versionTests
-    , UnitTests.Distribution.Version.parseTests
+--    , UnitTests.Distribution.Version.parseTests
     ]
 
 main :: IO ()

diff --git a/Cabal/tests/UnitTests/Distribution/Version.hs b/Cabal/tests/UnitTests/Distribution/Version.hs
@@ -2,12 +2,13 @@
                 -fno-warn-incomplete-patterns
                 -fno-warn-deprecations
                 -fno-warn-unused-binds #-} --FIXME
-module UnitTests.Distribution.Version (versionTests, parseTests) where
+module UnitTests.Distribution.Version (versionTests) where
 
 import Distribution.Version
 import Distribution.Text
 
-import Text.PrettyPrint as Disp (text, render, parens, hcat, punctuate, int, char, (<>), (<+>))
+import Text.PrettyPrint as Disp (text, render, parens, hcat
+                                ,punctuate, int, char, (<>), (<+>))
 
 import Test.Tasty (TestTree, testGroup)
 import Test.Tasty.QuickCheck
@@ -84,15 +85,21 @@ versionTests =
   , property prop_invertVersionIntervalsTwice
   ]
 
-parseTests :: TestTree
-parseTests =
-  testGroup "Distribution.Version" $
-  zipWith (\n p -> testProperty ("Parse Property " ++ show n) p) [1::Int ..]
-   -- parsing and pretty printing
-  [ -- property prop_parse_disp1  --FIXME: actually wrong
-    property prop_parse_disp2
-  , property prop_parse_disp3
-  ]
+-- parseTests :: TestTree
+-- parseTests =
+--   testGroup "Distribution.Version" $
+--   zipWith (\n p -> testProperty ("Parse Property " ++ show n) p) [1::Int ..]
+--    -- parsing and pretty printing
+--   [ -- property prop_parse_disp1  --FIXME: actually wrong
+
+--     --  These are also wrong, see
+--     --  https://github.com/haskell/cabal/issues/3037#issuecomment-177671011
+
+--     --   property prop_parse_disp2
+--     -- , property prop_parse_disp3
+--     -- , property prop_parse_disp4
+--     -- , property prop_parse_disp5
+--   ]
 
 instance Arbitrary Version where
   arbitrary = do
@@ -648,14 +655,41 @@ prop_parse_disp1 vr =
       IntersectVersionRanges (stripParens v1) (stripParens v2)
     stripParens v = v
 
-prop_parse_disp2 :: VersionRange -> Bool
+prop_parse_disp2 :: VersionRange -> Property
 prop_parse_disp2 vr =
-     fmap (display :: VersionRange -> String) (simpleParse (display vr))
-  == Just (display vr)
-
-prop_parse_disp3 :: VersionRange -> Bool
+  let b = fmap (display :: VersionRange -> String) (simpleParse (display vr))
+      a = Just (display vr)
+  in
+   counterexample ("Expected: " ++ show a) $
+   counterexample ("But got: " ++ show b) $
+   b == a
+
+prop_parse_disp3 :: VersionRange -> Property
 prop_parse_disp3 vr =
-  fmap displayRaw (simpleParse (display vr)) == Just (display vr)
+  let a = Just (display vr)
+      b = fmap displayRaw (simpleParse (display vr))
+  in
+   counterexample ("Expected: " ++ show a) $
+   counterexample ("But got: " ++ show b) $
+   b == a
+
+prop_parse_disp4 :: VersionRange -> Property
+prop_parse_disp4 vr =
+  let a = Just vr
+      b = (simpleParse (display vr))
+  in
+   counterexample ("Expected: " ++ show a) $
+   counterexample ("But got: " ++ show b) $
+   b == a
+
+prop_parse_disp5 :: VersionRange -> Property
+prop_parse_disp5 vr =
+  let a = Just vr
+      b = simpleParse (displayRaw vr)
+  in
+   counterexample ("Expected: " ++ show a) $
+   counterexample ("But got: " ++ show b) $
+   b == a
 
 displayRaw :: VersionRange -> String
 displayRaw =