From 84f6925f6032494e3dda2fe45fcacbbd48aeb982 Mon Sep 17 00:00:00 2001 From: Adam Wick Date: Sat, 17 Aug 2019 21:37:17 -0700 Subject: [PATCH] Infrastructure for generating test data. --- generation/generation.cabal | 5 +++-- generation/src/BinaryOps.hs | 37 +++++++++++++++++++++++++++++++------ generation/src/File.hs | 10 +++++++--- generation/src/Gen.hs | 37 ++++++++++++++++++++++++++++++++----- generation/src/Testing.hs | 4 ++++ 5 files changed, 77 insertions(+), 16 deletions(-) create mode 100644 generation/src/Testing.hs diff --git a/generation/generation.cabal b/generation/generation.cabal index bf06ed1..7569e91 100644 --- a/generation/generation.cabal +++ b/generation/generation.cabal @@ -18,13 +18,14 @@ extra-source-files: CHANGELOG.md executable generation main-is: Main.hs - other-modules: Base, BinaryOps, Compare, Conversions, CryptoNum, File, Gen + other-modules: Base, BinaryOps, Compare, Conversions, CryptoNum, File, Gen, Testing -- other-extensions: build-depends: base ^>=4.12.0.0, containers, directory, filepath, - mtl + mtl, + random hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall diff --git a/generation/src/BinaryOps.hs b/generation/src/BinaryOps.hs index aee5286..9d612a3 100644 --- a/generation/src/BinaryOps.hs +++ b/generation/src/BinaryOps.hs @@ -3,16 +3,20 @@ module BinaryOps( ) where -import Control.Monad(forM_) +import Control.Monad(forM_,replicateM_) +import Data.Bits((.&.), (.|.), shiftL, xor) import File import Gen +binaryTestCount :: Int +binaryTestCount = 3000 + binaryOps :: File binaryOps = File { predicate = \ _ _ -> True, outputName = "binary", generator = declareBinaryOperators, - testGenerator = Nothing + testGenerator = Just testVectors } declareBinaryOperators :: Word -> Gen () @@ -52,7 +56,7 @@ declareBinaryOperators bitsize = out ("output.value[" ++ show i ++ "] = !self.value[" ++ show i ++ "];") out "output" blank - addBinaryLaws name + addBinaryLaws name entries generateBinOps :: String -> String -> String -> String -> Word -> Gen () generateBinOps trait name fun op entries = @@ -99,8 +103,8 @@ generateBinOpsFromAssigns trait name fun op = out ("output " ++ op ++ " rhs;") out "output" -addBinaryLaws :: String -> Gen () -addBinaryLaws name = +addBinaryLaws :: String -> Word -> Gen () +addBinaryLaws name entries = do let args3 = "(a: " ++ name ++ ", b: " ++ name ++ ", c: " ++ name ++ ")" args2 = "(a: " ++ name ++ ", b: " ++ name ++ ")" out "#[cfg(test)]" @@ -143,4 +147,25 @@ addBinaryLaws name = out ("(&a & &ones) == a") blank wrapIndent ("fn or_ident(a: " ++ name ++ ") -> bool") $ - out ("(&a | " ++ name ++ "::zero()) == a") \ No newline at end of file + out ("(&a | " ++ name ++ "::zero()) == a") + wrapIndent ("fn neg_as_xor(a: " ++ name ++ ") -> bool") $ + do out ("let ones = " ++ name ++ "{ value: [0xFFFFFFFFFFFFFFFFu64; " + ++ show entries ++ "] };") + out ("!&a == (&ones ^ &a)") + + +testVectors :: Word -> Gen () +testVectors bitsize = replicateM_ binaryTestCount $ + do a <- newNum False bitsize + b <- newNum False bitsize + let o = a .|. b + c = a .&. b + n = a `xor` ((1 `shiftL` fromIntegral bitsize) - 1) + x = a `xor` b + emitTestVariable 'a' a + emitTestVariable 'b' b + emitTestVariable 'c' c + emitTestVariable 'o' o + emitTestVariable 'n' n + emitTestVariable 'x' x + \ No newline at end of file diff --git a/generation/src/File.hs b/generation/src/File.hs index 1b771b6..de17e35 100644 --- a/generation/src/File.hs +++ b/generation/src/File.hs @@ -8,6 +8,7 @@ module File( import Control.Monad(forM_) import Data.Char(toUpper) +import Data.List(isPrefixOf) import qualified Data.Map.Strict as Map import Gen(Gen,blank,out) import System.FilePath(takeBaseName,takeDirectory,takeFileName,()) @@ -41,9 +42,12 @@ addModuleTasks :: FilePath -> [Task] -> [Task] addModuleTasks base baseTasks = unsignedTask : (baseTasks ++ moduleTasks) where moduleMap = foldr addModuleInfo Map.empty baseTasks - addModuleInfo task = - Map.insertWith (++) (takeDirectory (outputFile task)) - [takeBaseName (outputFile task)] + addModuleInfo task map + | base `isPrefixOf` outputFile task = + Map.insertWith (++) (takeDirectory (outputFile task)) + [takeBaseName (outputFile task)] + map + | otherwise = map moduleTasks = Map.foldrWithKey generateModuleTask [] moduleMap generateModuleTask directory mods acc = acc ++ [Task { outputFile = directory "mod.rs", diff --git a/generation/src/Gen.hs b/generation/src/Gen.hs index 02bd661..d5183f2 100644 --- a/generation/src/Gen.hs +++ b/generation/src/Gen.hs @@ -10,14 +10,19 @@ module Gen( implFor, implFor', implFor'', + newNum, + TestVariable(..), ) where import Control.Monad.RWS.Strict(RWS,evalRWS) import Control.Monad.State.Class(MonadState,get,put) import Control.Monad.Writer.Class(MonadWriter,tell) +import Data.Bits(shiftL) import Data.List(replicate) import Data.Word(Word) +import Numeric(showHex) +import System.Random(StdGen, newStdGen, random, randomR) newtype Gen a = Gen { unGen :: RWS () String GenState a} deriving (Applicative, Functor, Monad, MonadState GenState, MonadWriter String) @@ -27,15 +32,19 @@ tabAmount = 4 data GenState = GenState { indentAmount :: Word, - gensymIndex :: Word + gensymIndex :: Word, + rng :: StdGen } -initGenState :: GenState -initGenState = GenState { indentAmount = 0, gensymIndex = 0 } +initGenState :: IO GenState +initGenState = + do rng0 <- newStdGen + return GenState { indentAmount = 0, gensymIndex = 0, rng = rng0 } runGen :: FilePath -> Gen a -> IO a runGen path action = - do let (res, contents) = evalRWS (unGen action) () initGenState + do state0 <- initGenState + let (res, contents) = evalRWS (unGen action) () state0 writeFile path contents return res @@ -85,4 +94,22 @@ implFor' trait name middle = implFor'' :: String -> String -> Gen a -> Gen a implFor'' trait name middle = - wrapIndent ("impl<'a,'b> " ++ trait ++ " for " ++ name) middle \ No newline at end of file + wrapIndent ("impl<'a,'b> " ++ trait ++ " for " ++ name) middle + +newNum :: Bool -> Word -> Gen Integer +newNum signed bits = + do gs <- get + let rng0 = rng gs + let high = (1 `shiftL` fromIntegral bits) - 1 + let (v, rng1) = randomR (0, high) rng0 + let (sign, rng2) = random rng1 + let v' = if signed && sign then -v else v + put gs{ rng = rng2 } + return v' + +class TestVariable a where + emitTestVariable :: Char -> a -> Gen () + +instance TestVariable Integer where + emitTestVariable c v = + out ([c] ++ ": " ++ showHex v "") \ No newline at end of file diff --git a/generation/src/Testing.hs b/generation/src/Testing.hs new file mode 100644 index 0000000..03e8088 --- /dev/null +++ b/generation/src/Testing.hs @@ -0,0 +1,4 @@ +module Testing( + ) + where +