diff options
-rw-r--r-- | compiler/GHC/Runtime/Eval.hs | 11 | ||||
-rw-r--r-- | testsuite/tests/ghci.debugger/scripts/T10616.hs | 6 | ||||
-rw-r--r-- | testsuite/tests/ghci.debugger/scripts/T10616.script | 4 | ||||
-rw-r--r-- | testsuite/tests/ghci.debugger/scripts/T10616.stdout | 6 | ||||
-rw-r--r-- | testsuite/tests/ghci.debugger/scripts/T10617.hs | 15 | ||||
-rw-r--r-- | testsuite/tests/ghci.debugger/scripts/T10617.script | 4 | ||||
-rw-r--r-- | testsuite/tests/ghci.debugger/scripts/T10617.stdout | 6 | ||||
-rw-r--r-- | testsuite/tests/ghci.debugger/scripts/all.T | 2 |
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', |