From 173d52700e53cee9ad90052862bcf7b5bc7dfc45 Mon Sep 17 00:00:00 2001 From: Matt Abdul-Rahim Date: Tue, 10 Jul 2018 12:50:56 +0100 Subject: [PATCH] More rearranging of generators. --- test/Spec/Generators/LexElements.hs | 50 ++++++++++++---------- test/Spec/Parser/Combinators/Lex.hs | 66 +++++++++++++++-------------- 2 files changed, 63 insertions(+), 53 deletions(-) diff --git a/test/Spec/Generators/LexElements.hs b/test/Spec/Generators/LexElements.hs index 29c64c1..4f55931 100644 --- a/test/Spec/Generators/LexElements.hs +++ b/test/Spec/Generators/LexElements.hs @@ -2,7 +2,7 @@ Module : Spec.Generators.LexElements Description : Generators of basic lexical elements of VHDL -} -module Spec.Generators.LexElements +module Spec.Generators.LexElements --( GenPair(..) --, combineGen ( genInteger @@ -15,12 +15,14 @@ module Spec.Generators.LexElements , genCaseInsensitiveWord --, genDelimiter , genComment + , intersperseUnderscores ) where import qualified Test.Tasty.QuickCheck as QC import Control.Monad import Data.Function ((&)) +import Data.Int (Int64) import qualified Data.Map.Strict as MapS import qualified Data.ByteString.Lazy.Char8 as B import Data.Char @@ -66,18 +68,17 @@ import Parser.Types.Token -- 'genInteger' ::= digit { 'genUnderscoreDigit' } -- 'genUnderscoreDigit' ::= [ underline ] digit -- @ -genInteger :: Integer -> Integer -> QC.Gen (ParserExpectedOutput Integer) +genInteger :: Maybe Integer -> Maybe Integer -> QC.Gen (ParserExpectedOutput Integer) genInteger minimum maximum = - let genUnderscore char = QC.arbitrary - <&> \includeUnderscore -> - if includeUnderscore - then ['_',char] - else [char] - addUnderscores (fst:rest) = ([fst]:) <$> mapM genUnderscore rest - addUnderscores [] = return [] - input output = concat <$> (addUnderscores $ show $ output) + let input = (intersperseUnderscores . show) output val = input val <&> \input -> ExpectedOutput input val - in output =<< QC.choose (minimum,maximum) + maxInt64 = toInteger (maxBound :: Int64) + in output =<< QC.choose ( case (minimum,maximum) of + (Just min,Just max) -> (min,max) + (Just min,Nothing) -> (min,maxInt64) + (Nothing,Just max) -> (0,max) + (Nothing,Nothing) -> (0,maxInt64) + ) -- |Generate a VHDL specific exponent -- > exponent ::= E [ + ] integer | E - integer @@ -92,7 +93,7 @@ genExponent :: QC.Gen (ParserExpectedOutput Integer) genExponent = do expChar <- QC.elements "Ee" expSign <- QC.elements ["+","-",""] - (ExpectedOutput expStr expVal) <- genInteger 0 200 + (ExpectedOutput expStr expVal) <- genInteger Nothing Nothing let expectedOutput = expVal & case expSign of "-" -> (-) 0 _ -> id @@ -280,18 +281,11 @@ genIdentifier :: Int -> Int -> QC.Gen String genIdentifier fromLength toLength = do letter <- QC.elements letters lengthStr <- QC.elements [fromLength..toLength] - otherLetters <- replicateM lengthStr genUnderscoreLetterOrDigit - let identifier = (letter:concat otherLetters) - return identifier + intersperseUnderscores + =<< (letter:) + <$> (replicateM lengthStr $ QC.elements letters_or_digits) where letters = ['a'..'z'] ++ ['A'..'Z'] letters_or_digits = ['0'..'9'] ++ letters - genUnderscoreLetterOrDigit :: QC.Gen String - genUnderscoreLetterOrDigit = do - optionalUnderscore <- QC.elements [True,False] - letter_or_digit <- QC.elements letters_or_digits - return $ - if optionalUnderscore then ['_',letter_or_digit] - else [letter_or_digit] ---- |Generate a VHDL specific decimal literal ---- Arguments: range of unit string, range of optional decimal part, whether exponent used @@ -371,3 +365,15 @@ genComment = do (fst,snd@('\n':rest)) -> (fst++snd,rest) (fst,[]) -> (fst,[]) return $ ExpectedOutput ("--" ++ input) expectedOutput + +-- |Intersperse a string with underscores +-- Useful for many VHDL patterns including integer and identifiers +intersperseUnderscores :: String -> QC.Gen String +intersperseUnderscores (fst:rest) = concat . ([fst]:) <$> mapM genUnderscore rest + where genUnderscore char = + QC.arbitrary + <&> \includeUnderscore -> + if includeUnderscore + then ['_',char] + else [char] +intersperseUnderscores [] = return [] diff --git a/test/Spec/Parser/Combinators/Lex.hs b/test/Spec/Parser/Combinators/Lex.hs index 77cbd72..a9c9ccb 100644 --- a/test/Spec/Parser/Combinators/Lex.hs +++ b/test/Spec/Parser/Combinators/Lex.hs @@ -12,8 +12,7 @@ import Control.Applicative (liftA2) import Data.Either (isLeft) import Data.Maybe (isNothing) import Data.Int - ( Int8 - , Int16 + ( Int16 , Int64 ) import Numeric @@ -50,6 +49,7 @@ import Spec.Generators.LexElements , genBitStr , genIdentifier , genComment + , intersperseUnderscores ) -- |All tests for the module "Parser.Combinators.Lex" @@ -110,38 +110,42 @@ validDecimals = testGroup "Valid decimal literals" -- Any decimal without a decimal point validDecimalIntegers :: TestTree validDecimalIntegers = QC.testProperty "Valid integer-kind decimal literals" $ - QC.forAll genInteger $ \(ExpectedOutput input expectedOutput) -> (parse abstractLiteral "TEST" input) == Right (UniversalInteger expectedOutput) - where genInteger :: QC.Gen (ParserExpectedOutput Int64) - genInteger = QC.oneof - [ noExponent - , positiveExponent - , negativeExponent - ] - genInt :: (QC.Arbitrary a,Integral a) => QC.Gen a - genInt = QC.suchThat QC.arbitrary (>= 0) + QC.forAll genDecimalInteger $ \(ExpectedOutput input expectedOutput) -> (parse abstractLiteral "TEST" input) == Right (UniversalInteger expectedOutput) + where genDecimalInteger :: QC.Gen (ParserExpectedOutput Int64) + genDecimalInteger = QC.oneof + [ noExponent + , positiveExponent + , negativeExponent + ] noExponent :: QC.Gen (ParserExpectedOutput Int64) - noExponent = - let gen value = ExpectedOutput (show value) value - in gen <$> genInt - positiveExponent :: QC.Gen (ParserExpectedOutput Int64) + noExponent = let gen (ExpectedOutput input value) = ExpectedOutput input (fromIntegral value) + in gen <$> genInteger Nothing Nothing positiveExponent = do - let genMulTen :: QC.Gen (Integer,Int8) - genMulTen = (\baseVal exponent -> (toInteger baseVal * 10 ^ exponent,exponent)) - <$> (genInt :: QC.Gen Int16) - <*> genInt - (expectedOutput,exponent) <- (\(a,b) -> (fromInteger a,b)) - <$> QC.suchThat genMulTen ((\val -> val >= 0 && val <= toInteger (maxBound :: Int64)) . fst) - actualExponent <- QC.choose (0,exponent) + (minValue,maxExponent) <- QC.suchThat + ( (,) + <$> QC.choose (0,2^7) + <*> QC.choose (0,maxBound :: Int16) + ) + $ \(baseVal,exp) -> (baseVal * 10 ^ exp) <= toInteger (maxBound :: Int64) + actualExponent <- QC.choose (0,maxExponent) exponentChar <- QC.elements "Ee" - let input = show (floor $ fromIntegral expectedOutput / 10.0 ^^ actualExponent) ++ [exponentChar] ++ show actualExponent - return $ ExpectedOutput input expectedOutput + valueStr <- intersperseUnderscores $ show $ minValue * 10 ^ (maxExponent - actualExponent) + exponentStr <- intersperseUnderscores $ show actualExponent + let inputStr = valueStr ++ [exponentChar] ++ exponentStr + expectedOutput = fromIntegral $ minValue * 10 ^ maxExponent + return $ ExpectedOutput inputStr expectedOutput negativeExponent :: QC.Gen (ParserExpectedOutput Int64) negativeExponent = do - expectedOutput <- genInt - shiftVal <- genInt - exponentChar <- QC.elements "Ee" - let input = show expectedOutput ++ replicate shiftVal '0' ++ [exponentChar] ++ show (-shiftVal) - return $ ExpectedOutput input expectedOutput + expectedValue <- QC.choose (0,maxBound :: Int64) + shiftVal <- QC.choose (0,2^7) -- Number of zeros on end of value + let actualValue = intersperseUnderscores $ show expectedValue ++ replicate shiftVal '0' + input <- (++) + <$> actualValue + <*> ( (\e val -> (e:'-':val)) + <$> QC.elements "Ee" + <*> intersperseUnderscores (show shiftVal) + ) + return $ ExpectedOutput input expectedValue -- |Tests for decimal literals that parse to reals validDecimalReals :: TestTree @@ -495,7 +499,7 @@ integers = testGroup "Integers" -- |Tests for valid integers validIntegers :: TestTree validIntegers = QC.testProperty "Valid integers" $ - QC.forAll (genInteger 0 $ toInteger (maxBound :: Int64)) $ + QC.forAll (genInteger Nothing Nothing) $ \(ExpectedOutput input expectedValue) -> parse integer "TEST" input == Right (show expectedValue) -- |Tests for invalid integers @@ -517,7 +521,7 @@ exponents = testGroup "Exponents" -- |Tests for valid exponents validExponents :: TestTree validExponents = QC.testProperty "Valid exponents" $ - QC.forAll genExponent $ \(ExpectedOutput input expectedOutput) -> parse exponent' "TEST" input == Right expectedOutput + QC.forAll genExponent $ \(ExpectedOutput input expectedOutput) -> parse exponent' "TEST" input == Right (toInteger expectedOutput) -- |Tests for invalid exponents invalidExponents :: TestTree