summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/typecheck/TcErrors.hs24
-rw-r--r--compiler/typecheck/TcOrigin.hs3
-rw-r--r--testsuite/tests/ghci.debugger/scripts/T14628.hs14
-rw-r--r--testsuite/tests/ghci.debugger/scripts/T14628.script4
-rw-r--r--testsuite/tests/ghci.debugger/scripts/T14628.stderr12
-rw-r--r--testsuite/tests/ghci.debugger/scripts/T14628.stdout5
-rw-r--r--testsuite/tests/ghci.debugger/scripts/all.T1
7 files changed, 52 insertions, 11 deletions
diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs
index b20fb55e11..9557efa40c 100644
--- a/compiler/typecheck/TcErrors.hs
+++ b/compiler/typecheck/TcErrors.hs
@@ -1762,8 +1762,7 @@ suggestAddSig ctxt ty1 ty2
inferred_bndrs = nub (get_inf ty1 ++ get_inf ty2)
get_inf ty | Just tv <- tcGetTyVar_maybe ty
, isSkolemTyVar tv
- , (implic, _) : _ <- getSkolemInfo (cec_encl ctxt) [tv]
- , InferSkol prs <- ic_info implic
+ , ((InferSkol prs, _) : _) <- getSkolemInfo (cec_encl ctxt) [tv]
= map fst prs
| otherwise
= []
@@ -2755,11 +2754,13 @@ pprSkols :: ReportErrCtxt -> [TcTyVar] -> SDoc
pprSkols ctxt tvs
= vcat (map pp_one (getSkolemInfo (cec_encl ctxt) tvs))
where
- pp_one (Implic { ic_info = skol_info }, tvs)
- | UnkSkol <- skol_info
+ pp_one (UnkSkol, tvs)
= hang (pprQuotedList tvs)
2 (is_or_are tvs "an" "unknown")
- | otherwise
+ pp_one (RuntimeUnkSkol, tvs)
+ = hang (pprQuotedList tvs)
+ 2 (is_or_are tvs "an" "unknown runtime")
+ pp_one (skol_info, tvs)
= vcat [ hang (pprQuotedList tvs)
2 (is_or_are tvs "a" "rigid" <+> text "bound by")
, nest 2 (pprSkolInfo skol_info)
@@ -2779,20 +2780,21 @@ getAmbigTkvs ct
dep_tkv_set = tyCoVarsOfTypes (map tyVarKind tkvs)
getSkolemInfo :: [Implication] -> [TcTyVar]
- -> [(Implication, [TcTyVar])]
+ -> [(SkolemInfo, [TcTyVar])] -- #14628
-- Get the skolem info for some type variables
--- from the implication constraints that bind them
+-- from the implication constraints that bind them.
--
--- In the returned (implic, tvs) pairs, the 'tvs' part is non-empty
+-- In the returned (skolem, tvs) pairs, the 'tvs' part is non-empty
getSkolemInfo _ []
= []
getSkolemInfo [] tvs
- = pprPanic "No skolem info:" (ppr tvs)
+ | all isRuntimeUnkSkol tvs = [(RuntimeUnkSkol, tvs)] -- #14628
+ | otherwise = pprPanic "No skolem info:" (ppr tvs)
getSkolemInfo (implic:implics) tvs
- | null tvs_here = getSkolemInfo implics tvs
- | otherwise = (implic, tvs_here) : getSkolemInfo implics tvs_other
+ | null tvs_here = getSkolemInfo implics tvs
+ | otherwise = (ic_info implic, tvs_here) : getSkolemInfo implics tvs_other
where
(tvs_here, tvs_other) = partition (`elem` ic_skols implic) tvs
diff --git a/compiler/typecheck/TcOrigin.hs b/compiler/typecheck/TcOrigin.hs
index fd260f01ac..df7a39f72e 100644
--- a/compiler/typecheck/TcOrigin.hs
+++ b/compiler/typecheck/TcOrigin.hs
@@ -237,6 +237,8 @@ data SkolemInfo
| QuantCtxtSkol -- Quantified context, e.g.
-- f :: forall c. (forall a. c a => c [a]) => blah
+ | RuntimeUnkSkol -- Runtime skolem from the GHCi debugger #14628
+
| UnkSkol -- Unhelpful info (until I improve it)
instance Outputable SkolemInfo where
@@ -267,6 +269,7 @@ pprSkolInfo (DataConSkol name)= text "the data constructor" <+> quotes (ppr name
pprSkolInfo ReifySkol = text "the type being reified"
pprSkolInfo (QuantCtxtSkol {}) = text "a quantified context"
+pprSkolInfo RuntimeUnkSkol = text "Unknown type from GHCi runtime"
-- UnkSkol
-- For type variables the others are dealt with by pprSkolTvBinding.
diff --git a/testsuite/tests/ghci.debugger/scripts/T14628.hs b/testsuite/tests/ghci.debugger/scripts/T14628.hs
new file mode 100644
index 0000000000..b94d9e736e
--- /dev/null
+++ b/testsuite/tests/ghci.debugger/scripts/T14628.hs
@@ -0,0 +1,14 @@
+module T14628 where
+
+import System.IO
+import Control.Monad.IO.Class
+import Control.Monad.Trans.State
+import Text.Printf
+
+putArrayBytes :: Handle -- ^ output file handle
+ -> [String] -- ^ byte-strings
+ -> IO Int -- ^ total number of bytes written
+putArrayBytes outfile xs = do
+ let writeCount x = modify' (+ length x) >> liftIO (putLine x) :: MonadIO m => StateT Int m ()
+ execStateT (mapM_ writeCount xs) 0
+ where putLine = hPutStrLn outfile . (" "++) . concatMap (printf "0x%02X,")
diff --git a/testsuite/tests/ghci.debugger/scripts/T14628.script b/testsuite/tests/ghci.debugger/scripts/T14628.script
new file mode 100644
index 0000000000..4675b515de
--- /dev/null
+++ b/testsuite/tests/ghci.debugger/scripts/T14628.script
@@ -0,0 +1,4 @@
+:l T14628.hs
+:br 12 46
+:trace putArrayBytes stdout [['1'..'9'],['2'..'8'],['3'..'7']]
+snd $ runStateT _result 0
diff --git a/testsuite/tests/ghci.debugger/scripts/T14628.stderr b/testsuite/tests/ghci.debugger/scripts/T14628.stderr
new file mode 100644
index 0000000000..276d63ff38
--- /dev/null
+++ b/testsuite/tests/ghci.debugger/scripts/T14628.stderr
@@ -0,0 +1,12 @@
+<interactive>:4:7:
+ Couldn't match type ‘m’ with ‘(,) a0’
+ ‘m’ is untouchable
+ inside the constraints: ()
+ bound by the inferred type of it :: ((), Int)
+ at <interactive>:4:1-25
+ ‘m’ is an interactive-debugger skolem
+ Expected type: (a0, ((), Int))
+ Actual type: m ((), Int)
+ In the second argument of ‘($)’, namely ‘runStateT _result 0’
+ In the expression: snd $ runStateT _result 0
+ In an equation for ‘it’: it = snd $ runStateT _result 0
diff --git a/testsuite/tests/ghci.debugger/scripts/T14628.stdout b/testsuite/tests/ghci.debugger/scripts/T14628.stdout
new file mode 100644
index 0000000000..9564271f8f
--- /dev/null
+++ b/testsuite/tests/ghci.debugger/scripts/T14628.stdout
@@ -0,0 +1,5 @@
+Breakpoint 0 activated at T14628.hs:12:46-63
+Stopped in T14628.putArrayBytes.writeCount, T14628.hs:12:46-63
+_result :: StateT Int m () = _
+putLine :: [Char] -> IO () = _
+x :: [Char] = "123456789"
diff --git a/testsuite/tests/ghci.debugger/scripts/all.T b/testsuite/tests/ghci.debugger/scripts/all.T
index 297b4c2b76..01662361c4 100644
--- a/testsuite/tests/ghci.debugger/scripts/all.T
+++ b/testsuite/tests/ghci.debugger/scripts/all.T
@@ -113,6 +113,7 @@ test('T13825-debugger',
[when(arch('powerpc64'), expect_broken(14455)),
when(arch('arm'), fragile_for(17557, ['ghci-ext']))],
ghci_script, ['T13825-debugger.script'])
+test('T14628', normal, ghci_script, ['T14628.script'])
test('T14690', normal, ghci_script, ['T14690.script'])
test('T16700', normal, ghci_script, ['T16700.script'])
View Lorry Controller Status