hexagoxel
/
brittany
1
0
Fork 0
Code Issues 117 Pull Requests 5 Packages Projects Releases 5 Wiki Activity

Merge unit tests into literate tests

pull/357/head
Taylor Fausak 2021-11-06 21:21:11 +00:00 committed by GitHub
parent d879125264
commit 9a9b67d410
3 changed files with 39 additions and 118 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
brittany.cabal
View File

@ -128,15 +128,6 @@ executable brittany
hs-source-dirs: source/executable hs-source-dirs: source/executable
main-is: Main.hs 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 test-suite littests
import: executable import: executable

39
src-literatetests/Main.hs
View File

@ -1,5 +1,6 @@
{-# LANGUAGE LambdaCase #-} {-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MonadComprehensions #-} {-# LANGUAGE MonadComprehensions #-}
{-# LANGUAGE ScopedTypeVariables #-}
import Language.Haskell.Brittany.Internal.Prelude import Language.Haskell.Brittany.Internal.Prelude
import qualified Data.Maybe import qualified Data.Maybe
@ -25,6 +26,43 @@ import Data.Coerce ( coerce )
import qualified Data.Text.IO as Text.IO import qualified Data.Text.IO as Text.IO
import System.FilePath ( (</>) ) 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 data InputLine
@ -53,6 +91,7 @@ main = do
inputCtxFree <- Text.IO.readFile "src-literatetests/30-tests-context-free.blt" inputCtxFree <- Text.IO.readFile "src-literatetests/30-tests-context-free.blt"
let groupsCtxFree = createChunks inputCtxFree let groupsCtxFree = createChunks inputCtxFree
hspec $ do hspec $ do
describe "asymptotic perf roundtrips" $ asymptoticPerfTest
groups `forM_` \(groupname, tests) -> do groups `forM_` \(groupname, tests) -> do
describe (Text.unpack groupname) $ do describe (Text.unpack groupname) $ do
tests `forM_` \test -> do tests `forM_` \test -> do

109
src-unittests/TestMain.hs
View File

@ -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