Sven Tennie pushed to branch wip/supersven/fix-foundation-test-shift-amounts at Glasgow Haskell Compiler / GHC

Commits:

1 changed file:

Changes:

  • testsuite/tests/numeric/should_run/foundation.hs
    ... ... @@ -133,51 +133,34 @@ newtype NonZero a = NonZero { getNonZero :: a }
    133 133
     instance (Arbitrary a, Num a, Eq a) => Arbitrary (NonZero a) where
    
    134 134
       arbitrary = nonZero
    
    135 135
     
    
    136
    --- | A newtype for shift amounts that are bounded by word size
    
    137
    -newtype BoundedShift a = BoundedShift { getBoundedShift :: Int }
    
    138
    -  deriving (Eq,Ord,Show)
    
    136
    +-- | A newtype for shift amounts that are bounded by @word_size - 1@
    
    137
    +newtype BoundedShift a = BoundedShift {getBoundedShift :: Int}
    
    138
    +  deriving (Eq, Ord, Show)
    
    139 139
     
    
    140
    --- | Generate shift amounts bounded by the word size for each type
    
    141
    -boundedShift8 :: Gen (BoundedShift Int8)
    
    142
    -boundedShift8 = do
    
    143
    -  x <- arbitrary
    
    144
    -  return $ BoundedShift (abs x `mod` 8)
    
    145
    -
    
    146
    -boundedShift16 :: Gen (BoundedShift Int16)
    
    147
    -boundedShift16 = do
    
    148
    -  x <- arbitrary
    
    149
    -  return $ BoundedShift (abs x `mod` 16)
    
    150
    -
    
    151
    -boundedShift32 :: Gen (BoundedShift Int32)
    
    152
    -boundedShift32 = do
    
    153
    -  x <- arbitrary
    
    154
    -  return $ BoundedShift (abs x `mod` 32)
    
    155
    -
    
    156
    -boundedShift64 :: Gen (BoundedShift Int64)
    
    157
    -boundedShift64 = do
    
    158
    -  x <- arbitrary
    
    159
    -  return $ BoundedShift (abs x `mod` 64)
    
    160
    -
    
    161
    -boundedShiftWord :: Gen (BoundedShift Int)
    
    162
    -boundedShiftWord = do
    
    163
    -  x <- arbitrary
    
    164
    -  return $ BoundedShift (abs x `mod` finiteBitSize (undefined :: Word))
    
    165
    -
    
    166
    --- Arbitrary instances for BoundedShift types to work with lambda patterns
    
    167 140
     instance Arbitrary (BoundedShift Int8) where
    
    168
    -  arbitrary = boundedShift8
    
    141
    +  arbitrary = do
    
    142
    +    x <- arbitrary
    
    143
    +    return $ BoundedShift (abs x `mod` 8)
    
    169 144
     
    
    170 145
     instance Arbitrary (BoundedShift Int16) where
    
    171
    -  arbitrary = boundedShift16
    
    146
    +  arbitrary = do
    
    147
    +    x <- arbitrary
    
    148
    +    return $ BoundedShift (abs x `mod` 8)
    
    172 149
     
    
    173 150
     instance Arbitrary (BoundedShift Int32) where
    
    174
    -  arbitrary = boundedShift32
    
    151
    +  arbitrary = do
    
    152
    +    x <- arbitrary
    
    153
    +    return $ BoundedShift (abs x `mod` 8)
    
    175 154
     
    
    176 155
     instance Arbitrary (BoundedShift Int64) where
    
    177
    -  arbitrary = boundedShift64
    
    156
    +  arbitrary = do
    
    157
    +    x <- arbitrary
    
    158
    +    return $ BoundedShift (abs x `mod` 8)
    
    178 159
     
    
    179 160
     instance Arbitrary (BoundedShift Int) where
    
    180
    -  arbitrary = boundedShiftWord
    
    161
    +  arbitrary = do
    
    162
    +    x <- arbitrary
    
    163
    +    return $ BoundedShift (abs x `mod` finiteBitSize (undefined :: Word))
    
    181 164
     
    
    182 165
     instance Arbitrary Natural where
    
    183 166
         arbitrary = integralDownsize . (`mod` 10000) . abs <$> arbitraryInt64