Infrastructure for generating test data.

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

generation/src/Base.hs

@@ -11,7 +11,8 @@ base :: File
 base = File {
   predicate = \ _ _ -> True,
   outputName = "base",
-  generator = declareBaseStructure
+  generator = declareBaseStructure,
+  testGenerator = Nothing
 }
 
 declareBaseStructure :: Word -> Gen ()

generation/src/BinaryOps.hs

@@ -3,15 +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
+    generator = declareBinaryOperators,
+    testGenerator = Just testVectors
 }
 
 declareBinaryOperators :: Word -> Gen ()
@@ -51,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 =
@@ -98,8 +103,8 @@ generateBinOpsFromAssigns trait name fun op =
                out ("output " ++ op ++ " rhs;")
                out "output"
 
-addBinaryLaws :: String -> Gen ()
+addBinaryLaws :: String -> Word -> Gen ()
-addBinaryLaws name =
+addBinaryLaws name entries =
   do let args3 = "(a: " ++ name ++ ", b: " ++ name ++ ", c: " ++ name ++ ")"
          args2 = "(a: " ++ name ++ ", b: " ++ name ++ ")"
      out "#[cfg(test)]"
@@ -143,3 +148,24 @@ addBinaryLaws name =
           blank
           wrapIndent ("fn or_ident(a: " ++ name ++ ") -> bool") $
             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
+  

generation/src/Compare.hs

@@ -9,7 +9,8 @@ comparisons :: File
 comparisons = File {
   predicate = \ _ _ -> True,
   outputName = "compare",
-  generator = declareComparators
+  generator = declareComparators,
+  testGenerator = Nothing
 }
 
 declareComparators :: Word -> Gen ()

generation/src/Conversions.hs

@@ -11,7 +11,8 @@ conversions :: File
 conversions = File {
   predicate = \ _ _ -> True,
   outputName = "conversions",
-  generator = declareConversions
+  generator = declareConversions,
+  testGenerator = Nothing
 }
 
 declareConversions :: Word -> Gen ()

generation/src/CryptoNum.hs

@@ -11,7 +11,8 @@ cryptoNum :: File
 cryptoNum = File {
   predicate = \ _ _ -> True,
   outputName = "cryptonum",
-  generator = declareCryptoNumInstance
+  generator = declareCryptoNumInstance,
+  testGenerator = Nothing
 }
 
 declareCryptoNumInstance :: Word -> Gen ()
@@ -24,7 +25,9 @@ declareCryptoNumInstance bitsize =
      out "#[cfg(test)]"
      out "use crate::testing::{build_test_path,run_test};"
      out "#[cfg(test)]"
-     out "use quickcheck::quickcheck;"
+     out "use quickcheck::{Arbitrary,Gen,quickcheck};"
+     out "#[cfg(test)]"
+     out "use std::fmt;"
      out ("use super::" ++ name ++ ";")
      blank
      implFor "CryptoNum" name $
@@ -96,13 +99,43 @@ declareCryptoNumInstance bitsize =
                     out ("idx -= 1;")
                out ("bytes[idx] = byte" ++ show (bytes-1) ++ ";")
      blank
+     let bytes = bitsize `div` 8
+         struct = "Bytes" ++ show bytes
+     out "#[cfg(test)]"
+     out "#[derive(Clone)]"
+     wrapIndent ("struct " ++ struct) $
+       out ("value: [u8; " ++ show bytes ++ "]")
+     blank
+     out "#[cfg(test)]"
+     implFor "PartialEq" struct $
+       wrapIndent ("fn eq(&self, other: &Self) -> bool") $
+         out "self.value.iter().zip(other.value.iter()).all(|(a,b)| a == b)"
+     blank
+     out "#[cfg(test)]"
+     implFor "fmt::Debug" struct $
+       wrapIndent ("fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result") $
+         out "f.debug_list().entries(self.value.iter()).finish()"
+     blank
+     out "#[cfg(test)]"
+     implFor "Arbitrary" struct $
+       wrapIndent ("fn arbitrary<G: Gen>(g: &mut G) -> Self") $
+         do out ("let mut res = " ++ struct ++ "{ value: [0; " ++ show bytes ++ "] };")
+            out ("g.fill_bytes(&mut res.value);")
+            out ("res")
+     blank
      out "#[cfg(test)]"
      wrapIndent "quickcheck!" $
        do wrapIndent ("fn to_from_ident(x: " ++ name ++ ") -> bool") $
-            do out ("let mut buffer = [0; " ++ show (bitsize `div` 8) ++ "];")
+            do out ("let mut buffer = [0; " ++ show bytes ++ "];")
                out ("x.to_bytes(&mut buffer);");
                out ("let y = " ++ name ++ "::from_bytes(&buffer);")
                out ("x == y")
