[commit: ghc] master: Add testcase for #14186 (fe35b85)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/fe35b85a8cc72582e0f98a3059be00a9a2318a4a/ghc

>---------------------------------------------------------------

commit fe35b85a8cc72582e0f98a3059be00a9a2318a4a
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Sun Sep 10 15:49:43 2017 +0100

    Add testcase for #14186
    
    and move the generally useful helpers check_errmsg and grep_errmsg to
    testlib.py. Some documentation can be found on
    https://ghc.haskell.org/trac/ghc/wiki/Building/RunningTests/Adding


>---------------------------------------------------------------

fe35b85a8cc72582e0f98a3059be00a9a2318a4a
 testsuite/driver/testlib.py                        | 13 +++++
 testsuite/tests/simplCore/should_compile/T14186.hs |  4 ++
 .../tests/simplCore/should_compile/T14186.stderr   | 57 ++++++++++++++++++++++
 testsuite/tests/simplCore/should_compile/all.T     |  6 ++-
 testsuite/tests/stranal/should_compile/all.T       | 21 ++------
 5 files changed, 83 insertions(+), 18 deletions(-)

diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py
index 15c773e..6a75068 100644
--- a/testsuite/driver/testlib.py
+++ b/testsuite/driver/testlib.py
@@ -520,6 +520,19 @@ def normalise_errmsg_fun( *fs ):
 def _normalise_errmsg_fun( name, opts, *fs ):
     opts.extra_errmsg_normaliser =  join_normalisers(opts.extra_errmsg_normaliser, fs)
 
+def check_errmsg(needle):
+    def norm(str):
+        if needle in str:
+            return "%s contained in -ddump-simpl\n" % needle
+        else:
+            return "%s not contained in -ddump-simpl\n" % needle
+    return normalise_errmsg_fun(norm)
+
+def grep_errmsg(needle):
+    def norm(str):
+        return "".join(filter(lambda l: re.search(needle, l), str.splitlines(True)))
+    return normalise_errmsg_fun(norm)
+
 def normalise_whitespace_fun(f):
     return lambda name, opts: _normalise_whitespace_fun(name, opts, f)
 
diff --git a/testsuite/tests/simplCore/should_compile/T14186.hs b/testsuite/tests/simplCore/should_compile/T14186.hs
new file mode 100644
index 0000000..1fe1d6a
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T14186.hs
@@ -0,0 +1,4 @@
+module T14186 where
+
+foo f g (x, xs) = (f (g x), map (f . g) xs)
+bar f g (x, xs) = (f (g x), map (f . g) xs)
diff --git a/testsuite/tests/simplCore/should_compile/T14186.stderr b/testsuite/tests/simplCore/should_compile/T14186.stderr
new file mode 100644
index 0000000..ccc9bd9
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T14186.stderr
@@ -0,0 +1,57 @@
+
+==================== Tidy Core ====================
+Result size of Tidy Core
+  = {terms: 52, types: 99, coercions: 0, joins: 0/0}
+
+-- RHS size: {terms: 18, types: 29, coercions: 0, joins: 0/0}
+foo
+  :: forall t1 b t2.
+     (t1 -> b) -> (t2 -> t1) -> (t2, [t2]) -> (b, [b])
+[GblId, Arity=3]
+foo
+  = \ (@ t_aUk)
+      (@ b_aUs)
+      (@ t1_aUo)
+      (f_apH :: t_aUk -> b_aUs)
+      (g_apI :: t1_aUo -> t_aUk)
+      (ds_dVH :: (t1_aUo, [t1_aUo])) ->
+      case ds_dVH of { (x_apJ, xs_apK) ->
+      (f_apH (g_apI x_apJ),
+       map
+         @ t1_aUo @ b_aUs (. @ t_aUk @ b_aUs @ t1_aUo f_apH g_apI) xs_apK)
+      }
+
+-- RHS size: {terms: 18, types: 29, coercions: 0, joins: 0/0}
+bar
+  :: forall t1 b t2.
+     (t1 -> b) -> (t2 -> t1) -> (t2, [t2]) -> (b, [b])
+[GblId, Arity=3]
+bar = foo
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+$trModule1_rVy :: GHC.Prim.Addr#
+[GblId, Caf=NoCafRefs]
+$trModule1_rVy = "main"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+$trModule2_rVX :: GHC.Types.TrName
+[GblId, Caf=NoCafRefs]
+$trModule2_rVX = GHC.Types.TrNameS $trModule1_rVy
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+$trModule3_rVY :: GHC.Prim.Addr#
+[GblId, Caf=NoCafRefs]
+$trModule3_rVY = "T14186"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+$trModule4_rVZ :: GHC.Types.TrName
+[GblId, Caf=NoCafRefs]
+$trModule4_rVZ = GHC.Types.TrNameS $trModule3_rVY
+
+-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
+T14186.$trModule :: GHC.Types.Module
+[GblId, Caf=NoCafRefs]
+T14186.$trModule = GHC.Types.Module $trModule2_rVX $trModule4_rVZ
+
+
+
diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T
index 82a5124..3eae1ff 100644
--- a/testsuite/tests/simplCore/should_compile/all.T
+++ b/testsuite/tests/simplCore/should_compile/all.T
@@ -269,4 +269,8 @@ test('T12600',
      ['$MAKE -s --no-print-directory T12600'])
 test('T13658', normal, compile, ['-dcore-lint'])
 test('T13708', normal, compile, [''])
