diff options
| -rw-r--r-- | compiler/ghci/ByteCodeGen.hs | 11 | ||||
| -rw-r--r-- | testsuite/tests/ghci/should_run/T12128.hs | 14 | ||||
| -rw-r--r-- | testsuite/tests/ghci/should_run/T12128.script | 1 | ||||
| -rw-r--r-- | testsuite/tests/ghci/should_run/all.T | 1 |
4 files changed, 27 insertions, 0 deletions
diff --git a/compiler/ghci/ByteCodeGen.hs b/compiler/ghci/ByteCodeGen.hs index 0d4c64b4d1..8839ffa544 100644 --- a/compiler/ghci/ByteCodeGen.hs +++ b/compiler/ghci/ByteCodeGen.hs @@ -1327,6 +1327,12 @@ pushAtom d p e pushAtom _ _ (AnnCoercion {}) -- Coercions are zero-width things, = return (nilOL, 0) -- treated just like a variable V +-- See Note [Empty case alternatives] in coreSyn/CoreSyn.hs +-- and Note [Bottoming expressions] in coreSyn/CoreUtils.hs: +-- The scrutinee of an empty case evaluates to bottom +pushAtom d p (AnnCase (_, a) _ _ []) -- trac #12128 + = pushAtom d p a + pushAtom d p (AnnVar v) | UnaryRep rep_ty <- repType (idType v) , V <- typeArgRep rep_ty @@ -1627,6 +1633,11 @@ atomPrimRep :: AnnExpr' Id ann -> PrimRep atomPrimRep e | Just e' <- bcView e = atomPrimRep e' atomPrimRep (AnnVar v) = bcIdPrimRep v atomPrimRep (AnnLit l) = typePrimRep (literalType l) + +-- Trac #12128: +-- A case expresssion can be an atom because empty cases evaluate to bottom. +-- See Note [Empty case alternatives] in coreSyn/CoreSyn.hs +atomPrimRep (AnnCase _ _ ty _) = ASSERT(typePrimRep ty == PtrRep) PtrRep atomPrimRep (AnnCoercion {}) = VoidRep atomPrimRep other = pprPanic "atomPrimRep" (ppr (deAnnotate' other)) diff --git a/testsuite/tests/ghci/should_run/T12128.hs b/testsuite/tests/ghci/should_run/T12128.hs new file mode 100644 index 0000000000..0194910313 --- /dev/null +++ b/testsuite/tests/ghci/should_run/T12128.hs @@ -0,0 +1,14 @@ +{- + This code produces an empty case statement, which + panics the bytecode generator after trac #11155. +-} + +module ShouldCompile where + +import GHC.TypeLits (Symbol) +import Unsafe.Coerce + +instance Read Symbol where + readsPrec = unsafeCoerce (readsPrec :: Int -> ReadS String) + +data Bar = TyCon !Symbol deriving (Read) diff --git a/testsuite/tests/ghci/should_run/T12128.script b/testsuite/tests/ghci/should_run/T12128.script new file mode 100644 index 0000000000..8873ce284e --- /dev/null +++ b/testsuite/tests/ghci/should_run/T12128.script @@ -0,0 +1 @@ +:load T12128 diff --git a/testsuite/tests/ghci/should_run/all.T b/testsuite/tests/ghci/should_run/all.T index 08fe33d166..f7e501847c 100644 --- a/testsuite/tests/ghci/should_run/all.T +++ b/testsuite/tests/ghci/should_run/all.T @@ -24,3 +24,4 @@ test('T10145', just_ghci, ghci_script, ['T10145.script']) test('T7253', just_ghci, ghci_script, ['T7253.script']) test('T11328', just_ghci, ghci_script, ['T11328.script']) test('T11825', just_ghci, ghci_script, ['T11825.script']) +test('T12128', just_ghci, ghci_script, ['T12128.script']) |