Script 'mail_helper' called by obssrc Hello community, here is the log from the commit of package ghc-reflection for openSUSE:Factory checked in at 2024-12-20 23:10:51 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-reflection (Old) and /work/SRC/openSUSE:Factory/.ghc-reflection.new.1881 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-reflection" Fri Dec 20 23:10:51 2024 rev:16 rq:1231466 version:2.1.9 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-reflection/ghc-reflection.changes 2024-05-13 01:12:17.523766931 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-reflection.new.1881/ghc-reflection.changes 2024-12-20 23:11:43.479203966 +0100 @@ -1,0 +2,7 @@ +Wed Dec 4 12:05:19 UTC 2024 - Peter Simons <[email protected]> + +- Update reflection to version 2.1.9. + # 2.1.9 [2024.12.04] + * Drop support for pre-8.0 versions of GHC. + +------------------------------------------------------------------- Old: ---- reflection-2.1.8.tar.gz New: ---- reflection-2.1.9.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-reflection.spec ++++++ --- /var/tmp/diff_new_pack.XfxJBq/_old 2024-12-20 23:11:44.191233323 +0100 +++ /var/tmp/diff_new_pack.XfxJBq/_new 2024-12-20 23:11:44.195233488 +0100 @@ -20,7 +20,7 @@ %global pkgver %{pkg_name}-%{version} %bcond_with tests Name: ghc-%{pkg_name} -Version: 2.1.8 +Version: 2.1.9 Release: 0 Summary: Reifies arbitrary terms into types that can be reflected back into terms License: BSD-3-Clause ++++++ reflection-2.1.8.tar.gz -> reflection-2.1.9.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/reflection-2.1.8/CHANGELOG.markdown new/reflection-2.1.9/CHANGELOG.markdown --- old/reflection-2.1.8/CHANGELOG.markdown 2001-09-09 03:46:40.000000000 +0200 +++ new/reflection-2.1.9/CHANGELOG.markdown 2001-09-09 03:46:40.000000000 +0200 @@ -1,3 +1,6 @@ +# 2.1.9 [2024.12.04] +* Drop support for pre-8.0 versions of GHC. + # 2.1.8 [2024.05.04] * Fix a memory leak in `reifyTypeable`. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/reflection-2.1.8/examples/Constraints.hs new/reflection-2.1.9/examples/Constraints.hs --- old/reflection-2.1.8/examples/Constraints.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/reflection-2.1.9/examples/Constraints.hs 2001-09-09 03:46:40.000000000 +0200 @@ -10,7 +10,7 @@ import Data.Semigroup -- from semigroups #endif --- | Values in our dynamically constructed monoid over 'a' +-- | Values in our dynamically constructed monoid over @a@ newtype Lift (p :: * -> Constraint) (a :: *) (s :: *) = Lift { lower :: a } class ReifiableConstraint p where diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/reflection-2.1.8/examples/FromJSON.hs new/reflection-2.1.9/examples/FromJSON.hs --- old/reflection-2.1.8/examples/FromJSON.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/reflection-2.1.9/examples/FromJSON.hs 2001-09-09 03:46:40.000000000 +0200 @@ -11,9 +11,7 @@ {-# LANGUAGE OverloadedStrings #-} import Data.Aeson -- from aeson -#if MIN_VERSION_aeson(2,0,0) import qualified Data.Aeson.Key as Key -#endif import Data.Aeson.Types (Parser) import Data.Proxy -- from tagged import Data.Reflection -- from reflection @@ -36,15 +34,7 @@ fooParser :: Text -> Object -> Parser Foo fooParser prefix o = do - Foo <$> o .: (toKey prefix <> "field1") <*> o .: (toKey prefix <> "field2") - -#if MIN_VERSION_aeson(2,0,0) -toKey :: Text -> Key.Key -toKey = Key.fromText -#else -toKey :: Text -> Text -toKey = id -#endif + Foo <$> o .: (Key.fromText prefix <> "field1") <*> o .: (Key.fromText prefix <> "field2") -- A wrapper over Foo carrying a phantom type s newtype J a s = J { runJ :: a } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/reflection-2.1.8/examples/Monoid.hs new/reflection-2.1.9/examples/Monoid.hs --- old/reflection-2.1.8/examples/Monoid.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/reflection-2.1.9/examples/Monoid.hs 2001-09-09 03:46:40.000000000 +0200 @@ -7,7 +7,7 @@ import Data.Semigroup -- from base #endif --- | Values in our dynamically-constructed 'Monoid' over 'a' +-- | Values in our dynamically-constructed 'Monoid' over @a@ newtype M a s = M { runM :: a } deriving (Eq,Ord) -- | A dictionary describing a 'Monoid' diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/reflection-2.1.8/examples/reflection-examples.cabal new/reflection-2.1.9/examples/reflection-examples.cabal --- old/reflection-2.1.8/examples/reflection-examples.cabal 2001-09-09 03:46:40.000000000 +0200 +++ new/reflection-2.1.9/examples/reflection-examples.cabal 2001-09-09 03:46:40.000000000 +0200 @@ -23,8 +23,11 @@ , GHC == 8.10.7 , GHC == 9.0.2 , GHC == 9.2.8 - , GHC == 9.4.5 - , GHC == 9.6.2 + , GHC == 9.4.8 + , GHC == 9.6.6 + , GHC == 9.8.4 + , GHC == 9.10.1 + , GHC == 9.12.1 flag examples default: True @@ -50,10 +53,7 @@ if !flag(examples) buildable: False main-is: FromJSON.hs - build-depends: - -- TODO: Eventually, we should bump the lower version - -- bounds to >=2 so that we can remove some CPP in FromJSON. - aeson >= 1 && < 2.3, + build-depends: aeson >= 2 && < 2.3, base >= 4.9 && < 5, microlens, microlens-aeson >= 2.5.1, diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/reflection-2.1.8/fast/Data/Reflection.hs new/reflection-2.1.9/fast/Data/Reflection.hs --- old/reflection-2.1.8/fast/Data/Reflection.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/reflection-2.1.9/fast/Data/Reflection.hs 2001-09-09 03:46:40.000000000 +0200 @@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} @@ -6,36 +7,23 @@ {-# LANGUAGE KindSignatures #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PatternGuards #-} +{-# LANGUAGE PolyKinds #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE ScopedTypeVariables #-} -#if __GLASGOW_HASKELL__ >= 706 -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE PolyKinds #-} {-# LANGUAGE TypeOperators #-} -#define USE_TYPE_LITS 1 -#endif #ifdef MIN_VERSION_template_haskell -# if __GLASGOW_HASKELL__ >= 800 -- TH-subset that works with stage1 & unregisterised GHCs {-# LANGUAGE TemplateHaskellQuotes #-} -# else -{-# LANGUAGE TemplateHaskell #-} -# endif #endif {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-cse #-} {-# OPTIONS_GHC -fno-full-laziness #-} {-# OPTIONS_GHC -fno-float-in #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -{-# OPTIONS_GHC -fno-warn-unused-binds #-} - -#ifndef MIN_VERSION_base -#define MIN_VERSION_base(x,y,z) 1 -#endif +{-# OPTIONS_GHC -Wno-orphans #-} +{-# OPTIONS_GHC -Wno-unused-binds #-} ---------------------------------------------------------------------------- -- | @@ -77,10 +65,8 @@ -- * Reflection Reifies(..) , reify -#if __GLASGOW_HASKELL__ >= 708 , reifyNat , reifySymbol -#endif , reifyTypeable -- * Given , Given(..) @@ -115,30 +101,19 @@ #endif import Data.Bits - -#if __GLASGOW_HASKELL__ < 710 -import Data.Foldable -#endif - -import Data.Semigroup as Sem +import Data.Coerce (Coercible, coerce) import Data.Proxy - -#if __GLASGOW_HASKELL__ < 710 -import Data.Traversable -#endif - +import Data.Semigroup as Sem import Data.Typeable import Data.Word import Foreign.Ptr import Foreign.StablePtr -#if (__GLASGOW_HASKELL__ >= 707) || (defined(MIN_VERSION_template_haskell) && USE_TYPE_LITS) import GHC.TypeLits -# if MIN_VERSION_base(4,10,0) +#if MIN_VERSION_base(4,10,0) import qualified Numeric.Natural as Numeric (Natural) -# elif __GLASGOW_HASKELL__ >= 707 +#else import Control.Exception (ArithException(..), throw) -# endif #endif #ifdef __HUGS__ @@ -155,10 +130,6 @@ import Unsafe.Coerce #endif -#if MIN_VERSION_base(4,7,0) -import Data.Coerce (Coercible, coerce) -#endif - #if MIN_VERSION_base(4,18,0) import qualified GHC.TypeNats as TN #endif @@ -190,15 +161,11 @@ reify a k = unsafeCoerce (Magic k :: Magic a r) (const a) Proxy {-# INLINE_UNSAFE_COERCE reify #-} -#if __GLASGOW_HASKELL__ >= 707 instance KnownNat n => Reifies n Integer where reflect = natVal instance KnownSymbol n => Reifies n String where reflect = symbolVal -#endif - -#if __GLASGOW_HASKELL__ >= 708 -------------------------------------------------------------------------------- -- KnownNat @@ -220,29 +187,29 @@ -- 4 reifyNat :: forall r. Integer -> (forall (n :: Nat). KnownNat n => Proxy n -> r) -> r -# if MIN_VERSION_base(4,18,0) +#if MIN_VERSION_base(4,18,0) -- With base-4.18 or later, we can use the API in GHC.TypeNats to define this -- function directly. reifyNat n k = TN.withSomeSNat (fromInteger n :: Numeric.Natural) $ \(sn :: (SNat n)) -> TN.withKnownNat sn $ k (Proxy :: Proxy n) {-# INLINE reifyNat #-} -# else +#else -- On older versions of base, we resort to unsafeCoerce. reifyNat n k = unsafeCoerce (MagicNat k :: MagicNat r) -# if MIN_VERSION_base(4,10,0) +# if MIN_VERSION_base(4,10,0) -- Starting with base-4.10, the internal -- representation of KnownNat changed from Integer -- to Natural, so make sure to perform the same -- conversion before unsafeCoercing. (fromInteger n :: Numeric.Natural) -# else +# else (if n < 0 then throw Underflow else n) -# endif +# endif Proxy {-# INLINE_UNSAFE_COERCE reifyNat #-} newtype MagicNat r = MagicNat (forall (n :: Nat). KnownNat n => Proxy n -> r) -# endif +#endif -------------------------------------------------------------------------------- -- KnownSymbol @@ -260,19 +227,18 @@ -- >>> reifySymbol "hello" reflect -- "hello" reifySymbol :: forall r. String -> (forall (n :: Symbol). KnownSymbol n => Proxy n -> r) -> r -# if MIN_VERSION_base(4,18,0) +#if MIN_VERSION_base(4,18,0) -- With base-4.18 or later, we can use the API in GHC.TypeNats to define this -- function directly. reifySymbol s k = withSomeSSymbol s $ \(ss :: SSymbol s) -> withKnownSymbol ss (k (Proxy :: Proxy s)) {-# INLINE reifySymbol #-} -# else +#else -- On older versions of base, we resort to unsafeCoerce. reifySymbol n k = unsafeCoerce (MagicSymbol k :: MagicSymbol r) n Proxy {-# INLINE_UNSAFE_COERCE reifySymbol #-} -# endif +#endif newtype MagicSymbol r = MagicSymbol (forall (n :: Symbol). KnownSymbol n => Proxy n -> r) -#endif ------------------------------------------------------------------------------ -- Given @@ -344,9 +310,7 @@ -- in the \"Functional Pearl: Implicit Configurations\" paper by Oleg Kiselyov and Chung-Chieh Shan. -- -- @instance Num (Q Exp)@ provided in this package allows writing @$(3)@ --- instead of @$(int 3)@. Sometimes the two will produce the same --- representation (if compiled without the @-DUSE_TYPE_LITS@ preprocessor --- directive). +-- instead of @$(int 3)@. int :: Int -> TypeQ int n = case quotRem n 2 of (0, 0) -> conT ''Z @@ -363,12 +327,6 @@ | n >= 0 = int n | otherwise = error "nat: negative" -#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 704 -instance Show (Q a) where - show _ = "Q" -instance Eq (Q a) where - _ == _ = False -#endif instance Num a => Num (Q a) where (+) = liftM2 (+) (*) = liftM2 (*) @@ -385,29 +343,13 @@ -- | This permits the use of $(5) as a type splice. instance Num Type where -#ifdef USE_TYPE_LITS LitT (NumTyLit a) + LitT (NumTyLit b) = LitT (NumTyLit (a+b)) a + b = AppT (AppT (VarT ''(+)) a) b LitT (NumTyLit a) * LitT (NumTyLit b) = LitT (NumTyLit (a*b)) (*) a b = AppT (AppT (VarT ''(GHC.TypeLits.*)) a) b -#if MIN_VERSION_base(4,8,0) a - b = AppT (AppT (VarT ''(-)) a) b -#else - (-) = error "Type.(-): undefined" -#endif fromInteger = LitT . NumTyLit -#else - (+) = error "Type.(+): undefined" - (*) = error "Type.(*): undefined" - (-) = error "Type.(-): undefined" - fromInteger n = case quotRem n 2 of - (0, 0) -> ConT ''Z - (q,-1) -> ConT ''PD `AppT` fromInteger q - (q, 0) -> ConT ''D `AppT` fromInteger q - (q, 1) -> ConT ''SD `AppT` fromInteger q - _ -> error "ghc is bad at math" -#endif abs = error "Type.abs" signum = error "Type.signum" @@ -442,27 +384,12 @@ signum = onProxyType1 signum fromInteger n = ConE 'Proxy `SigE` (ConT ''Proxy `AppT` fromInteger n) -#ifdef USE_TYPE_LITS addProxy :: Proxy a -> Proxy b -> Proxy (a + b) addProxy _ _ = Proxy mulProxy :: Proxy a -> Proxy b -> Proxy (a * b) mulProxy _ _ = Proxy -#if MIN_VERSION_base(4,8,0) subProxy :: Proxy a -> Proxy b -> Proxy (a - b) subProxy _ _ = Proxy -#else -subProxy :: Proxy a -> Proxy b -> Proxy c -subProxy _ _ = error "Exp.(-): undefined" -#endif --- fromInteger = LitT . NumTyLit -#else -addProxy :: Proxy a -> Proxy b -> Proxy c -addProxy _ _ = error "Exp.(+): undefined" -mulProxy :: Proxy a -> Proxy b -> Proxy c -mulProxy _ _ = error "Exp.(*): undefined" -subProxy :: Proxy a -> Proxy b -> Proxy c -subProxy _ _ = error "Exp.(-): undefined" -#endif #endif @@ -504,7 +431,7 @@ GO(T253,253) GO(T254,254) GO(T255,255) #define GO(Tn,n) \ - newtype Tn = Tn Tn deriving Typeable; \ + newtype Tn = Tn Tn; \ instance B Tn where { \ reflectByte _ = n \ }; @@ -522,9 +449,9 @@ _ -> impossible } -newtype W (b0 :: *) (b1 :: *) (b2 :: *) (b3 :: *) = W (W b0 b1 b2 b3) deriving Typeable -newtype StableBox (w0 :: *) (w1 :: *) (a :: *) = StableBox (StableBox w0 w1 a) deriving Typeable -newtype Stable (w0 :: *) (w1 :: *) (a :: *) = Stable (Stable w0 w1 a) deriving Typeable +newtype W (b0 :: *) (b1 :: *) (b2 :: *) (b3 :: *) = W (W b0 b1 b2 b3) +newtype StableBox (w0 :: *) (w1 :: *) (a :: *) = StableBox (StableBox w0 w1 a) +newtype Stable (w0 :: *) (w1 :: *) (a :: *) = Stable (Stable w0 w1 a) data Box a = Box a @@ -610,11 +537,7 @@ -- -- This can be necessary to work around the changes to @Data.Typeable@ in GHC HEAD. reifyTypeable :: Typeable a => a -> (forall (s :: *). (Typeable s, Reifies s a) => Proxy s -> r) -> r -#if MIN_VERSION_base(4,4,0) reifyTypeable a k = unsafeDupablePerformIO $ do -#else -reifyTypeable a k = unsafePerformIO $ do -#endif p <- newStablePtr (Box a) let n = stablePtrToIntPtr p reifyByte (fromIntegral n) (\s0 -> @@ -650,7 +573,7 @@ reifyMonoid f z m xs = reify (ReifiedMonoid f z) (unreflectedMonoid (m xs)) -- | Fold a value using its 'Foldable' instance using --- explicitly provided 'Monoid' operations. This is like 'fold' +-- explicitly provided 'Monoid' operations. This is like 'Data.Foldable.fold' -- where the 'Monoid' instance can be manually specified. -- -- @ @@ -707,10 +630,5 @@ sequenceBy :: Traversable t => (forall x. x -> f x) -> (forall x y. f (x -> y) -> f x -> f y) -> t (f a) -> f (t a) sequenceBy pur app = reifyApplicative pur app (traverse ReflectedApplicative) -#if MIN_VERSION_base(4,7,0) (#.) :: Coercible c b => (b -> c) -> (a -> b) -> (a -> c) (#.) _ = coerce (\x -> x :: b) :: forall a b. Coercible b a => a -> b -#else -(#.) :: (b -> c) -> (a -> b) -> a -> c -(#.) _ = unsafeCoerce -#endif diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/reflection-2.1.8/reflection.cabal new/reflection-2.1.9/reflection.cabal --- old/reflection-2.1.8/reflection.cabal 2001-09-09 03:46:40.000000000 +0200 +++ new/reflection-2.1.9/reflection.cabal 2001-09-09 03:46:40.000000000 +0200 @@ -1,5 +1,5 @@ name: reflection -version: 2.1.8 +version: 2.1.9 license: BSD3 license-file: LICENSE author: Edward A. Kmett, Elliott Hird, Oleg Kiselyov and Chung-chieh Shan @@ -31,13 +31,7 @@ approach taken by this library, along with more motivating examples. . * Arnaud Spiwack's tutorial <https://www.tweag.io/posts/2017-12-21-reflection-tutorial.html All about reflection> explains how to use this library. -tested-with: GHC == 7.0.4 - , GHC == 7.2.2 - , GHC == 7.4.2 - , GHC == 7.6.3 - , GHC == 7.8.4 - , GHC == 7.10.3 - , GHC == 8.0.2 +tested-with: GHC == 8.0.2 , GHC == 8.2.2 , GHC == 8.4.4 , GHC == 8.6.5 @@ -45,8 +39,11 @@ , GHC == 8.10.7 , GHC == 9.0.2 , GHC == 9.2.8 - , GHC == 9.4.5 - , GHC == 9.6.2 + , GHC == 9.4.8 + , GHC == 9.6.6 + , GHC == 9.8.4 + , GHC == 9.10.1 + , GHC == 9.12.1 extra-source-files: .hlint.yaml @@ -81,27 +78,15 @@ if impl(ghc >= 8.6) ghc-options: -Wno-star-is-type - if impl(ghc >= 7.2) - default-extensions: Trustworthy + default-extensions: Trustworthy build-depends: - base >= 2 && < 5 - - if impl(ghc < 7.8) - build-depends: - tagged >= 0.4.4 && < 1 - - if !impl(ghc >= 8.0) - build-depends: - semigroups >= 0.11 && < 0.21 + base >= 4.9 && < 5 default-language: Haskell98 if flag(template-haskell) && impl(ghc) - if !impl(ghc >= 8.0) - other-extensions: TemplateHaskell - -- else - -- other-extensions: TemplateHaskellQuotes -- Hackage doesn't know this extension yet + -- other-extensions: TemplateHaskellQuotes -- Hackage doesn't know this extension yet build-depends: template-haskell if !flag(slow) && (impl(ghc) || impl(hugs)) @@ -128,7 +113,7 @@ default-language: Haskell98 build-tool-depends: hspec-discover:hspec-discover >= 1.8 build-depends: - base >= 2 && < 5, + base >= 4.9 && < 5, containers >= 0.1 && < 0.8, hspec >= 2 && < 3, QuickCheck >= 2 && < 3, diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/reflection-2.1.8/slow/Data/Reflection.hs new/reflection-2.1.9/slow/Data/Reflection.hs --- old/reflection-2.1.8/slow/Data/Reflection.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/reflection-2.1.9/slow/Data/Reflection.hs 2001-09-09 03:46:40.000000000 +0200 @@ -9,7 +9,7 @@ {-# OPTIONS_GHC -fno-cse #-} {-# OPTIONS_GHC -fno-full-laziness #-} {-# OPTIONS_GHC -fno-float-in #-} -{-# OPTIONS_GHC -fno-warn-unused-binds #-} +{-# OPTIONS_GHC -Wno-unused-binds #-} ---------------------------------------------------------------------------- -- | -- Module : Data.Reflection diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/reflection-2.1.8/tests/ReifyNatSpec.hs new/reflection-2.1.9/tests/ReifyNatSpec.hs --- old/reflection-2.1.8/tests/ReifyNatSpec.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/reflection-2.1.9/tests/ReifyNatSpec.hs 2001-09-09 03:46:40.000000000 +0200 @@ -2,20 +2,18 @@ {-# LANGUAGE ScopedTypeVariables #-} module ReifyNatSpec where -#if __GLASGOW_HASKELL__ >= 708 import Data.Reflection import Test.Hspec.QuickCheck import Test.QuickCheck (NonNegative(..)) -# if MIN_VERSION_base(4,10,0) +#if MIN_VERSION_base(4,10,0) import GHC.TypeNats (natVal) import Numeric.Natural (Natural) -# endif +#endif -# if __GLASGOW_HASKELL__ != 900 +#if __GLASGOW_HASKELL__ != 900 import Control.Exception (ArithException(..), evaluate) import Test.QuickCheck (Negative(..)) -# endif #endif import Test.Hspec @@ -25,11 +23,10 @@ spec :: Spec spec = -#if __GLASGOW_HASKELL__ >= 708 describe "reifyNat" $ do prop "reify positive Integers and reflect them back" $ \(NonNegative (i :: Integer)) -> reifyNat i $ \p -> reflect p `shouldBe` i -# if __GLASGOW_HASKELL__ != 900 +#if __GLASGOW_HASKELL__ != 900 -- Inexplicably, this test fails on GHC 9.0 with hspec-2.8.4 or later. -- Moreover, I suspect that undefined behavior is involved in some way, -- as the output of hspec will occasionally be swallowed entirely. I have @@ -38,8 +35,8 @@ prop "should throw an Underflow exception on negative inputs" $ \(Negative (i :: Integer)) -> reifyNat i (evaluate . reflect) `shouldThrow` (== Underflow) -# endif -# if MIN_VERSION_base(4,10,0) +#endif +#if MIN_VERSION_base(4,10,0) it "should reflect very large Naturals correctly" $ do -- #41 let d42, d2_63, d2_64 :: Natural d42 = 42 @@ -50,7 +47,4 @@ reifyNat (toInteger d2_63) $ \p -> natVal p `shouldBe` d2_63 reifyNat (toInteger (d2_64-1)) $ \p -> natVal p `shouldBe` d2_64-1 reifyNat (toInteger d2_64) $ \p -> natVal p `shouldBe` d2_64 -# endif -#else - return () #endif
