diff --git a/src/QuickCheckTests.hs b/src/QuickCheckTests.hs new file mode 100644 index 0000000..7f7f977 --- /dev/null +++ b/src/QuickCheckTests.hs @@ -0,0 +1,94 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Main where + +import Test.QuickCheck + +import Windows12.Ast +import Windows12.Parser (programP) +import Text.Megaparsec (parse) + +import Data.String.Conversions (cs) + +import Data.Text +import Data.Text.Internal +import Data.Text.Prettyprint.Doc (pretty) + +main :: IO () +main = quickCheck prop_print_parse + +-- Ensure that pretty-printing and parsing are inverses +prop_print_parse :: Program -> Bool +prop_print_parse p = Right p == (parse programP "" (cs (show (pretty p)))) + +instance Arbitrary Data.Text.Internal.Text where + arbitrary = listOf1 (elements ['a'..'z']) >>= return . Data.Text.pack + +instance Arbitrary BinOp where + arbitrary = elements [Add, Sub, Mul, Div, Mod, Eq, Ne, Lt, Gt, Le, Ge, And, Or, + BitAnd, BitOr, BitXor, ShiftL, ShiftR] + +instance Arbitrary UnOp where + arbitrary = elements [Neg, Not, BitNot] + +instance Arbitrary AssignOp where + arbitrary = elements [BaseAssign, AddAssign, SubAssign, MulAssign, DivAssign, + ModAssign, BitAndAssign, BitOrAssign, BitXorAssign, ShiftLAssign, ShiftRAssign] + +instance Arbitrary Expr where + arbitrary = oneof + [ Id <$> arbitrary + , IntLit <$> arbitrary + , UIntLit <$> arbitrary + , FloatLit <$> arbitrary + , StrLit <$> arbitrary + , BoolLit <$> arbitrary + , CharLit <$> arbitrary + , BinOp <$> arbitrary <*> arbitrary <*> arbitrary + , UnOp <$> arbitrary <*> arbitrary + , Call <$> arbitrary <*> arbitrary + , Index <$> arbitrary <*> arbitrary + , Member <$> arbitrary <*> arbitrary + , Cast <$> arbitrary <*> arbitrary + , Sizeof <$> arbitrary + , StructInit <$> arbitrary <*> arbitrary + ] + +instance Arbitrary Stmt where + arbitrary = oneof + [ Expr <$> arbitrary + , Return <$> arbitrary + , If <$> arbitrary <*> arbitrary <*> arbitrary + , While <$> arbitrary <*> arbitrary + , Assign <$> arbitrary <*> arbitrary <*> arbitrary + , Block <$> arbitrary + , Var <$> arbitrary <*> arbitrary <*> arbitrary + ] + +-- Massively simplified types: No pointers, void, structs, enums +instance Arbitrary Type where + arbitrary = elements [IntType, UIntType, FloatType, StrType, BoolType, + CharType, PtrType IntType, ArrayType IntType] + +instance Arbitrary Bind where + arbitrary = Bind <$> arbitrary <*> arbitrary + +instance Arbitrary TLStruct where + arbitrary = Struct <$> arbitrary <*> arbitrary + +-- ensure the enum has at least one field +instance Arbitrary TLEnum where + arbitrary = Enum <$> arbitrary <*> listOf1 arbitrary + +instance Arbitrary TLFunc where + arbitrary = Func <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary + +instance Arbitrary TL where + arbitrary = oneof + [ TLStruct <$> arbitrary + , TLEnum <$> arbitrary + , TLFunc <$> arbitrary + ] + +instance Arbitrary Program where + arbitrary = Program <$> arbitrary <*> arbitrary <*> arbitrary diff --git a/windows12.cabal b/windows12.cabal index 35720ce..dd9d8a9 100644 --- a/windows12.cabal +++ b/windows12.cabal @@ -92,3 +92,36 @@ executable windows12 -- Base language which the package is written in. default-language: Haskell2010 + +executable windows12-qc + -- Import common warning flags. + import: warnings + + -- .hs or .lhs file containing the Main module. + main-is: QuickCheckTests.hs + + -- Modules included in this executable, other than Main. + other-modules: + Windows12.Ast + Windows12.Lexer + Windows12.Parser + + -- LANGUAGE extensions used by modules in this package. + -- other-extensions: + + -- Other library packages from which modules are imported. + build-depends: + base >= 4.15.1 && < 4.16, + megaparsec >= 9.6.1 && < 9.7, + text >= 1.2.5 && < 1.3, + parser-combinators >= 1.3.0 && < 1.4, + prettyprinter >= 1.5.1 && < 1.6, + string-conversions >= 0.4.0 && < 0.5, + mtl >= 2.2.2 && < 2.3, + QuickCheck >= 2.14.2 && < 2.15, + + -- Directories containing source files. + hs-source-dirs: src + + -- Base language which the package is written in. + default-language: Haskell2010