[commit: ghc] master: Add testcase for #11770 (cb9a1e6)
git at git.haskell.org
git at git.haskell.org
Wed Mar 30 07:58:36 UTC 2016
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/cb9a1e6875ac636f7c150ffacc272a2594a192dc/ghc
>---------------------------------------------------------------
commit cb9a1e6875ac636f7c150ffacc272a2594a192dc
Author: Joachim Breitner <mail at joachim-breitner.de>
Date: Wed Mar 30 09:59:09 2016 +0200
Add testcase for #11770
and use normalise_errmsg_fun to check the core output in all.T, instead
relying on code in the Makefile.
>---------------------------------------------------------------
cb9a1e6875ac636f7c150ffacc272a2594a192dc
testsuite/tests/stranal/should_compile/Makefile | 18 -----
.../{T10482.stdout => T10482.stderr} | 0
.../{T10482a.stdout => T10482a.stderr} | 0
.../{T10694.stdout => T10694.stderr} | 0
testsuite/tests/stranal/should_compile/T11770.hs | 11 +++
.../tests/stranal/should_compile/T11770.stderr | 85 ++++++++++++++++++++++
testsuite/tests/stranal/should_compile/all.T | 28 +++++--
7 files changed, 119 insertions(+), 23 deletions(-)
diff --git a/testsuite/tests/stranal/should_compile/Makefile b/testsuite/tests/stranal/should_compile/Makefile
index 1b289c6..9101fbd 100644
--- a/testsuite/tests/stranal/should_compile/Makefile
+++ b/testsuite/tests/stranal/should_compile/Makefile
@@ -1,21 +1,3 @@
TOP=../../..
include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/test.mk
-
-# T10482
-# The intent here is to check that $wfoo has type
-# $wfoo :: Int# -> Int# -> Int
-# with two unboxed args. See Trac #10482 for background
-T10482:
- $(RM) -f T10482.o T10482.hi
- # Set -dppr-cols to ensure output doesn't wrap
- '$(TEST_HC)' $(TEST_HC_OPTS) -dppr-cols=200 -O -c -ddump-simpl T10482.hs | grep 'T10482.*wfoo.*Int'
-
-T10482a:
- $(RM) -f T10482a.o T10482a.hi
- # Set -dppr-cols to ensure output doesn't wrap
- '$(TEST_HC)' $(TEST_HC_OPTS) -dppr-cols=200 -O -c -ddump-simpl T10482a.hs | grep 'wf.*Int'
-
-T10694:
- $(RM) -f T10694.o
- '$(TEST_HC)' $(TEST_HC_OPTS) -O -c -ddump-simpl T10694.hs | grep 'Str='
diff --git a/testsuite/tests/stranal/should_compile/T10482.stdout b/testsuite/tests/stranal/should_compile/T10482.stderr
similarity index 100%
rename from testsuite/tests/stranal/should_compile/T10482.stdout
rename to testsuite/tests/stranal/should_compile/T10482.stderr
diff --git a/testsuite/tests/stranal/should_compile/T10482a.stdout b/testsuite/tests/stranal/should_compile/T10482a.stderr
similarity index 100%
rename from testsuite/tests/stranal/should_compile/T10482a.stdout
rename to testsuite/tests/stranal/should_compile/T10482a.stderr
diff --git a/testsuite/tests/stranal/should_compile/T10694.stdout b/testsuite/tests/stranal/should_compile/T10694.stderr
similarity index 100%
rename from testsuite/tests/stranal/should_compile/T10694.stdout
rename to testsuite/tests/stranal/should_compile/T10694.stderr
diff --git a/testsuite/tests/stranal/should_compile/T11770.hs b/testsuite/tests/stranal/should_compile/T11770.hs
new file mode 100644
index 0000000..6b669f9
--- /dev/null
+++ b/testsuite/tests/stranal/should_compile/T11770.hs
@@ -0,0 +1,11 @@
+module T11770 where
+
+
+foo :: Int -> Int -> Int
+foo 10 c = 0
+foo n c =
+ -- Bar should not be marked as one-shot
+ let bar :: Int -> Int
+ bar n = n + c
+ {-# NOINLINE bar #-}
+ in bar n + foo (bar (n+1)) c
diff --git a/testsuite/tests/stranal/should_compile/T11770.stderr b/testsuite/tests/stranal/should_compile/T11770.stderr
new file mode 100644
index 0000000..82f6a9d
--- /dev/null
+++ b/testsuite/tests/stranal/should_compile/T11770.stderr
@@ -0,0 +1,85 @@
+
+==================== Tidy Core ====================
+Result size of Tidy Core = {terms: 56, types: 25, coercions: 0}
+
+-- RHS size: {terms: 2, types: 0, coercions: 0}
+T11770.$trModule2 :: GHC.Types.TrName
+[GblId,
+ Caf=NoCafRefs,
+ Str=m1,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+ WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 20}]
+T11770.$trModule2 = GHC.Types.TrNameS "main"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0}
+T11770.$trModule1 :: GHC.Types.TrName
+[GblId,
+ Caf=NoCafRefs,
+ Str=m1,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+ WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 40 20}]
+T11770.$trModule1 = GHC.Types.TrNameS "T11770"#
+
+-- RHS size: {terms: 3, types: 0, coercions: 0}
+T11770.$trModule :: GHC.Types.Module
+[GblId,
+ Caf=NoCafRefs,
+ Str=m,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+ WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}]
+T11770.$trModule =
+ GHC.Types.Module T11770.$trModule2 T11770.$trModule1
+
+Rec {
+-- RHS size: {terms: 32, types: 11, coercions: 0}
+T11770.$wfoo [InlPrag=[0], Occ=LoopBreaker]
+ :: GHC.Prim.Int# -> Int -> GHC.Prim.Int#
+[GblId, Arity=2, Caf=NoCafRefs, Str=<S,U><L,U(U)>]
+T11770.$wfoo =
+ \ (ww_s1Mj :: GHC.Prim.Int#) (w_s1Mg :: Int) ->
+ case ww_s1Mj of ds_X1Lc {
+ __DEFAULT ->
+ let {
+ bar_s1LA [InlPrag=NOINLINE] :: Int -> Int
+ [LclId, Arity=1, Str=<S(S),1*U(U)>m {axl-><S(S),1*U(U)>}]
+ bar_s1LA =
+ \ (n_axp :: Int) ->
+ GHC.Num.$fNumInt_$c+ n_axp w_s1Mg } in
+ case bar_s1LA (GHC.Types.I# ds_X1Lc)
+ of _ [Occ=Dead] { GHC.Types.I# x_a1Lp ->
+ case bar_s1LA (GHC.Types.I# (GHC.Prim.+# ds_X1Lc 1#))
+ of _ [Occ=Dead] { GHC.Types.I# ww2_X1MK ->
+ case T11770.$wfoo ww2_X1MK w_s1Mg of ww3_s1Mn { __DEFAULT ->
+ GHC.Prim.+# x_a1Lp ww3_s1Mn
+ }
+ }
+ };
+ 10# -> 0#
+ }
+end Rec }
+
+-- RHS size: {terms: 12, types: 5, coercions: 0}
+foo [InlPrag=INLINE[0]] :: Int -> Int -> Int
+[GblId,
+ Arity=2,
+ Caf=NoCafRefs,
+ Str=<S(S),1*U(U)><L,U(U)>m,
+ Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
+ WorkFree=True, Expandable=True,
+ Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False)
+ Tmpl= \ (w_s1Mf [Occ=Once!] :: Int) (w1_s1Mg [Occ=Once] :: Int) ->
+ case w_s1Mf of _ [Occ=Dead] { GHC.Types.I# ww1_s1Mj [Occ=Once] ->
+ case T11770.$wfoo ww1_s1Mj w1_s1Mg of ww2_s1Mn { __DEFAULT ->
+ GHC.Types.I# ww2_s1Mn
+ }
+ }}]
+foo =
+ \ (w_s1Mf :: Int) (w1_s1Mg :: Int) ->
+ case w_s1Mf of _ [Occ=Dead] { GHC.Types.I# ww1_s1Mj ->
+ case T11770.$wfoo ww1_s1Mj w1_s1Mg of ww2_s1Mn { __DEFAULT ->
+ GHC.Types.I# ww2_s1Mn
+ }
+ }
+
+
+
diff --git a/testsuite/tests/stranal/should_compile/all.T b/testsuite/tests/stranal/should_compile/all.T
index d2fc18d..3ac075b 100644
--- a/testsuite/tests/stranal/should_compile/all.T
+++ b/testsuite/tests/stranal/should_compile/all.T
@@ -1,6 +1,19 @@
# 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, [''])
@@ -20,13 +33,18 @@ test('T8467', normal, compile, [''])
test('T8037', normal, compile, [''])
test('T8743', [ extra_clean(['T8743.o-boot', 'T8743a.hi', 'T8743a.o', 'T8743.hi-boot']) ], multimod_compile, ['T8743', '-v0'])
-# test('T10482', normal, compile, [''])
-
-test('T10482', only_ways(['normal']), run_command, ['$MAKE -s --no-print-directory T10482'])
-test('T10482a', only_ways(['normal']), run_command, ['$MAKE -s --no-print-directory T10482a'])
+# T10482
+# The intent here is to check that $wfoo has type
+# $wfoo :: Int# -> Int# -> Int
+# with two unboxed args. See Trac #10482 for background
+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('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', only_ways(['normal']), run_command, ['$MAKE -s --no-print-directory T10694'])
+test('T10694', [ grepCoreString(r'Str=') ], compile, ['-dppr-cols=200 -ddump-simpl'])
+test('T11770', [ expect_broken(117700), checkCoreString("OneShot") ], compile, ['-ddump-simpl'])
+
+
More information about the ghc-commits
mailing list