[commit: ghc] wip/T9858-typeable-ben2: Accept more test output (4a3e411)
git at git.haskell.org
git at git.haskell.org
Sat Sep 26 21:52:30 UTC 2015
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/T9858-typeable-ben2
Link : http://ghc.haskell.org/trac/ghc/changeset/4a3e411c43290bdb4726f191199baedd685112b1/ghc
>---------------------------------------------------------------
commit 4a3e411c43290bdb4726f191199baedd685112b1
Author: Ben Gamari <ben at smart-cactus.org>
Date: Wed Sep 23 21:57:49 2015 +0200
Accept more test output
>---------------------------------------------------------------
4a3e411c43290bdb4726f191199baedd685112b1
compiler/deSugar/DsBinds.hs | 2 +-
.../tests/ghci.debugger/scripts/print018.stdout | 6 +++---
testsuite/tests/ghci/scripts/T8674.stdout | 4 +---
testsuite/tests/roles/should_compile/Roles3.stderr | 25 ++++++++++++++++++++++
.../tests/simplCore/should_compile/T3234.stderr | 4 ++--
.../tests/typecheck/should_fail/T9858a.stderr | 6 +++---
.../tests/typecheck/should_fail/T9858b.stderr | 5 ++---
.../should_fail/TcStaticPointersFail02.stderr | 4 +---
8 files changed, 38 insertions(+), 18 deletions(-)
diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs
index 4887354..57f463c 100644
--- a/compiler/deSugar/DsBinds.hs
+++ b/compiler/deSugar/DsBinds.hs
@@ -945,7 +945,7 @@ ds_ev_typeable ty (EvTypeableTyLit _)
-- typeLitTypeRep :: String -> TypeRep
-- ; let finst = mkTyApps (Var ctr) [ty]
-- proxy = mkTyApps (Var proxyHashId) [typeKind ty, ty]
- ; tag <- mkStringExpr str
+ ; let tag = Lit $ MachStr $ fastStringToByteString $ mkFastString str
; return (mkApps (Var ctr) [tag]) }
where
str
diff --git a/testsuite/tests/ghci.debugger/scripts/print018.stdout b/testsuite/tests/ghci.debugger/scripts/print018.stdout
index d5b7d46..a00d537 100644
--- a/testsuite/tests/ghci.debugger/scripts/print018.stdout
+++ b/testsuite/tests/ghci.debugger/scripts/print018.stdout
@@ -3,9 +3,9 @@ Stopped at ../Test.hs:40:1-17
_result :: () = _
Stopped at ../Test.hs:40:10-17
_result :: () = _
-x :: a17 = _
-x = (_t1::a17)
-x :: a17
+x :: a36 = _
+x = (_t1::a36)
+x :: a36
()
x = Unary
x :: Unary
diff --git a/testsuite/tests/ghci/scripts/T8674.stdout b/testsuite/tests/ghci/scripts/T8674.stdout
index 6c13176..45d4f0a 100644
--- a/testsuite/tests/ghci/scripts/T8674.stdout
+++ b/testsuite/tests/ghci/scripts/T8674.stdout
@@ -1,5 +1,3 @@
-type role Sing nominal
-data family Sing (a :: k)
- -- Defined at T8674.hs:4:1
+data family Sing (a :: k) -- Defined at T8674.hs:4:1
data instance Sing Bool = SBool -- Defined at T8674.hs:6:15
data instance Sing a = SNil -- Defined at T8674.hs:5:15
diff --git a/testsuite/tests/roles/should_compile/Roles3.stderr b/testsuite/tests/roles/should_compile/Roles3.stderr
index 6f25b63..483b349 100644
--- a/testsuite/tests/roles/should_compile/Roles3.stderr
+++ b/testsuite/tests/roles/should_compile/Roles3.stderr
@@ -26,4 +26,29 @@ Dependent packages: [base-4.8.2.0, ghc-prim-0.4.0.0,
integer-gmp-1.0.0.0]
==================== Typechecker ====================
+Roles3.$tcC4
+ = TyCon
+ 12861862461396457184##
+ 6389612623460961504##
+ Roles3.$trModule
+ (TrNameS "C4"#)
+Roles3.$tcC3
+ = TyCon
+ 5998139369941479154##
+ 6816352641934636458##
+ Roles3.$trModule
+ (TrNameS "C3"#)
+Roles3.$tcC2
+ = TyCon
+ 8833962732139387711##
+ 7891126688522429937##
+ Roles3.$trModule
+ (TrNameS "C2"#)
+Roles3.$tcC1
+ = TyCon
+ 16242970448469140073##
+ 10229725431456576413##
+ Roles3.$trModule
+ (TrNameS "C1"#)
+Roles3.$trModule = Module (TrNameS "main"#) (TrNameS "Roles3"#)
diff --git a/testsuite/tests/simplCore/should_compile/T3234.stderr b/testsuite/tests/simplCore/should_compile/T3234.stderr
index c3591d0..d317991 100644
--- a/testsuite/tests/simplCore/should_compile/T3234.stderr
+++ b/testsuite/tests/simplCore/should_compile/T3234.stderr
@@ -10,7 +10,7 @@
==================== Grand total simplifier statistics ====================
-Total ticks: 45
+Total ticks: 46
14 PreInlineUnconditionally
1 n
@@ -37,7 +37,7 @@ Total ticks: 45
1 foldr/single
1 unpack
1 unpack-list
-1 LetFloatFromLet 1
+2 LetFloatFromLet 2
22 BetaReduction
1 a
1 b
diff --git a/testsuite/tests/typecheck/should_fail/T9858a.stderr b/testsuite/tests/typecheck/should_fail/T9858a.stderr
index a42339e..9cb68e0 100644
--- a/testsuite/tests/typecheck/should_fail/T9858a.stderr
+++ b/testsuite/tests/typecheck/should_fail/T9858a.stderr
@@ -1,9 +1,9 @@
T9858a.hs:28:18: error:
- No instance for (Typeable
- ((() :: Constraint, () :: Constraint) => ()))
+ No instance for (Typeable (() :: Constraint))
arising from a use of ‘cast’
- (maybe you haven't applied a function to enough arguments?)
+ GHC can't yet do polykinded
+ Typeable (() :: Constraint :: Constraint)
In the expression: cast e
In the expression: case cast e of { Just e' -> ecast e' }
In an equation for ‘supercast’:
diff --git a/testsuite/tests/typecheck/should_fail/T9858b.stderr b/testsuite/tests/typecheck/should_fail/T9858b.stderr
index 656ff53..a84c1bd 100644
--- a/testsuite/tests/typecheck/should_fail/T9858b.stderr
+++ b/testsuite/tests/typecheck/should_fail/T9858b.stderr
@@ -1,8 +1,7 @@
T9858b.hs:7:8: error:
- No instance for (Typeable (Eq Int => Int))
- arising from a use of ‘typeRep’
- (maybe you haven't applied a function to enough arguments?)
+ No instance for (Typeable (Eq Int)) arising from a use of ‘typeRep’
+ GHC can't yet do polykinded Typeable (Eq Int :: Constraint)
In the expression: typeRep (Proxy :: Proxy (Eq Int => Int))
In an equation for ‘test’:
test = typeRep (Proxy :: Proxy (Eq Int => Int))
diff --git a/testsuite/tests/typecheck/should_fail/TcStaticPointersFail02.stderr b/testsuite/tests/typecheck/should_fail/TcStaticPointersFail02.stderr
index f63fb47..6237b76 100644
--- a/testsuite/tests/typecheck/should_fail/TcStaticPointersFail02.stderr
+++ b/testsuite/tests/typecheck/should_fail/TcStaticPointersFail02.stderr
@@ -6,8 +6,6 @@ TcStaticPointersFail02.hs:9:6: error:
f1 = static (undefined :: (forall a. a -> a) -> b)
TcStaticPointersFail02.hs:12:6: error:
- No instance for (Typeable (Monad m => a -> m a))
- arising from a static form
- (maybe you haven't applied a function to enough arguments?)
+ No instance for (Typeable m) arising from a static form
In the expression: static return
In an equation for ‘f2’: f2 = static return
More information about the ghc-commits
mailing list