From 3d8b510ffd8ee36449ac4f4c2e75e44979fd01b9 Mon Sep 17 00:00:00 2001 From: Alexander Wood Date: Sun, 8 Sep 2024 17:09:37 -0400 Subject: [PATCH] add an integration test for source generation --- hie.yaml | 5 +- templatespiler-converter/converter.cabal | 22 ++++ .../src/Templatespiler/Convert.hs | 1 + .../src/Templatespiler/Convert/Target.hs | 5 +- templatespiler-converter/test/Main.hs | 108 ++++++++++++++++++ templatespiler-converter/test/Util.hs | 15 +++ 6 files changed, 153 insertions(+), 3 deletions(-) create mode 100644 templatespiler-converter/test/Main.hs create mode 100644 templatespiler-converter/test/Util.hs diff --git a/hie.yaml b/hie.yaml index 397ed82..79e596f 100644 --- a/hie.yaml +++ b/hie.yaml @@ -6,6 +6,9 @@ cradle: - path: "templatespiler-converter/src/Main.hs" component: "templatespiler-converter:exe:converter" + - path: "templatespiler-converter/test" + component: "templatespiler-converter:test:test" + - path: "templatespiler-generator/src" component: "lib:templatespiler-generator" @@ -25,4 +28,4 @@ cradle: component: "templatespiler-server:exe:server" - path: "templatespiler-server/src/Main.hs" - component: "templatespiler-server:exe:server" \ No newline at end of file + component: "templatespiler-server:exe:server" diff --git a/templatespiler-converter/converter.cabal b/templatespiler-converter/converter.cabal index 447dd9c..42dc78e 100644 --- a/templatespiler-converter/converter.cabal +++ b/templatespiler-converter/converter.cabal @@ -12,6 +12,7 @@ common shared -Wall -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-deriving-strategies -Wunused-foralls -Wunused-foralls -fprint-explicit-foralls -fprint-explicit-kinds + -threaded -rtsopts -with-rtsopts=-N mixins: base hiding (Prelude), @@ -63,3 +64,24 @@ executable converter main-is: Main.hs build-depends: templatespiler-converter hs-source-dirs: app + +test-suite test + import: shared + type: exitcode-stdio-1.0 + main-is: Main.hs + build-depends: + , hedgehog >=1.4 + , sydtest + , sydtest-hedgehog + , templatespiler-generator + , templatespiler-converter + , process + , temporary + , temporary-resourcet + , exceptions + , unliftio-core + , mmorph + , resourcet + + default-extensions: TemplateHaskell + hs-source-dirs: test diff --git a/templatespiler-converter/src/Templatespiler/Convert.hs b/templatespiler-converter/src/Templatespiler/Convert.hs index bfd3b86..5e1fb59 100644 --- a/templatespiler-converter/src/Templatespiler/Convert.hs +++ b/templatespiler-converter/src/Templatespiler/Convert.hs @@ -14,6 +14,7 @@ import Templatespiler.ToLang.Target convertTo :: BindingList -> TargetLanguage -> Maybe ConvertResult convertTo bindingList lang = case lang of Python -> Just $ convertTo' @Python bindingList + C -> Just $ convertTo' @C bindingList _ -> Nothing convertTo' :: diff --git a/templatespiler-converter/src/Templatespiler/Convert/Target.hs b/templatespiler-converter/src/Templatespiler/Convert/Target.hs index e697f81..23d2b91 100644 --- a/templatespiler-converter/src/Templatespiler/Convert/Target.hs +++ b/templatespiler-converter/src/Templatespiler/Convert/Target.hs @@ -12,14 +12,15 @@ import Templatespiler.Convert.ToImperative qualified as Imperative import Templatespiler.IR.Declarative as DecIR import Templatespiler.IR.Imperative as ImpIR -data TargetLanguage = C | Python | Haskell deriving stock (Eq, Show, Generic) +data TargetLanguage = C | Python deriving stock (Eq, Show, Generic, Enum, Bounded) data LanguageKind = Imperative | Declarative type family ParadigmOf (lang :: TargetLanguage) where ParadigmOf C = Imperative ParadigmOf Python = Imperative - ParadigmOf Haskell = Declarative + +-- ParadigmOf Haskell = Declarative -- TODO type family IRTarget (lang :: LanguageKind) = p | p -> lang where IRTarget Imperative = ImpIR.Program diff --git a/templatespiler-converter/test/Main.hs b/templatespiler-converter/test/Main.hs new file mode 100644 index 0000000..e2d1f61 --- /dev/null +++ b/templatespiler-converter/test/Main.hs @@ -0,0 +1,108 @@ +{-# LANGUAGE PackageImports #-} + +module Main where + +import Control.Monad.Catch +import Control.Monad.IO.Unlift +import Control.Monad.Morph (hoist) +import Control.Monad.Trans.Resource +import Data.Text.IO qualified as Text +import Hedgehog (MonadTest, evalEither, evalMaybe, forAll, property, (===)) +import Hedgehog.Gen qualified as Gen +import Hedgehog.Internal.Property (failWith) +import Hedgehog.Range qualified as Range +import Language.Templatespiler.Parser +import Language.Templatespiler.Syntax +import Prettyprinter +import Prettyprinter.Render.Terminal +import System.IO (hClose) +import System.Process +import Templatespiler.Convert +import Templatespiler.Convert.Target +import Templatespiler.Emit.Common +import Templatespiler.Generate (arbitraryInput) +import Templatespiler.Generator +import Test.Syd +import Test.Syd.Hedgehog +import Text.Trifecta +import Util (shouldBeJust, shouldBeRight) +import "temporary" System.IO.Temp qualified as Temp +import "temporary-resourcet" System.IO.Temp qualified as TempResourceT +import System.FilePath (()) + +main :: IO () +main = sydTest spec + +spec :: Spec +spec = describe "Integration Test" $ do + it "Simple Template" $ do + property . hoist runResourceT $ do + let parsed = parseTemplate simpleTemplate3Ints + res <- evalEither parsed + + let allLanguages = [minBound ..] :: [TargetLanguage] + for_ allLanguages $ \lang -> do + genResult <- evalMaybe $ convertTo res lang + code <- case genResult of + ConversionFailed errorDoc -> failWith Nothing $ toString $ renderStrict $ layoutPretty defaultLayoutOptions errorDoc + ConvertResult warnings code -> do + liftIO $ putDoc $ vsep warnings + pure $ show code + + pass + exec <- withCompiled lang code + input <- forAll $ arbitraryInput res + liftIO $ exec input + + +withCompiled :: MonadResource m => TargetLanguage -> Text -> m ([Text] -> IO ()) +withCompiled lang code = do + (_, fp) <- TempResourceT.createTempDirectory Nothing "templatespiler" + + let sourceExt = case lang of + Python -> ".py" + C -> ".c" + (_, sourceFp, sourceHandle) <- TempResourceT.openTempFile (Just fp) ("source" <> sourceExt) + liftIO $ Text.hPutStrLn sourceHandle code + liftIO $ hClose sourceHandle + compiledFile <- case lang of + Python -> pure sourceFp + C -> do + liftIO $ callProcess "gcc" [sourceFp, "-o", fp "a.out"] + pure $ fp <> "/a.out" + + let (cmdToRun, argsToRun) = case lang of + Python -> ("python3", [toText compiledFile]) + C -> (toText compiledFile, []) + + pure $ \inputs -> runProcessWithStdin cmdToRun argsToRun inputs + +runProcessWithStdin :: Text -> [Text] -> [Text] -> IO () +runProcessWithStdin processName args input = do + let inputText = unlines input + (Just hin, Just hout, _, _) <- createProcess (proc (toString processName) (map toString args)) {std_in = CreatePipe, std_out = CreatePipe} + Text.hPutStrLn hin inputText + hFlush hin + -- assert that the process exits successfully with no output + output <- Text.hGetContents hout + output `shouldBe` "" + +parseTemplate :: Text -> Either Text BindingList +parseTemplate input = do + let x = parseByteString parseBindingList mempty . encodeUtf8 $ input + case x of + Success a -> Right a + Failure e -> Left $ renderStrict $ layoutPretty defaultLayoutOptions $ _errDoc e + +-- tests :: TestTree +-- tests = +-- testGroup +-- "Test Generation" +-- [ testCaseSteps "Simple Template" $ \step -> do +-- step "Parse Template" +-- let parsed = parseTemplate simpleTemplate3Ints + +-- ] + +simpleTemplate3Ints :: Text +simpleTemplate3Ints = "a : Integer\n b : Integer\n c : Integer\n" \ No newline at end of file diff --git a/templatespiler-converter/test/Util.hs b/templatespiler-converter/test/Util.hs new file mode 100644 index 0000000..1afb558 --- /dev/null +++ b/templatespiler-converter/test/Util.hs @@ -0,0 +1,15 @@ +module Util where + +import Test.Syd + +shouldBeRight :: (Show a, HasCallStack) => Either Text a -> IO a +shouldBeRight theEither = do + shouldSatisfyNamed theEither "IsRight" isRight + Right a <- pure theEither + pure a + +shouldBeJust :: (Show a, HasCallStack) => Text -> Maybe a -> IO a +shouldBeJust annotation theMaybe = do + shouldSatisfyNamed theMaybe (toString ("IsJust: " <> annotation)) isJust + Just a <- pure theMaybe + pure a \ No newline at end of file