diff options
Diffstat (limited to 'testsuite/tests/lib/integer')
| -rw-r--r-- | testsuite/tests/lib/integer/Makefile | 50 | ||||
| -rw-r--r-- | testsuite/tests/lib/integer/all.T | 1 | ||||
| -rw-r--r-- | testsuite/tests/lib/integer/naturalConstantFolding.hs | 172 | ||||
| -rw-r--r-- | testsuite/tests/lib/integer/naturalConstantFolding.stdout | 38 |
4 files changed, 258 insertions, 3 deletions
diff --git a/testsuite/tests/lib/integer/Makefile b/testsuite/tests/lib/integer/Makefile index aa2704ab6d..4292a1b970 100644 --- a/testsuite/tests/lib/integer/Makefile +++ b/testsuite/tests/lib/integer/Makefile @@ -2,14 +2,18 @@ TOP=../../.. include $(TOP)/mk/boilerplate.mk include $(TOP)/mk/test.mk -CHECK = grep -q -- '$1' integerConstantFolding.simpl || \ +CHECK = grep -q -- '$1' folding.simpl || \ echo "$2 didn't constant fold" +CHECK2 = grep -q -- '$1' folding.simpl || \ + grep -q -- '$2' folding.simpl || \ + echo "$3 didn't constant fold" + .PHONY: integerConstantFolding integerConstantFolding: - '$(TEST_HC)' -Wall -v0 -O --make integerConstantFolding -fforce-recomp -ddump-simpl > integerConstantFolding.simpl + '$(TEST_HC)' -Wall -v0 -O --make integerConstantFolding -fforce-recomp -ddump-simpl > folding.simpl # All the 100nnn values should be constant-folded away - ! grep -q '\<100[0-9][0-9][0-9]\>' integerConstantFolding.simpl || { echo "Unfolded values found"; grep '\<100[0-9][0-9][0-9]\>' integerConstantFolding.simpl; } + ! grep -q '\<100[0-9][0-9][0-9]\>' folding.simpl || { echo "Unfolded values found"; grep '\<100[0-9][0-9][0-9]\>' folding.simpl; } $(call CHECK,\<200007\>,plusInteger) $(call CHECK,\<683234160\>,timesInteger) $(call CHECK,-991\>,minusIntegerN) @@ -58,3 +62,43 @@ IntegerConversionRules: -grep -q integerToWord $@.simpl && echo "integerToWord present" -grep -q int2Word $@.simpl || echo "int2Word absent" +.PHONY: naturalConstantFolding +naturalConstantFolding: + '$(TEST_HC)' -Wall -v0 -O --make naturalConstantFolding -fforce-recomp -ddump-simpl > folding.simpl +# All the 100nnn values should be constant-folded away + ! grep -q '\<100[0-9][0-9][0-9]\>' folding.simpl || { echo "Unfolded values found"; grep '\<100[0-9][0-9][0-9]\>' folding.simpl; } + # Bit arithmetic + $(call CHECK,\<532\>,andNatural) + $(call CHECK,\<239055\>,xorNatural) + $(call CHECK,\<16\>,bitNatural) + $(call CHECK,\<239579\>,orNatural) + $(call CHECK,\<1601040\>,shiftLNatural) + $(call CHECK,\<6254\>,shiftRNatural) + $(call CHECK,\<6\>,popCountNatural) + # Arithmetic + $(call CHECK,\<200121\>,plusNatural) + $(call CHECK,\<683678240\>,timesNatural) + $(call CHECK,\<989\>,minusNatural) + $(call CHECK,\<0\>,negateNatural) + $(call CHECK,\<1\>,signumNaturalP) + $(call CHECK,\<0\>,signumNaturalZ) + # Quotients and remainders + $(call CHECK2,\<813\>,\<60\>,quotRemNatural) + $(call CHECK2,\<219\>,\<196\>,divModNatural) + $(call CHECK,\<641\>,quotNatural) + $(call CHECK,\<68\>,remNatural) + $(call CHECK,\<642\>,divNatural) + $(call CHECK,\<90\>,modNatural) + $(call CHECK,\<50024\>,gcdNatural) + $(call CHECK,\<1001100300\>,lcmNatural) + # Conversions + $(call CHECK,\<200109\>,naturalFromInteger) + $(call CHECK,\<200113\>,naturalToInteger) + $(call CHECK,\<200145\>,wordToNatural) + $(call CHECK,\<200149\>,naturalToWord) + $(call CHECK,\<200153\>,intToNatural) + $(call CHECK,\<200157\>,naturalToInt) + $(call CHECK,\<200189.0\>,doubleFromNatural) + $(call CHECK,\<200193.0\>,floatFromNatural) + # Ordering and Equality + ./naturalConstantFolding diff --git a/testsuite/tests/lib/integer/all.T b/testsuite/tests/lib/integer/all.T index f279be2f81..c132ca24dd 100644 --- a/testsuite/tests/lib/integer/all.T +++ b/testsuite/tests/lib/integer/all.T @@ -3,6 +3,7 @@ test('integerBits', normal, compile_and_run, ['']) test('integerConversions', normal, compile_and_run, ['']) test('plusMinusInteger', [omit_ways(['ghci'])], compile_and_run, ['']) test('integerConstantFolding', normal, makefile_test, ['integerConstantFolding']) +test('naturalConstantFolding', normal, makefile_test, ['naturalConstantFolding']) test('fromToInteger', [], makefile_test, ['fromToInteger']) test('IntegerConversionRules', [], makefile_test, ['IntegerConversionRules']) test('gcdInteger', normal, compile_and_run, ['']) diff --git a/testsuite/tests/lib/integer/naturalConstantFolding.hs b/testsuite/tests/lib/integer/naturalConstantFolding.hs new file mode 100644 index 0000000000..9469d44bf6 --- /dev/null +++ b/testsuite/tests/lib/integer/naturalConstantFolding.hs @@ -0,0 +1,172 @@ +module Main (main) where + +import Data.Bits +import Numeric.Natural (Natural) + +main :: IO () +main = do + p "andNatural" andNatural + p "bitNatural" bitNatural + p "minusNatural" minusNatural + p "naturalFromInteger" naturalFromInteger + p "naturalToInteger" naturalToInteger + p "negateNatural" negateNatural + p "orNatural" orNatural + p "plusNatural" plusNatural + p "popCountNatural" popCountNatural + p "divModNatural" divModNatural + p "divNatural" divNatural + p "modNatural" modNatural + p "quotNatural" quotNatural + p "quotRemNatural" quotRemNatural + p "remNatural" remNatural + p "gcdNatural" gcdNatural + p "lcmNatural" lcmNatural + p "shiftLNatural" shiftLNatural + p "shiftRNatural" shiftRNatural + p "signumNaturalP" signumNaturalP + p "signumNaturalZ" signumNaturalZ + p "testBitNaturalT" testBitNaturalT + p "testBitNaturalF" testBitNaturalF + p "timesNatural" timesNatural + p "wordToNatural" wordToNatural + p "naturalToWord" naturalToWord + p "intToNatural" intToNatural + p "naturalToInt" naturalToInt + p "doubleFromNatural" doubleFromNatural + p "floatFromNatural" floatFromNatural + p "xorNatural" xorNatural + p "eqNatural" eqNatural + p "neqNatural" neqNatural + p "leNatural" leNatural + p "ltNatural" ltNatural + p "geNatural" geNatural + p "gtNatural" gtNatural + p "compareNatural" compareNatural + + where p :: Show a => String -> a -> IO () + p str x = putStrLn (str ++ ": " ++ show x) + +-- Bit arithmetic +andNatural :: Natural +andNatural = 100052 .&. 140053 + +xorNatural :: Natural +xorNatural = 100071 `xor` 140072 + +bitNatural :: Natural +bitNatural = bit 4 + +orNatural :: Natural +orNatural = 100058 .|. 140059 + +shiftLNatural :: Natural +shiftLNatural = 100065 `shiftL` 4 + +shiftRNatural :: Natural +shiftRNatural = 100066 `shiftR` 4 + +popCountNatural :: Int +popCountNatural = popCount (100098 :: Natural) + +testBitNaturalT :: Bool +testBitNaturalT = testBit (100068 :: Natural) 2 + +testBitNaturalF :: Bool +testBitNaturalF = testBit (100069 :: Natural) 1 +----------------------------------------------- + +-- Arithmetic +plusNatural :: Natural +plusNatural = 100060 + 100061 + +timesNatural :: Natural +timesNatural = 100070 * 6832 + +minusNatural :: Natural +minusNatural = 100999 - 100010 + +negateNatural :: Natural +negateNatural = negate 0 + +signumNaturalP :: Natural +signumNaturalP = signum 100067 + +signumNaturalZ :: Natural +signumNaturalZ = signum 0 +------------------------ + +-- Quotients and remainders +quotRemNatural :: (Natural, Natural) +quotRemNatural = 100063 `quotRem` 123 + +divModNatural :: (Natural, Natural) +divModNatural = 100060 `divMod` 456 + +quotNatural :: Natural +quotNatural = 100062 `quot` 156 + +remNatural :: Natural +remNatural = 100064 `rem` 156 + +divNatural :: Natural +divNatural = 100286 `div` 156 + +modNatural :: Natural +modNatural = 100086 `mod` 156 + +gcdNatural :: Natural +gcdNatural = 100048 `gcd` 150072 + +lcmNatural :: Natural +lcmNatural = 100050 `lcm` 100060 +-------------------------------- + +-- Conversions +naturalFromInteger :: Natural +naturalFromInteger = fromInteger 100054 + 100055 + +naturalToInteger :: Integer +naturalToInteger = toInteger (100056 :: Natural) + 100057 + +-- Same story as the @Integer@ case: for the conversion functions, we can't +-- just check that e.g. 100065 is in the resulting core, because it will be +-- regardless of whether the rules fire or not. So we add something to the +-- number being converted, and thus rely on the addition rule for the +-- end-result type also firing. +wordToNatural :: Natural +wordToNatural = fromIntegral (100072 :: Word) + 100073 + +naturalToWord :: Word +naturalToWord = 100075 + fromIntegral (100074 :: Natural) + +intToNatural :: Natural +intToNatural = fromIntegral (100076 :: Int) + 100077 + +naturalToInt :: Int +naturalToInt = fromIntegral (100078 :: Natural) + 100079 + +doubleFromNatural :: Double +doubleFromNatural = 100095.0 + realToFrac (100094 :: Natural) + +floatFromNatural :: Float +floatFromNatural = 100097.0 + realToFrac (100096 :: Natural) + +--------------------------------------------------- + +-- Ordering and Equality +eqNatural, neqNatural, leNatural, ltNatural, geNatural, gtNatural :: Bool +eqNatural = (100080 :: Natural) == 100081 + +neqNatural = (100082 :: Natural) /= 100083 + +leNatural = (100084 :: Natural) <= 100085 + +ltNatural = (100086 :: Natural) < 100087 + +geNatural = (100088 :: Natural) >= 100089 + +gtNatural = (100090 :: Natural) > 100091 + +compareNatural :: Ordering +compareNatural = compare (100092 :: Natural) 100093 diff --git a/testsuite/tests/lib/integer/naturalConstantFolding.stdout b/testsuite/tests/lib/integer/naturalConstantFolding.stdout new file mode 100644 index 0000000000..3a8edda426 --- /dev/null +++ b/testsuite/tests/lib/integer/naturalConstantFolding.stdout @@ -0,0 +1,38 @@ +andNatural: 532 +bitNatural: 16 +minusNatural: 989 +naturalFromInteger: 200109 +naturalToInteger: 200113 +negateNatural: 0 +orNatural: 239579 +plusNatural: 200121 +popCountNatural: 6 +divModNatural: (219,196) +divNatural: 642 +modNatural: 90 +quotNatural: 641 +quotRemNatural: (813,64) +remNatural: 68 +gcdNatural: 50024 +lcmNatural: 1001100300 +shiftLNatural: 1601040 +shiftRNatural: 6254 +signumNaturalP: 1 +signumNaturalZ: 0 +testBitNaturalT: True +testBitNaturalF: False +timesNatural: 683678240 +wordToNatural: 200145 +naturalToWord: 200149 +intToNatural: 200153 +naturalToInt: 200157 +doubleFromNatural: 200189.0 +floatFromNatural: 200193.0 +xorNatural: 239055 +eqNatural: False +neqNatural: True +leNatural: True +ltNatural: True +geNatural: False +gtNatural: False +compareNatural: LT |