summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--compiler/GHC/Runtime/Eval.hs11
-rw-r--r--testsuite/tests/ghci.debugger/scripts/T10616.hs6
-rw-r--r--testsuite/tests/ghci.debugger/scripts/T10616.script4
-rw-r--r--testsuite/tests/ghci.debugger/scripts/T10616.stdout6
-rw-r--r--testsuite/tests/ghci.debugger/scripts/T10617.hs15
-rw-r--r--testsuite/tests/ghci.debugger/scripts/T10617.script4
-rw-r--r--testsuite/tests/ghci.debugger/scripts/T10617.stdout6
-rw-r--r--testsuite/tests/ghci.debugger/scripts/all.T2
8 files changed, 49 insertions, 5 deletions
diff --git a/compiler/GHC/Runtime/Eval.hs b/compiler/GHC/Runtime/Eval.hs
index c514cd105b..343f021a45 100644
--- a/compiler/GHC/Runtime/Eval.hs
+++ b/compiler/GHC/Runtime/Eval.hs
@@ -573,7 +573,7 @@ bindLocalsAtBreakpoint hsc_env apStack_fhv (Just BreakInfo{..}) = do
(ids, offsets, occs') = syncOccs mbPointers occs
- free_tvs = tyCoVarsOfTypesList (result_ty:map idType ids)
+ free_tvs = tyCoVarsOfTypesWellScoped (result_ty:map idType ids)
-- It might be that getIdValFromApStack fails, because the AP_STACK
-- has been accidentally evaluated, or something else has gone wrong.
@@ -623,10 +623,11 @@ bindLocalsAtBreakpoint hsc_env apStack_fhv (Just BreakInfo{..}) = do
newTyVars :: UniqSupply -> [TcTyVar] -> TCvSubst
-- Similarly, clone the type variables mentioned in the types
-- we have here, *and* make them all RuntimeUnk tyvars
- newTyVars us tvs
- = mkTvSubstPrs [ (tv, mkTyVarTy (mkRuntimeUnkTyVar name (tyVarKind tv)))
- | (tv, uniq) <- tvs `zip` uniqsFromSupply us
- , let name = setNameUnique (tyVarName tv) uniq ]
+ newTyVars us tvs = foldl' new_tv emptyTCvSubst (tvs `zip` uniqsFromSupply us)
+ new_tv subst (tv,uniq) = extendTCvSubstWithClone subst tv new_tv
+ where
+ new_tv = mkRuntimeUnkTyVar (setNameUnique (tyVarName tv) uniq)
+ (substTy subst (tyVarKind tv))
isPointer id | [rep] <- typePrimRep (idType id)
, isGcPtrRep rep = True
diff --git a/testsuite/tests/ghci.debugger/scripts/T10616.hs b/testsuite/tests/ghci.debugger/scripts/T10616.hs
new file mode 100644
index 0000000000..f4339ab279
--- /dev/null
+++ b/testsuite/tests/ghci.debugger/scripts/T10616.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE PolyKinds #-}
+
+data D a = A | B
+
+f d@A = const True d
+f B = False
diff --git a/testsuite/tests/ghci.debugger/scripts/T10616.script b/testsuite/tests/ghci.debugger/scripts/T10616.script
new file mode 100644
index 0000000000..a711d4e6ac
--- /dev/null
+++ b/testsuite/tests/ghci.debugger/scripts/T10616.script
@@ -0,0 +1,4 @@
+:l T10616.hs
+:break f
+f A
+:continue
diff --git a/testsuite/tests/ghci.debugger/scripts/T10616.stdout b/testsuite/tests/ghci.debugger/scripts/T10616.stdout
new file mode 100644
index 0000000000..a88ee3f583
--- /dev/null
+++ b/testsuite/tests/ghci.debugger/scripts/T10616.stdout
@@ -0,0 +1,6 @@
+Breakpoint 0 activated at T10616.hs:5:9-20
+Breakpoint 1 activated at T10616.hs:6:7-11
+Stopped in Main.f, T10616.hs:5:9-20
+_result :: Bool = _
+d :: D a = A
+True
diff --git a/testsuite/tests/ghci.debugger/scripts/T10617.hs b/testsuite/tests/ghci.debugger/scripts/T10617.hs
new file mode 100644
index 0000000000..bc649a7c63
--- /dev/null
+++ b/testsuite/tests/ghci.debugger/scripts/T10617.hs
@@ -0,0 +1,15 @@
+{-# LANGUAGE GADTs, StandaloneKindSignatures, PolyKinds, RankNTypes #-}
+
+import GHC.Types (Type)
+
+type AppTreeT :: forall k. k -> Type
+data AppTreeT a where
+ Con :: AppTreeT a
+ App :: AppTreeT a -> AppTreeT b -> AppTreeT (a b)
+
+tmt :: AppTreeT (Maybe Bool)
+tmt = App (Con :: AppTreeT Maybe) Con
+
+f :: AppTreeT a -> Bool
+f (App (c@Con) _) = const True c
+f _ = False
diff --git a/testsuite/tests/ghci.debugger/scripts/T10617.script b/testsuite/tests/ghci.debugger/scripts/T10617.script
new file mode 100644
index 0000000000..cc5320695e
--- /dev/null
+++ b/testsuite/tests/ghci.debugger/scripts/T10617.script
@@ -0,0 +1,4 @@
+:l T10617.hs
+:break f
+f tmt
+:continue
diff --git a/testsuite/tests/ghci.debugger/scripts/T10617.stdout b/testsuite/tests/ghci.debugger/scripts/T10617.stdout
new file mode 100644
index 0000000000..4539e6323e
--- /dev/null
+++ b/testsuite/tests/ghci.debugger/scripts/T10617.stdout
@@ -0,0 +1,6 @@
+Breakpoint 0 activated at T10617.hs:14:21-32
+Breakpoint 1 activated at T10617.hs:15:7-11
+Stopped in Main.f, T10617.hs:14:21-32
+_result :: Bool = _
+c :: AppTreeT a1 = Con
+True
diff --git a/testsuite/tests/ghci.debugger/scripts/all.T b/testsuite/tests/ghci.debugger/scripts/all.T
index 3f1fc88644..4ed1fc046e 100644
--- a/testsuite/tests/ghci.debugger/scripts/all.T
+++ b/testsuite/tests/ghci.debugger/scripts/all.T
@@ -111,6 +111,8 @@ test('getargs', extra_files(['../getargs.hs']), ghci_script, ['getargs.script'])
test('T7386', normal, ghci_script, ['T7386.script'])
test('T8487', normal, ghci_script, ['T8487.script'])
test('T8557', normal, ghci_script, ['T8557.script'])
+test('T10616', normal, ghci_script, ['T10616.script'])
+test('T10617', normal, ghci_script, ['T10617.script'])
test('T12449', normal, ghci_script, ['T12449.script'])
test('T12458', normal, ghci_script, ['T12458.script'])
test('T13825-debugger',