diff --git a/ghc/tests/typecheck/should_compile/tc096.stderr b/ghc/tests/typecheck/should_compile/tc096.stderr
new file mode 100644
index 0000000000000000000000000000000000000000..a5e5580974bdcba1b6d0b37fd3b8ca2618bd5f4d
--- /dev/null
+++ b/ghc/tests/typecheck/should_compile/tc096.stderr
@@ -0,0 +1,6 @@
+ghc: module version changed to 1; reason: no old .hi file
+_exports_
+ShouldSucceed main x;
+_declarations_
+1 main _:_ PrelIOBase.IO PrelBase.() ;;
+1 x _:_ PrelBase.Double ;;
diff --git a/ghc/tests/typecheck/should_compile/tc097.hs b/ghc/tests/typecheck/should_compile/tc097.hs
new file mode 100644
index 0000000000000000000000000000000000000000..fac0101a2db7c39fd8222de6f9b8c5dbcd20cf11
--- /dev/null
+++ b/ghc/tests/typecheck/should_compile/tc097.hs
@@ -0,0 +1,10 @@
+--!!! Local universal quantification.
+module ShouldSucceed where
+
+import PrelGHC -- to get at All
+
+data Monad2 m = MkMonad2 (All a => a -> m a)
+                         ((All a, All b) =>  m a -> (a -> m b) -> m b)
+
+halfListMonad  :: ((All a, All b) => [a] -> (a -> [b]) -> [b]) -> Monad2 []
+halfListMonad b = MkMonad2 (\x -> [x]) b
diff --git a/ghc/tests/typecheck/should_compile/tc097.stderr b/ghc/tests/typecheck/should_compile/tc097.stderr
new file mode 100644
index 0000000000000000000000000000000000000000..19704af617c2138c980289e69646c2598e1bc4ec
--- /dev/null
+++ b/ghc/tests/typecheck/should_compile/tc097.stderr
@@ -0,0 +1,9 @@
+ghc: module version changed to 1; reason: no old .hi file
+_exports_
+ShouldSucceed halfListMonad Monad2(MkMonad2);
+_instances_
+instance _forall_ [a :: (* -> *)] => {PrelBase.Eval (Monad2 a)} = $dEvalMonad20;
+_declarations_
+1 $dEvalMonad20 _:_ _forall_ [a :: (* -> *)] => {PrelBase.Eval (Monad2 a)} ;;
+1 data Monad2 m :: (* -> *) = MkMonad2 (_forall_ [a] => a -> m a) (_forall_ [a b] => m a -> (a -> m b) -> m b) ;
+1 halfListMonad _:_ (_forall_ [a b] => [a] -> (a -> [b]) -> [b]) -> Monad2 PrelBase.[] ;;