[Git][ghc/ghc][master] add reproducer for #15630

[Marge Bot]

 Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
de139cc4 by Artem Pelenitsyn at 2020-07-12T02:53:20-04:00
add reproducer for #15630

- - - - -


2 changed files:

- + testsuite/tests/perf/compiler/T15630.hs
- testsuite/tests/perf/compiler/all.T


Changes:

=====================================
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 ?)


=====================================
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',



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/de139cc496c0e0110e252a1208ae346f47f8061e

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/de139cc496c0e0110e252a1208ae346f47f8061e
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20200712/4caa882e/attachment-0001.html>