[GHC] #15270: TH doesn't verify name types during conversion

#15270: TH doesn't verify name types during conversion -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Template | Version: 8.4.3 Haskell | Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Angerman reported that a use of the [[http://hackage.haskell.org/package /deriving-compat-0.4.2/docs/src/Data.Eq.Deriving.Internal.html#deriveEq1 `deriveEq`]] splice is causing GHC to abort with an assertion failure: {{{#!hs zonkExpr env (HsVar x (L l id)) = ASSERT2( isNothing (isDataConId_maybe id), ppr id ) return (HsVar x (L l (zonkIdOcc env id))) }}} I suspect the `deriveEq1` is calling `varE` with a DataCon name. We should catch this case and throw a better error message. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/15270 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#15270: TH doesn't verify name types during conversion -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Template Haskell | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): If you could figure out which part of `deriving-compat` is doing something infelicitous with `varE`, let me know and I'll fix that separately. :) -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/15270#comment:1 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#15270: TH doesn't verify name types during conversion -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Template Haskell | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): I think my hypothesis may not be quite right, actually. For the record, the failing module is https://github.com/input-output-hk/cardano- sl/blob/e24a7c11203446b7a926acc340db2afedfba1664/core/src/Pos/Core/Script.hs#L31-L33. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/15270#comment:2 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#15270: TH doesn't verify name types during conversion -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Template Haskell | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Description changed by bgamari: Old description:
Angerman reported that a use of the [[http://hackage.haskell.org/package /deriving-compat-0.4.2/docs/src/Data.Eq.Deriving.Internal.html#deriveEq1 `deriveEq`]] splice is causing GHC to abort with an assertion failure: {{{#!hs zonkExpr env (HsVar x (L l id)) = ASSERT2( isNothing (isDataConId_maybe id), ppr id ) return (HsVar x (L l (zonkIdOcc env id))) }}}
I suspect the `deriveEq1` is calling `varE` with a DataCon name. We should catch this case and throw a better error message.
New description: Angerman reported that a use of the [[http://hackage.haskell.org/package /deriving- compat-0.4.2/docs/src/Data.Eq.Deriving.Internal.html#deriveEq1|`deriveEq`]] splice is causing GHC to abort with an assertion failure: {{{#!hs zonkExpr env (HsVar x (L l id)) = ASSERT2( isNothing (isDataConId_maybe id), ppr id ) return (HsVar x (L l (zonkIdOcc env id))) }}} I suspect the `deriveEq1` is calling `varE` with a DataCon name. We should catch this case and throw a better error message. -- -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/15270#comment:3 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#15270: TH doesn't verify name types during conversion -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Template Haskell | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): Actually, I think your hypothesis wasn't too far off, bgamari. Here's a minimal example which triggers the panic: {{{#!hs {-# LANGUAGE TemplateHaskell #-} module Bug where import Language.Haskell.TH.Lib import Language.Haskell.TH.Syntax main :: IO () main = print $(conE (mkNameG_v "ghc-prim" "GHC.Types" "True")) }}} {{{ $ ghc/inplace/bin/ghc-stage2 Bug2.hs [1 of 1] Compiling Bug ( Bug2.hs, Bug2.o ) ghc-stage2: panic! (the 'impossible' happened) (GHC version 8.5.20180616 for x86_64-unknown-linux): ASSERT failed! True Call stack: CallStack (from HasCallStack): callStackDoc, called at compiler/utils/Outputable.hs:1164:37 in ghc:Outputable pprPanic, called at compiler/utils/Outputable.hs:1223:5 in ghc:Outputable assertPprPanic, called at compiler/typecheck/TcHsSyn.hs:655:67 in ghc:TcHsSyn }}} It turns out that I was using `conE (mkNameG_v "ghc-prim" "GHC.Types" "True")` in `deriving-compat`. Oops! -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/15270#comment:4 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#15270: TH doesn't verify name types during conversion -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Template Haskell | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): Interesting, I excluded my hypothesis after noticing that the following testcase indeed fails with a proper error: {{{#!hs {-# LANGUAGE TemplateHaskell #-} module T10047A where import Language.Haskell.TH -- Passing var name to conE should fail. x = $(conE 'id) }}} I didn't look much farther after this. Quite interesting that `mkNameG_v` gets around the error. Are you going to continue looking into this or should I add it to my queue? -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/15270#comment:5 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#15270: TH doesn't verify name types during conversion -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Template Haskell | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): Indeed, this is an odd one. Some other observations: * `conE 'id` fails with: {{{ • Illegal data constructor name: ‘id’ When splicing a TH expression: GHC.Base.id • In the untyped splice: $(conE 'id) }}} * `varE 'True` fails with: {{{ • Illegal variable name: ‘True’ When splicing a TH expression: GHC.Types.True • In the untyped splice: $(varE 'True) }}} * Finally, `$(varE (mkNameG_d "base" "GHC.Base" "id"))` fails with: {{{ • Can't find interface-file declaration for data constructor GHC.Base.id Probable cause: bug in .hi-boot file, or inconsistent .hi file Use -ddump-if-trace to get an idea of which file caused the error • In the expression: (GHC.Base.id) In an equation for ‘it’: it = (GHC.Base.id) }}} I suppose we want something like that last error if we try to use `$(conE (mkNameG_v "ghc-prim" "GHC.Types" "True"))` as in comment:4. That being said, I can't figure out why we don't //currently// get that error. After all, that error message is caused by looking up a `Name` in an EPS and failing, so if `$(conE (mkNameG_v "ghc-prim" "GHC.Types" "True"))` isn't erroring, does that mean that a value named `True` //is// located in the EPS? I'm afraid I don't know how to proceed at this point, so do you think you could look at this, Ben? -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/15270#comment:6 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#15270: TH doesn't verify name types during conversion -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Template Haskell | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4859 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * differential: => Phab:D4859 Comment: Have the beginning of some tests as Phab:D4859. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/15270#comment:7 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#15270: TH doesn't verify name types during conversion
-------------------------------------+-------------------------------------
Reporter: bgamari | Owner: (none)
Type: bug | Status: new
Priority: normal | Milestone: 8.8.1
Component: Template Haskell | Version: 8.4.3
Resolution: | Keywords:
Operating System: Unknown/Multiple | Architecture:
| Unknown/Multiple
Type of failure: None/Unknown | Test Case:
Blocked By: | Blocking:
Related Tickets: | Differential Rev(s): Phab:D4859
Wiki Page: |
-------------------------------------+-------------------------------------
Comment (by Ben Gamari
participants (1)
-
GHC