diff options
| author | Artem Pelenitsyn <a.pelenitsyn@gmail.com> | 2020-06-13 03:15:58 +0200 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2020-07-12 02:53:20 -0400 |
| commit | de139cc496c0e0110e252a1208ae346f47f8061e (patch) | |
| tree | a407700f7dbbe8e9a1c89ab87d842a5469c29ca6 /testsuite | |
| parent | 2b7c71cb79095a10b9a5964a5a0676a2a196e92d (diff) | |
| download | haskell-de139cc496c0e0110e252a1208ae346f47f8061e.tar.gz | |
add reproducer for #15630
Diffstat (limited to 'testsuite')
| -rw-r--r-- | testsuite/tests/perf/compiler/T15630.hs | 56 | ||||
| -rw-r--r-- | testsuite/tests/perf/compiler/all.T | 5 |
2 files changed, 61 insertions, 0 deletions
diff --git a/testsuite/tests/perf/compiler/T15630.hs b/testsuite/tests/perf/compiler/T15630.hs new file mode 100644 index 0000000000..2d666758fc --- /dev/null +++ b/testsuite/tests/perf/compiler/T15630.hs @@ -0,0 +1,56 @@ +module T15630 where + +data IValue = IDefault + | IInt Int + | IBlob String + +(?) :: Applicative m => (IValue -> m a) -> IValue -> m (Maybe a) +(?) _ IDefault = pure Nothing +(?) p x = Just <$> p x + +getInt :: IValue -> Either () Int +getInt (IInt i) = Right i +getInt v = Left () + +getString :: IValue -> Either () String +getString (IBlob b) = Right $ b +getString v = Left () + +(<+>) :: Applicative m => (m (a -> b), [IValue]) -> (IValue -> m a) -> (m b, [IValue]) +(<+>) (f, (v:vs)) p = (f <*> (p v), vs) + +data TestStructure = TestStructure + { _param1 :: Int + , _param2 :: Maybe String + , _param3 :: Maybe Int + , _param4 :: Maybe String + , _param5 :: Maybe Int + , _param6 :: Maybe Int + , _param7 :: Maybe String + , _param8 :: Maybe String + , _param9 :: Maybe Int + , _param10 :: Maybe Int + , _param11 :: Maybe String + , _param12 :: Maybe String + , _param13 :: Maybe Int + , _param14 :: Maybe Int + , _param15 :: Maybe String + } + +getMenuItem :: [IValue] -> Either () TestStructure +getMenuItem vs = fst $ (pure TestStructure, vs) + <+> getInt + <+> (getString ?) + <+> (getInt ?) + <+> (getString ?) + <+> (getInt ?) + <+> (getInt ?) + <+> (getString ?) + <+> (getString ?) + <+> (getInt ?) + <+> (getInt ?) + <+> (getString ?) + <+> (getString ?) + <+> (getInt ?) + <+> (getInt ?) + <+> (getString ?) diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index f405acc592..e993d40587 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -346,6 +346,11 @@ test ('T15164', ], compile, ['-v0 -O']) +test('T15630', + [collect_compiler_stats() + ], + compile, + ['-O2']) # See https://gitlab.haskell.org/ghc/ghc/merge_requests/312#note_186960 test ('WWRec', |