diff options
author | Zubin Duggal <zubin.duggal@gmail.com> | 2021-06-30 15:56:13 +0530 |
---|---|---|
committer | Zubin <zubin.duggal@gmail.com> | 2021-07-13 20:45:44 +0000 |
commit | 9992159318d0f0c3fcf1c1ae060bb15d0b5fc1a8 (patch) | |
tree | 21d54c9455527aebb683ba8df94824759e0b015d | |
parent | bb8e0df8f4187a4f4d0788dd3da3ef6f9268d378 (diff) | |
download | haskell-9992159318d0f0c3fcf1c1ae060bb15d0b5fc1a8.tar.gz |
Don't panic on 'no skolem info' and add failing testswip/no-skolem-panic
-rw-r--r-- | compiler/GHC/Tc/Errors.hs | 16 | ||||
-rw-r--r-- | compiler/GHC/Utils/Trace.hs | 10 | ||||
-rw-r--r-- | testsuite/tests/ado/T16135.hs | 11 | ||||
-rw-r--r-- | testsuite/tests/ado/all.T | 1 | ||||
-rw-r--r-- | testsuite/tests/typecheck/no_skolem_info/Makefile | 3 | ||||
-rw-r--r-- | testsuite/tests/typecheck/no_skolem_info/T10946_sk.hs | 6 | ||||
-rw-r--r-- | testsuite/tests/typecheck/no_skolem_info/T19482.hs | 17 | ||||
-rw-r--r-- | testsuite/tests/typecheck/no_skolem_info/T19752.hs | 13 | ||||
-rw-r--r-- | testsuite/tests/typecheck/no_skolem_info/T19760.hs | 12 | ||||
-rw-r--r-- | testsuite/tests/typecheck/no_skolem_info/T20063.hs | 26 | ||||
-rw-r--r-- | testsuite/tests/typecheck/no_skolem_info/all.T | 5 |
11 files changed, 117 insertions, 3 deletions
diff --git a/compiler/GHC/Tc/Errors.hs b/compiler/GHC/Tc/Errors.hs index c26dce5161..766b88408d 100644 --- a/compiler/GHC/Tc/Errors.hs +++ b/compiler/GHC/Tc/Errors.hs @@ -74,6 +74,7 @@ import GHC.Utils.FV ( fvVarList, unionFV ) import GHC.Data.Bag import GHC.Data.FastString +import GHC.Utils.Trace (pprTraceUserWarning) import GHC.Data.List.SetOps ( equivClasses ) import GHC.Data.Maybe import qualified GHC.Data.Strict as Strict @@ -2944,8 +2945,11 @@ pprSkols ctxt tvs = vcat (map pp_one (getSkolemInfo (cec_encl ctxt) tvs)) where pp_one (UnkSkol, tvs) - = hang (pprQuotedList tvs) - 2 (is_or_are tvs "an" "unknown") + = vcat [ hang (pprQuotedList tvs) + 2 (is_or_are tvs "a" "(rigid, skolem)") + , nest 2 (text "of unknown origin") + , nest 2 (text "bound at" <+> ppr (foldr1 combineSrcSpans (map getSrcSpan tvs))) + ] pp_one (RuntimeUnkSkol, tvs) = hang (pprQuotedList tvs) 2 (is_or_are tvs "an" "unknown runtime") @@ -2979,7 +2983,13 @@ getSkolemInfo _ [] getSkolemInfo [] tvs | all isRuntimeUnkSkol tvs = [(RuntimeUnkSkol, tvs)] -- #14628 - | otherwise = pprPanic "No skolem info:" (ppr tvs) + | otherwise = -- See https://gitlab.haskell.org/ghc/ghc/-/issues?label_name[]=No%20skolem%20info + pprTraceUserWarning msg [(UnkSkol,tvs)] + where + msg = text "No skolem info - we could not find the origin of the following variables" <+> ppr tvs + $$ text "This should not happen, please report it as a bug following the instructions at:" + $$ text "https://gitlab.haskell.org/ghc/ghc/wikis/report-a-bug" + getSkolemInfo (implic:implics) tvs | null tvs_here = getSkolemInfo implics tvs diff --git a/compiler/GHC/Utils/Trace.hs b/compiler/GHC/Utils/Trace.hs index ac29cd6fd8..5da6e6e5d9 100644 --- a/compiler/GHC/Utils/Trace.hs +++ b/compiler/GHC/Utils/Trace.hs @@ -7,6 +7,7 @@ module GHC.Utils.Trace , pprSTrace , pprTraceException , warnPprTrace + , pprTraceUserWarning , trace ) where @@ -71,6 +72,15 @@ warnPprTrace True msg x (msg $$ withFrozenCallStack traceCallStackDoc ) x +-- | For when we want to show the user a non-fatal WARNING so that they can +-- report a GHC bug, but don't want to panic. +pprTraceUserWarning :: HasCallStack => SDoc -> a -> a +pprTraceUserWarning msg x + | unsafeHasNoDebugOutput = x + | otherwise = pprDebugAndThen defaultSDocContext trace (text "WARNING:") + (msg $$ withFrozenCallStack traceCallStackDoc ) + x + traceCallStackDoc :: HasCallStack => SDoc traceCallStackDoc = hang (text "Call stack:") diff --git a/testsuite/tests/ado/T16135.hs b/testsuite/tests/ado/T16135.hs new file mode 100644 index 0000000000..ff8cc8588e --- /dev/null +++ b/testsuite/tests/ado/T16135.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE ExistentialQuantification, ApplicativeDo #-} + +module Bug where + +data T f = forall a. MkT (f a) + +runf :: forall f. Functor f => IO (T f) +runf = do + return () + MkT fa <- runf + return $ MkT fa diff --git a/testsuite/tests/ado/all.T b/testsuite/tests/ado/all.T index 8c07539965..86e18998b0 100644 --- a/testsuite/tests/ado/all.T +++ b/testsuite/tests/ado/all.T @@ -18,3 +18,4 @@ test('T14163', normal, compile_and_run, ['']) test('T15344', normal, compile_and_run, ['']) test('T16628', normal, compile_fail, ['']) test('T17835', normal, compile, ['']) +test('T16135', when(compiler_debugged(),expect_broken(16135)), compile, ['']) diff --git a/testsuite/tests/typecheck/no_skolem_info/Makefile b/testsuite/tests/typecheck/no_skolem_info/Makefile new file mode 100644 index 0000000000..9101fbd40a --- /dev/null +++ b/testsuite/tests/typecheck/no_skolem_info/Makefile @@ -0,0 +1,3 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk diff --git a/testsuite/tests/typecheck/no_skolem_info/T10946_sk.hs b/testsuite/tests/typecheck/no_skolem_info/T10946_sk.hs new file mode 100644 index 0000000000..c63dd7e30d --- /dev/null +++ b/testsuite/tests/typecheck/no_skolem_info/T10946_sk.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Bug where + +m :: a -> a +m x = $$([||_||]) diff --git a/testsuite/tests/typecheck/no_skolem_info/T19482.hs b/testsuite/tests/typecheck/no_skolem_info/T19482.hs new file mode 100644 index 0000000000..175887bd59 --- /dev/null +++ b/testsuite/tests/typecheck/no_skolem_info/T19482.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE AllowAmbiguousTypes #-} + +module Bug where + +instance BugClass ((s : sx) :: [r]) where + bugList = testF @r @s + +class BugClass k where + bugList :: () + +testF :: forall a (b :: [a]). () +testF = () diff --git a/testsuite/tests/typecheck/no_skolem_info/T19752.hs b/testsuite/tests/typecheck/no_skolem_info/T19752.hs new file mode 100644 index 0000000000..3fd3a68318 --- /dev/null +++ b/testsuite/tests/typecheck/no_skolem_info/T19752.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE ScopedTypeVariables #-} +module Bug where + +type family F a + +g :: forall a. a +g = f + where + f :: (F b ~ a) => a + f = undefined diff --git a/testsuite/tests/typecheck/no_skolem_info/T19760.hs b/testsuite/tests/typecheck/no_skolem_info/T19760.hs new file mode 100644 index 0000000000..eb3ac674cc --- /dev/null +++ b/testsuite/tests/typecheck/no_skolem_info/T19760.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +module Bug where + +import Data.Kind + +f :: forall a (p :: Maybe a -> Type) (m :: Maybe a). p m +f = go + where + go :: forall a' (m' :: Maybe a'). p m' + go = undefined diff --git a/testsuite/tests/typecheck/no_skolem_info/T20063.hs b/testsuite/tests/typecheck/no_skolem_info/T20063.hs new file mode 100644 index 0000000000..f49d5a9ec4 --- /dev/null +++ b/testsuite/tests/typecheck/no_skolem_info/T20063.hs @@ -0,0 +1,26 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE StandaloneKindSignatures #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} + +module Bug where + +data Context where + Extend :: forall k. Context -> Context + +type (:*&) :: Context -> forall k -> Context +type ctx :*& k = Extend @k ctx + +data Idx ctx where + T :: Idx ctx -> Idx (ctx :*& l) + +data Rn ctx1 ctx2 where + U :: Rn ctx1 ctx2 -> Rn (ctx1 :*& l) (ctx2 :*& l) + +rnRename :: Rn ctx1 ctx2 -> Idx ctx3 -> Idx ctx4 +rnRename (U _ ) _ = T _ +rnRename _ T = undefined diff --git a/testsuite/tests/typecheck/no_skolem_info/all.T b/testsuite/tests/typecheck/no_skolem_info/all.T new file mode 100644 index 0000000000..80b4db6a1b --- /dev/null +++ b/testsuite/tests/typecheck/no_skolem_info/all.T @@ -0,0 +1,5 @@ +test('T19752', [expect_broken(19752), grep_errmsg('of unknown origin')], compile_fail, ['']) +test('T20063', [expect_broken(20063), grep_errmsg('of unknown origin')], compile_fail, ['']) +test('T19760', [expect_broken(19760), grep_errmsg('of unknown origin')], compile_fail, ['']) +test('T19482', [expect_broken(19482), grep_errmsg('of unknown origin')], compile_fail, ['']) +test('T10946_sk', [expect_broken(10946), grep_errmsg('of unknown origin')], compile_fail, ['']) |