Script 'mail_helper' called by obssrc Hello community, here is the log from the commit of package ghc-clock for openSUSE:Factory checked in at 2022-02-11 23:08:40 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-clock (Old) and /work/SRC/openSUSE:Factory/.ghc-clock.new.1956 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-clock" Fri Feb 11 23:08:40 2022 rev:16 rq:953443 version:0.8.3 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-clock/ghc-clock.changes 2021-02-16 22:45:24.962340149 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-clock.new.1956/ghc-clock.changes 2022-02-11 23:10:37.063155639 +0100 @@ -1,0 +2,8 @@ +Wed Feb 9 03:52:14 UTC 2022 - Peter Simons <[email protected]> + +- Update clock to version 0.8.3. + Upstream added a new change log file in this release. With no + previous version to compare against, the automatic updater cannot + reliable determine the relevante entries for this release. + +------------------------------------------------------------------- Old: ---- clock-0.8.2.tar.gz New: ---- clock-0.8.3.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-clock.spec ++++++ --- /var/tmp/diff_new_pack.RWJlNw/_old 2022-02-11 23:10:37.467156808 +0100 +++ /var/tmp/diff_new_pack.RWJlNw/_new 2022-02-11 23:10:37.471156819 +0100 @@ -1,7 +1,7 @@ # # spec file for package ghc-clock # -# Copyright (c) 2021 SUSE LLC +# Copyright (c) 2022 SUSE LLC # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -19,7 +19,7 @@ %global pkg_name clock %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.8.2 +Version: 0.8.3 Release: 0 Summary: High-resolution clock functions: monotonic, realtime, cputime License: BSD-3-Clause @@ -113,5 +113,6 @@ %license LICENSE %files devel -f %{name}-devel.files +%doc CHANGELOG.md %changelog ++++++ clock-0.8.2.tar.gz -> clock-0.8.3.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/clock-0.8.2/CHANGELOG.md new/clock-0.8.3/CHANGELOG.md --- old/clock-0.8.2/CHANGELOG.md 1970-01-01 01:00:00.000000000 +0100 +++ new/clock-0.8.3/CHANGELOG.md 2001-09-09 03:46:40.000000000 +0200 @@ -0,0 +1,7 @@ +# 0.8.3 + +- Dropped support for GHC < 7.8. +- Tested with GHC 7.8 - 9.2. +- TODO: new module `System.Clock.Seconds` +- TODO: new functions +- TODO: other changes diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/clock-0.8.2/System/Clock/Seconds.hs new/clock-0.8.3/System/Clock/Seconds.hs --- old/clock-0.8.2/System/Clock/Seconds.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/clock-0.8.3/System/Clock/Seconds.hs 2001-09-09 03:46:40.000000000 +0200 @@ -0,0 +1,77 @@ +{-# OPTIONS_GHC -fno-warn-type-defaults #-} +module System.Clock.Seconds + ( Clock(..) + , Seconds(..) + , getTime + , getRes + , fromNanoSecs + , toNanoSecs + , diffTimeSpec + ) where + +import Data.Coerce +import Data.Ratio +import Data.Typeable (Typeable) +import Foreign.Storable +import GHC.Generics (Generic) + +import System.Clock(TimeSpec(..), Clock, s2ns, normalize) +import qualified System.Clock as C + +newtype Seconds = Seconds { toTimeSpec :: TimeSpec } + deriving (Generic, Read, Show, Typeable, Eq, Ord, Storable, Bounded) + +instance Num Seconds where + fromInteger n = Seconds $ TimeSpec (fromInteger n) 0 + Seconds (TimeSpec xs xn) * Seconds (TimeSpec ys yn) = + Seconds $ normalize $! TimeSpec (xs*ys) (xs*yn+xn*ys+((xn*yn) `div` s2ns)) + (+) = coerce ((+) :: TimeSpec -> TimeSpec -> TimeSpec) + (-) = coerce ((-) :: TimeSpec -> TimeSpec -> TimeSpec) + negate = coerce (negate :: TimeSpec -> TimeSpec) + abs = coerce (abs :: TimeSpec -> TimeSpec) + signum (Seconds a) = case signum a of + 1 -> 1 + (-1) -> (-1) + _ -> 0 + +instance Enum Seconds where + succ x = x + 1 + pred x = x - 1 + toEnum x = Seconds $ TimeSpec (fromIntegral x) 0 + fromEnum (Seconds (TimeSpec s _)) = fromEnum s + +instance Real Seconds where + toRational (Seconds x) = toInteger x % s2ns + +instance Fractional Seconds where + fromRational x = Seconds . fromInteger $ floor (x * s2ns) + Seconds a / Seconds b = Seconds $ a * s2ns `div` b + recip (Seconds a) = Seconds $ s2ns * s2ns `div` a + +instance RealFrac Seconds where + properFraction (Seconds (TimeSpec s ns)) + | s >= 0 = (fromIntegral s, Seconds $ TimeSpec 0 ns) + | otherwise = (fromIntegral (s+1), Seconds $ TimeSpec (-1) ns) + +-- | The 'getTime' function shall return the current value for the +-- specified clock. +getTime :: Clock -> IO Seconds +getTime = coerce C.getTime + +-- | The 'getRes' function shall return the resolution of any clock. +-- Clock resolutions are implementation-defined and cannot be set +-- by a process. +getRes :: Clock -> IO Seconds +getRes = coerce C.getRes + +-- | Seconds from nano seconds. +fromNanoSecs :: Integer -> Seconds +fromNanoSecs = coerce C.fromNanoSecs + +-- | Seconds to nano seconds. +toNanoSecs :: Seconds -> Integer +toNanoSecs = coerce C.toNanoSecs + +-- | Compute the absolute difference. +diffTimeSpec :: Seconds -> Seconds -> Seconds +diffTimeSpec = coerce C.diffTimeSpec diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/clock-0.8.2/System/Clock.hsc new/clock-0.8.3/System/Clock.hsc --- old/clock-0.8.2/System/Clock.hsc 2001-09-09 03:46:40.000000000 +0200 +++ new/clock-0.8.3/System/Clock.hsc 2001-09-09 03:46:40.000000000 +0200 @@ -17,11 +17,14 @@ , toNanoSecs , diffTimeSpec , timeSpecAsNanoSecs + , normalize + , s2ns ) where import Control.Applicative ((<$>), (<*>)) import Data.Int import Data.Word +import Data.Ratio import Data.Typeable (Typeable) import Foreign.C import Foreign.Ptr @@ -44,7 +47,7 @@ -- | Clock types. A clock may be system-wide (that is, visible to all processes) -- or per-process (measuring time that is meaningful only within a process). --- All implementations shall support 'Realtime'. +-- All implementations shall support 'Realtime'. data Clock -- | The identifier for the system-wide monotonic clock, which is defined as @@ -227,21 +230,34 @@ instance Num TimeSpec where (TimeSpec xs xn) + (TimeSpec ys yn) = normalize $! TimeSpec (xs + ys) (xn + yn) (TimeSpec xs xn) - (TimeSpec ys yn) = normalize $! TimeSpec (xs - ys) (xn - yn) - (TimeSpec xs xn) * (TimeSpec ys yn) = normalize $! TimeSpec (xsi_ysi) (xni_yni) - where xsi_ysi = fromInteger $! xsi*ysi - xni_yni = fromInteger $! (xni*yni + (xni*ysi + xsi*yni) * s2ns) `div` s2ns - xsi = toInteger xs - ysi = toInteger ys - xni = toInteger xn - yni = toInteger yn - + (normalize -> TimeSpec xs xn) * (normalize -> TimeSpec ys yn) = normalize $! TimeSpec (s2ns*xs*ys+xs*yn+xn*ys) (xn*yn) negate (TimeSpec xs xn) = normalize $! TimeSpec (negate xs) (negate xn) abs (normalize -> TimeSpec xs xn) | xs == 0 = normalize $! TimeSpec 0 xn | otherwise = normalize $! TimeSpec (abs xs) (signum xs * xn) - signum (normalize -> TimeSpec xs xn) | xs == 0 = TimeSpec (signum xn) 0 - | otherwise = TimeSpec (signum xs) 0 + signum (normalize -> TimeSpec xs xn) | xs == 0 = TimeSpec 0 (signum xn) + | otherwise = TimeSpec 0 (signum xs) fromInteger x = TimeSpec (fromInteger q) (fromInteger r) where (q, r) = x `divMod` s2ns +instance Enum TimeSpec where + succ x = x + 1 + pred x = x - 1 + toEnum x = normalize $ TimeSpec 0 (fromIntegral x) + fromEnum = fromEnum . toInteger + +instance Real TimeSpec where + toRational x = toInteger x % 1 + +instance Integral TimeSpec where + toInteger = toNanoSecs + quot (toInteger-> t1) (toInteger-> t2) = fromInteger $! quot t1 t2 + rem (toInteger-> t1) (toInteger-> t2) = fromInteger $! rem t1 t2 + div (toInteger-> t1) (toInteger-> t2) = fromInteger $! div t1 t2 + mod (toInteger-> t1) (toInteger-> t2) = fromInteger $! mod t1 t2 + divMod (toInteger-> t1) (toInteger-> t2) = + let (q,r)=divMod t1 t2 in (fromInteger $! q, fromInteger $! r) + quotRem (toInteger-> t1) (toInteger-> t2) = + let (q,r)=quotRem t1 t2 in (fromInteger $! q, fromInteger $! r) + instance Eq TimeSpec where (normalize -> TimeSpec xs xn) == (normalize -> TimeSpec ys yn) | True == es = xn == yn | otherwise = es @@ -252,6 +268,10 @@ | otherwise = os where os = compare xs ys +instance Bounded TimeSpec where + minBound = TimeSpec minBound 0 + maxBound = TimeSpec maxBound (s2ns-1) + -- | TimeSpec from nano seconds. fromNanoSecs :: Integer -> TimeSpec fromNanoSecs x = TimeSpec (fromInteger q) (fromInteger r) where (q, r) = x `divMod` s2ns diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/clock-0.8.2/clock.cabal new/clock-0.8.3/clock.cabal --- old/clock-0.8.2/clock.cabal 2001-09-09 03:46:40.000000000 +0200 +++ new/clock-0.8.3/clock.cabal 2001-09-09 03:46:40.000000000 +0200 @@ -1,6 +1,6 @@ cabal-version: >= 1.10 name: clock -version: 0.8.2 +version: 0.8.3 stability: stable synopsis: High-resolution clock functions: monotonic, realtime, cputime. description: A package for convenient access to high-resolution clock and @@ -52,7 +52,21 @@ bug-reports: https://github.com/corsis/clock/issues category: System build-type: Simple -tested-with: GHC==8.10.3, GHC==8.8.4, GHC==8.6.5 + +tested-with: + GHC == 9.2.1 + GHC == 9.0.2 + GHC == 8.10.7 + GHC == 8.8.4 + GHC == 8.6.5 + GHC == 8.4.4 + GHC == 8.2.2 + GHC == 8.0.2 + GHC == 7.10.3 + GHC == 7.8.4 + +extra-source-files: + CHANGELOG.md source-repository head @@ -66,16 +80,18 @@ library - default-language: Haskell2010 - if impl (ghc < 7.6) - build-depends: base >= 4.4 && <= 5, ghc-prim - build-depends: base >= 2 && <= 5 + build-depends: base >= 4.7 && < 5 + exposed-modules: System.Clock - default-extensions: DeriveGeneric + System.Clock.Seconds + + default-language: Haskell2010 + default-extensions: DeriveGeneric DeriveDataTypeable ForeignFunctionInterface ScopedTypeVariables ViewPatterns + GeneralizedNewtypeDeriving if os(windows) c-sources: cbits/hs_clock_win32.c include-dirs: cbits @@ -86,7 +102,10 @@ test-suite test - default-language: Haskell2010 + default-language: Haskell2010 + default-extensions: ScopedTypeVariables + GeneralizedNewtypeDeriving + StandaloneDeriving type: exitcode-stdio-1.0 hs-source-dirs: @@ -94,7 +113,7 @@ main-is: test.hs build-depends: - base >= 4 && < 5 + base , tasty >= 0.10 , tasty-quickcheck , clock @@ -108,6 +127,6 @@ main-is: benchmarks.hs build-depends: - base >= 4 && < 5 + base , criterion , clock diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/clock-0.8.2/tests/test.hs new/clock-0.8.3/tests/test.hs --- old/clock-0.8.2/tests/test.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/clock-0.8.3/tests/test.hs 2001-09-09 03:46:40.000000000 +0200 @@ -4,6 +4,7 @@ import Data.List -- import Test.Tasty.HUnit as HUnit import System.Clock +import System.Clock.Seconds as S instance Arbitrary TimeSpec where arbitrary = do @@ -11,28 +12,98 @@ nan <- arbitrarySizedIntegral return $ TimeSpec sec nan -main = defaultMain (adjustOption (QuickCheckTests 100000 +) $ tests) +deriving instance Arbitrary Seconds + +main = defaultMain (localOption (QuickCheckTests 100000) $ tests) tests :: TestTree -tests = testGroup "All tests" [numInstanceTests, ordInstanceTests] +tests = testGroup "All tests" [timeSpecTests, secondsTests] + +timeSpecTests = testGroup "TimeSpec tests" [qcNumInstance (0 :: TimeSpec), qcRealInstance (0 :: TimeSpec), qcTimeSpec] +secondsTests = testGroup "Seconds tests" [qcNumInstance (0 :: S.Seconds), qcRealInstance (0 :: S.Seconds), qcSeconds] + +qcNumInstance :: (Eq a, Num a, Arbitrary a, Show a) => a -> TestTree +qcNumInstance (s :: a) = testGroup "Num" + [ + QuickCheck.testProperty "Associativity of (+)" $ \(x :: a) y z -> + (x + y) + z == x + (y + z) + , QuickCheck.testProperty "Commutativity of (+)" $ \(x :: a) y -> + x + y == y + x + , QuickCheck.testProperty "fromInteger 0 is the additive identity" $ \(x :: a) -> + x + fromInteger 0 == x + , QuickCheck.testProperty "negate gives the additive inverse" $ \(x :: a) -> + x + negate x == fromInteger 0 + , QuickCheck.testProperty "fromInteger 1 is the multiplicative identity" $ \(x :: a) -> + x * fromInteger 1 == x && fromInteger 1 * x == x + , QuickCheck.testProperty "neg(neg(x)) = x" $ \(x :: a) -> + negate (negate x) == x + , QuickCheck.testProperty "x = abs(x) * signum(x)" $ \(x :: a) -> + x == (abs x) * (signum x) + ] -numInstanceTests = testGroup "Num instance tests" [qcNumInstance] -ordInstanceTests = testGroup "Ord instance tests" [qcOrdInstance] +qcRealInstance :: (Real a, Arbitrary a, Show a) => a -> TestTree +qcRealInstance (s :: a) = testGroup "Real" + [ + QuickCheck.testProperty "integer addition is correct" $ \ x y -> + toRational (x + y) == toRational (fromInteger x + fromInteger y :: a) + , QuickCheck.testProperty "integer subtraction is correct" $ \ x y -> + toRational (x - y) == toRational (fromInteger x - fromInteger y :: a) + , QuickCheck.testProperty "integer multiplication is correct" $ \ x y -> + toRational (x * y) == toRational (fromInteger x * fromInteger y :: a) + , QuickCheck.testProperty "random list of TimeSpecs is sorted like equivalent list of rationals" $ \(x :: [a]) -> + map toRational (sort x) == sort (map toRational x) + ] -qcNumInstance = testGroup "QuickCheck" - [ - QuickCheck.testProperty "x = abs(x) * signum(x)" $ \ x -> (x :: TimeSpec) == (abs x) * (signum x) - , QuickCheck.testProperty "integer addition equals TimeSpec addition" $ \ x y -> x + y == toNanoSecs (fromInteger x + fromInteger y) - , QuickCheck.testProperty "integer subtraction equals TimeSpec subtracttion" $ \ x y -> x - y == toNanoSecs (fromInteger x - fromInteger y) - , QuickCheck.testProperty "rational multiplication equals TimeSpec multiplication" $ - \ x y -> - let rationalMul = truncate ((x :: Nano) * (y :: Nano) * (10^9)) - timespecMul = toNanoSecs (fromInteger (truncate (x * 10^9)) * fromInteger (truncate (y * 10^9))) - in rationalMul == timespecMul - , QuickCheck.testProperty "neg(neg(x)) = x" $ \ x -> negate (negate x :: TimeSpec) == x +qcTimeSpec :: TestTree +qcTimeSpec = testGroup "TimeSpec-specific" + [ + -- fails with Seconds on 0.000000001 * -1.000000002 * -2.000000001 + QuickCheck.testProperty "Associativity of (*)" $ \(x :: TimeSpec) y z -> + (x * y) * z == x * (y * z) + -- fails with Seconds on [-0.999999999,0.000000001,-1.000000001] + , QuickCheck.testProperty "Distributivity of (*) with respect to (+)" $ \(a :: TimeSpec) b c -> + a * (b + c) == (a * b) + (a * c) && (b + c) * a == (b * a) + (c * a) + , QuickCheck.testProperty "TimeSpec Quot-rem division equality" $ \(x :: TimeSpec) y -> + y == 0 || x == y * quot x y + rem x y + , QuickCheck.testProperty "TimeSpec Rem is within bounds" $ \(x :: TimeSpec) y -> + let r = rem x y in y == 0 || r == fromInteger 0 || abs r < abs y + , QuickCheck.testProperty "TimeSpec quotRem agrees with quot and rem" $ \(x :: TimeSpec) y -> + let (q,r) = quotRem x y in + y == 0 || (q == quot x y && r == rem x y) + , QuickCheck.testProperty "TimeSpec Div-mod division equality" $ \(x :: TimeSpec) y -> + y == 0 || x == y * div x y + mod x y + , QuickCheck.testProperty "TimeSpec Mod is within bounds" $ \(x :: TimeSpec) y -> + let r = mod x y in y == 0 || (r == fromInteger 0 || abs r < abs y) + , QuickCheck.testProperty "TimeSpec divMod agrees with div and mod" $ \(x :: TimeSpec) y -> + let (q,r) = divMod x y in + y == 0 || (q == div x y && r == mod x y) + , QuickCheck.testProperty "TimeSpec toInteger . fromInteger is the identity" $ \x -> + x == toInteger (fromInteger x :: TimeSpec) + , QuickCheck.testProperty "TimeSpec fromInteger . toInteger is the identity" $ \(x :: TimeSpec) -> + x == fromInteger (toInteger x) + , QuickCheck.testProperty "TimeSpec division agrees with Integer" $ \(x :: TimeSpec) y -> + y == 0 || toInteger (x `div` y) == toInteger x `div` toInteger y + , QuickCheck.testProperty "TimeSpec quot agrees with Integer" $ \(x :: TimeSpec) y -> + y == 0 || toInteger (x `quot` y) == toInteger x `quot` toInteger y ] -qcOrdInstance = testGroup "QuickCheck" +qcSeconds :: TestTree +qcSeconds = testGroup "Seconds-specific" [ - QuickCheck.testProperty "random list of TimeSpecs is sorted like equivalent list of integers" $ \ x -> sort (x :: [TimeSpec]) == map (fromInteger) (sort (map toNanoSecs x)) + QuickCheck.testProperty "Seconds multiplication is Nano multiplication" $ \x y -> + let nano = toRational $ (x :: Nano) * (y :: Nano) + seconds = toRational $ (realToFrac x) * (realToFrac y :: Seconds) + in nano == seconds + , QuickCheck.testProperty "Seconds truncate is Nano truncate" $ \(x :: Nano) -> + let nano = truncate x :: Integer + seconds = truncate (realToFrac x :: Seconds) + in nano == seconds + , QuickCheck.testProperty "Seconds / is Nano /" $ \(x :: Nano) (y :: Nano) -> + let nano = toRational $ x / y + seconds = toRational (realToFrac x / realToFrac y :: Seconds) + in y == 0 || nano == seconds + , QuickCheck.testProperty "Seconds recip is Nano recip" $ \(x :: Nano) -> + let nano = toRational $ recip x + seconds = toRational (recip $ realToFrac x :: Seconds) + in x == 0 || nano == seconds ]