+          blank
+          wrapIndent ("fn from_to_ident(x: " ++ struct ++ ") -> bool") $
+            do out ("let val = " ++ name ++ "::from_bytes(&x.value);")
+               out ("let mut buffer = [0; " ++ show bytes ++ "];")
+               out ("val.to_bytes(&mut buffer);")
+               out ("buffer.iter().zip(x.value.iter()).all(|(a,b)| a == b)")
      blank
      out "#[cfg(test)]"
      out "#[allow(non_snake_case)]"

generation/src/File.hs

@@ -2,12 +2,13 @@ module File(
          File(..),
          Task(..),
          addModuleTasks,
-         makeTask
+         makeTasks
        )
  where
 
 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,(</>))
@@ -15,7 +16,8 @@ import System.FilePath(takeBaseName,takeDirectory,takeFileName,(</>))
 data File = File {
     predicate :: Word -> [Word] -> Bool,
     outputName :: FilePath,
-    generator :: Word -> Gen ()
+    generator :: Word -> Gen (),
+    testGenerator :: Maybe (Word -> Gen ())
 }
 
 data Task = Task {
@@ -23,26 +25,29 @@ data Task = Task {
     fileGenerator :: Gen ()
 }
 
-makeTask :: FilePath ->
+makeTasks :: FilePath -> FilePath ->
             Word -> [Word] ->
             File ->
-            Maybe Task
+            [Task]
-makeTask base size allSizes file
+makeTasks srcBase testBase size allSizes file
   | predicate file size allSizes =
-     Just Task {
+      let base = Task (srcBase </> ("u" ++ show size) </> outputName file <> ".rs") (generator file size)
-         outputFile = base </> ("u" ++ show size) </> outputName file <> ".rs",
+      in case testGenerator file of 
-         fileGenerator = generator file size
+           Nothing -> [base]
-     }
+           Just x ->
-  | otherwise =
+            [base, Task (testBase </> outputName file </> ("U" ++ show size ++ ".test")) (x size)]
-     Nothing
+  | otherwise = []
 
 addModuleTasks :: FilePath -> [Task] -> [Task]
 addModuleTasks base baseTasks = unsignedTask : (baseTasks ++ moduleTasks)
  where
   moduleMap = foldr addModuleInfo Map.empty baseTasks
-  addModuleInfo task =
+  addModuleInfo task map
-    Map.insertWith (++) (takeDirectory (outputFile task))
+    | base `isPrefixOf` outputFile task =
-                        [takeBaseName (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",

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 :: IO GenState
-initGenState =  GenState { indentAmount = 0, gensymIndex = 0 }
+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
 
@@ -86,3 +95,21 @@ implFor' trait name middle =
 implFor'' :: String -> String -> Gen a -> Gen a
 implFor'' trait name middle =
     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 "")

generation/src/Main.hs

@@ -7,9 +7,8 @@ import Compare(comparisons)
 import Conversions(conversions)
 import CryptoNum(cryptoNum)
 import Control.Monad(forM_,unless)
-import Data.Maybe(mapMaybe)
 import Data.Word(Word)
-import File(File,Task(..),addModuleTasks,makeTask)
+import File(File,Task(..),addModuleTasks,makeTasks)
 import Gen(runGen)
 import System.Directory(createDirectoryIfMissing)
 import System.Environment(getArgs)
@@ -38,21 +37,24 @@ signedFiles :: [File]
 signedFiles = [
   ]
 
-makeTasks :: FilePath -> [File] -> [Task]
+makeTasks' :: FilePath -> FilePath -> [File] -> [Task]
-makeTasks basePath files =
+makeTasks' srcPath testPath files =
-  concatMap (\ sz -> mapMaybe (makeTask basePath sz bitsizes) files) bitsizes
+  concatMap (\ sz -> concatMap (makeTasks srcPath testPath sz bitsizes) files) bitsizes
 
-makeAllTasks :: FilePath -> [Task]
+makeAllTasks :: FilePath -> FilePath -> [Task]
-makeAllTasks basePath = addModuleTasks basePath $
+makeAllTasks srcPath testPath = addModuleTasks srcPath $
-  makeTasks (basePath </> "unsigned") unsignedFiles ++
+  makeTasks' (srcPath </> "unsigned") testPath unsignedFiles ++
-  makeTasks (basePath </> "signed")   signedFiles
+  makeTasks' (srcPath </> "signed")   testPath signedFiles
 
 main :: IO ()
 main =
   do args <- getArgs
      unless (length args == 1) $
        die ("generation takes exactly one argument, the target directory")
-     let tasks = makeAllTasks (head args)
+     let topLevel = head args
+         srcPath = topLevel </> "src"
+         testPath = topLevel </> "testdata"
+         tasks = makeAllTasks srcPath testPath
          total = length tasks
      forM_ (zip [(1::Word)..] tasks) $ \ (i, task) ->
        do putStrLn ("[" ++ show i ++ "/" ++ show total ++ "] " ++ outputFile task)

generation/src/Testing.hs

@@ -0,0 +1,4 @@
+module Testing(
+       )
+ where
+