-test('T14137', normal, compile, ['-dsuppress-uniques -ddump-simpl'])
+
+# thunk should inline here, so check whether or not it appears in the Core
+test('T14137', [ check_errmsg(r'thunk') ], compile, ['-dsuppress-uniques -ddump-simpl'])
+# bar and foo should CSEd here, so check for that in the Core
+test('T14186', [ only_ways(['optasm']), check_errmsg(r'bar = foo'), expect_broken(14186) ], compile, ['-ddump-simpl'])
diff --git a/testsuite/tests/stranal/should_compile/all.T b/testsuite/tests/stranal/should_compile/all.T
index d8fc757..4421b24 100644
--- a/testsuite/tests/stranal/should_compile/all.T
+++ b/testsuite/tests/stranal/should_compile/all.T
@@ -1,19 +1,6 @@
 # Only compile with optimisation
 setTestOpts( only_ways(['optasm']) )
 
-def checkCoreString(needle):
-    def norm(str):
-        if needle in str:
-            return "%s contained in -ddump-simpl\n" % needle
-        else:
-            return "%s not contained in -ddump-simpl\n" % needle
-    return normalise_errmsg_fun(norm)
-
-def grepCoreString(needle):
-    def norm(str):
-        return "".join(filter(lambda l: re.search(needle, l), str.splitlines(True)))
-    return normalise_errmsg_fun(norm)
-
 test('default', normal, compile, [''])
 test('fact', normal, compile, [''])
 test('fun', normal, compile, [''])
@@ -39,15 +26,15 @@ test('T8743', [], multimod_compile, ['T8743', '-v0'])
 #   with two unboxed args.  See Trac #10482 for background
 #
 # Set -dppr-cols to ensure output doesn't wrap
-test('T10482',  [ grepCoreString(r'wfoo.*Int#') ], compile, ['-dppr-cols=200 -ddump-simpl'])
-test('T10482a', [ grepCoreString(r'wf.*Int#') ],   compile, ['-dppr-cols=200 -ddump-simpl'])
+test('T10482',  [ grep_errmsg(r'wfoo.*Int#') ], compile, ['-dppr-cols=200 -ddump-simpl'])
+test('T10482a', [ grep_errmsg(r'wf.*Int#') ],   compile, ['-dppr-cols=200 -ddump-simpl'])
 
 test('T9208', when(compiler_debugged(), expect_broken(9208)), compile, [''])
 # T9208 fails (and should do so) if you have assertion checking on in the compiler
 # Hence the above expect_broken.  See comments in the Trac ticket
 
-test('T10694', [ grepCoreString(r'Str=') ],   compile, ['-dppr-cols=200 -ddump-simpl'])
-test('T11770', [ checkCoreString('OneShot') ], compile, ['-ddump-simpl'])
+test('T10694', [ grep_errmsg(r'Str=') ],   compile, ['-dppr-cols=200 -ddump-simpl'])
+test('T11770', [ check_errmsg('OneShot') ], compile, ['-ddump-simpl'])
 
 test('T13031', normal, run_command,
          ['$MAKE -s --no-print-directory T13031'])