From 9a9b67d410de28356dfb7975d59d407d8f5e9c6c Mon Sep 17 00:00:00 2001 From: Taylor Fausak Date: Sat, 6 Nov 2021 21:21:11 +0000 Subject: [PATCH] Merge unit tests into literate tests --- brittany.cabal | 9 ---- src-literatetests/Main.hs | 39 ++++++++++++++ src-unittests/TestMain.hs | 109 -------------------------------------- 3 files changed, 39 insertions(+), 118 deletions(-) delete mode 100644 src-unittests/TestMain.hs diff --git a/brittany.cabal b/brittany.cabal index ee0035b..d659a6a 100644 --- a/brittany.cabal +++ b/brittany.cabal @@ -128,15 +128,6 @@ executable brittany hs-source-dirs: source/executable main-is: Main.hs -test-suite unittests - import: executable - - type: exitcode-stdio-1.0 - build-depends: - , hspec ^>= 2.8.3 - main-is: TestMain.hs - hs-source-dirs: src-unittests - test-suite littests import: executable diff --git a/src-literatetests/Main.hs b/src-literatetests/Main.hs index d11007b..e97252d 100644 --- a/src-literatetests/Main.hs +++ b/src-literatetests/Main.hs @@ -1,5 +1,6 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MonadComprehensions #-} +{-# LANGUAGE ScopedTypeVariables #-} import Language.Haskell.Brittany.Internal.Prelude import qualified Data.Maybe @@ -25,6 +26,43 @@ import Data.Coerce ( coerce ) import qualified Data.Text.IO as Text.IO import System.FilePath ( () ) +import System.Timeout ( timeout ) + + + +import Language.Haskell.Brittany.Internal.PreludeUtils + + + +asymptoticPerfTest :: Spec +asymptoticPerfTest = do + it "10 do statements" + $ roundTripEqualWithTimeout 1500000 + $ (Text.pack "func = do\n") + <> Text.replicate 10 (Text.pack " statement\n") + it "10 do nestings" + $ roundTripEqualWithTimeout 4000000 + $ (Text.pack "func = ") + <> mconcat + ( [1 .. 10] + <&> \(i :: Int) -> + (Text.replicate (2 * i) (Text.pack " ") <> Text.pack "do\n") + ) + <> Text.replicate 2000 (Text.pack " ") + <> Text.pack "return\n" + <> Text.replicate 2002 (Text.pack " ") + <> Text.pack "()" + it "10 AppOps" + $ roundTripEqualWithTimeout 1000000 + $ (Text.pack "func = expr") + <> Text.replicate 10 (Text.pack "\n . expr") --TODO + +roundTripEqualWithTimeout :: Int -> Text -> Expectation +roundTripEqualWithTimeout time t = + timeout time (action >>= evaluate) >>= (`shouldSatisfy`Data.Maybe.isJust) + where + action = fmap (fmap PPTextWrapper) + (parsePrintModuleTests defaultTestConfig "TestFakeFileName.hs" t) data InputLine @@ -53,6 +91,7 @@ main = do inputCtxFree <- Text.IO.readFile "src-literatetests/30-tests-context-free.blt" let groupsCtxFree = createChunks inputCtxFree hspec $ do + describe "asymptotic perf roundtrips" $ asymptoticPerfTest groups `forM_` \(groupname, tests) -> do describe (Text.unpack groupname) $ do tests `forM_` \test -> do diff --git a/src-unittests/TestMain.hs b/src-unittests/TestMain.hs deleted file mode 100644 index 33af44b..0000000 --- a/src-unittests/TestMain.hs +++ /dev/null @@ -1,109 +0,0 @@ -{-# LANGUAGE ScopedTypeVariables #-} - -import Test.Hspec - -import Language.Haskell.Brittany.Internal.Prelude -import qualified Data.Maybe -import qualified Data.Semigroup as Semigroup -import qualified Data.Text as Text - -import Language.Haskell.Brittany.Internal - -import Language.Haskell.Brittany.Internal.Config.Types -import Language.Haskell.Brittany.Internal.Config - -import System.Timeout ( timeout ) - -import Data.Coerce ( coerce ) - - - -import Language.Haskell.Brittany.Internal.PreludeUtils - - - -asymptoticPerfTest :: Spec -asymptoticPerfTest = do - it "10 do statements" - $ roundTripEqualWithTimeout 1500000 - $ (Text.pack "func = do\n") - <> Text.replicate 10 (Text.pack " statement\n") - it "10 do nestings" - $ roundTripEqualWithTimeout 4000000 - $ (Text.pack "func = ") - <> mconcat - ( [1 .. 10] - <&> \(i :: Int) -> - (Text.replicate (2 * i) (Text.pack " ") <> Text.pack "do\n") - ) - <> Text.replicate 2000 (Text.pack " ") - <> Text.pack "return\n" - <> Text.replicate 2002 (Text.pack " ") - <> Text.pack "()" - it "10 AppOps" - $ roundTripEqualWithTimeout 1000000 - $ (Text.pack "func = expr") - <> Text.replicate 10 (Text.pack "\n . expr") --TODO - - - -roundTripEqual :: Text -> Expectation -roundTripEqual t = - fmap (fmap PPTextWrapper) - (parsePrintModuleTests defaultTestConfig "TestFakeFileName.hs" t) - `shouldReturn` Right (PPTextWrapper t) - -roundTripEqualWithTimeout :: Int -> Text -> Expectation -roundTripEqualWithTimeout time t = - timeout time (action >>= evaluate) >>= (`shouldSatisfy`Data.Maybe.isJust) - where - action = fmap (fmap PPTextWrapper) - (parsePrintModuleTests defaultTestConfig "TestFakeFileName.hs" t) - -newtype PPTextWrapper = PPTextWrapper Text - deriving Eq - -instance Show PPTextWrapper where - show (PPTextWrapper t) = "\n" ++ Text.unpack t - -defaultTestConfig :: Config -defaultTestConfig = Config - { _conf_version = _conf_version staticDefaultConfig - , _conf_debug = _conf_debug staticDefaultConfig - , _conf_layout = LayoutConfig - { _lconfig_cols = coerce (80 :: Int) - , _lconfig_indentPolicy = coerce IndentPolicyFree - , _lconfig_indentAmount = coerce (2 :: Int) - , _lconfig_indentWhereSpecial = coerce True - , _lconfig_indentListSpecial = coerce True - , _lconfig_importColumn = coerce (60 :: Int) - , _lconfig_importAsColumn = coerce (60 :: Int) - , _lconfig_altChooser = coerce $ AltChooserBoundedSearch 3 - , _lconfig_columnAlignMode = coerce (ColumnAlignModeMajority 0.7) - , _lconfig_alignmentLimit = coerce (30 :: Int) - , _lconfig_alignmentBreakOnMultiline = coerce True - , _lconfig_hangingTypeSignature = coerce False - , _lconfig_reformatModulePreamble = coerce True - , _lconfig_allowSingleLineExportList = coerce True - , _lconfig_allowHangingQuasiQuotes = coerce True - , _lconfig_experimentalSemicolonNewlines = coerce False - -- , _lconfig_allowSinglelineRecord = coerce False - } - , _conf_errorHandling = (_conf_errorHandling staticDefaultConfig) - { _econf_ExactPrintFallback = coerce ExactPrintFallbackModeNever - } - , _conf_preprocessor = (_conf_preprocessor staticDefaultConfig) - , _conf_forward = ForwardOptions {_options_ghc = Identity []} - , _conf_roundtrip_exactprint_only = coerce False - , _conf_disable_formatting = coerce False - , _conf_obfuscate = coerce False - } - - - -main :: IO () -main = hspec $ tests - -tests :: Spec -tests = do - describe "asymptotic perf roundtrips" $ asymptoticPerfTest