Opened 5 years ago

Closed 5 years ago

#7453 closed bug (fixed)

unsafe coerce without extensions

Reported by: guest Owned by: igloo
Priority: normal Milestone:
Component: Compiler (Type checker) Version: 7.6.1
Keywords: Cc: pho@…, ekmett@…,…, emertens@…, pumpkingod@…
Operating System: Unknown/Multiple Architecture: Unknown/Multiple
Type of failure: GHC accepts invalid program Test Case: T7453
Blocked By: Blocking:
Related Tickets: Differential Rev(s):
Wiki Page:


The following program implements an unsafe coerce and works on versions of GHC at least as far back as 7.0.3 but is fixed in HEAD. I'm reporting this because I don't know if it was fixed on purpose and might merit at least a fix to the 7.6.X branch if not the 7.4.X branch (due to its use in the platform)

newtype Id a = Id { runId :: a }

-- Providing this type triggers a type-error
-- cast :: a -> b
cast v = runId z
  z :: Id v
  z = aux
    aux = Id v

Example usage:

*Main> map cast [97..107 :: Int] :: String

*Main> cast (Just True) :: String
"\-1152921504589708267Segmentation fault: 11

Change History (16)

comment:1 Changed 5 years ago by guest

Reported by Eric Mertens <emertens@…> with help from Edward A. Kmett <ekmett@…> after I encountering this bug in the course of using one of his libraries.

comment:2 Changed 5 years ago by PHO

Cc: pho@… added

comment:3 Changed 5 years ago by ekmett

You don't even need a newtype:

ghci> let unsafeCoerce v = z () where z :: () -> v; z = aux where aux = const v

comment:4 Changed 5 years ago by pumpkin

You don't even need to use the aux (the where block must be there, and do that, though):

let unsafeCoerce v = z () where z :: () -> v; z = const v where _ = const v

comment:5 Changed 5 years ago by ekmett

Cc: ekmett@… added

z can be simplified

let unsafeCoerce v = z where z :: v; z = v where aux = const v

Note: this doesn't happen if you use aux _ = v

comment:6 Changed 5 years ago by ion1

Cc:… added

comment:7 Changed 5 years ago by ion1

This has some security implications as well.

% mueval -e 'let unsafeCoerce v = z where z :: v; z = v where aux = const v in (unsafeCoerce (putStrLn "evil IO action") :: () -> ()) ()'
evil IO action

comment:8 Changed 5 years ago by glguy

Cc: emertens@… added

comment:9 Changed 5 years ago by pumpkin

Cc: pumpkingod@… added

comment:10 Changed 5 years ago by igloo

difficulty: Unknown
Test Case: T7453

Added as a regression test, thanks.

comment:11 Changed 5 years ago by simonpj

Resolution: wontfix
Status: newclosed

Well this is embarrassing. It looks as if there's been a missing (or missed) skolem-escape check in GHC for a long time. I re-engineered and simplified the bit that deals with inferring types for bindings, after 7.6, so I expect that's what has fixed it.

I'm not very keen on peering into the bowels of 7.6 to find out what is going on, though; it's clearly not that easy to trip over if it's been around for so long without anyone noticing. If you are worried about security, use -dcore-lint, which picks up the bug right away.

So for now I'll mark it as "wont-fix" meaning "fixed in HEAD, wont-fix in 7.6". Is that acceptable?


comment:12 Changed 5 years ago by simonmar

Hmm, now that we have Safe Haskell, bugs that expose holes in the type system are more serious. I don't think we ought to leave this unfixed in 7.6.2.

comment:13 Changed 5 years ago by simonpj

Resolution: wontfix
Status: closednew

comment:14 Changed 5 years ago by simonpj

Here is a fix for the 7.6 branch

commit b637a24dbb471d99887e5544037a2abe10af26ee
Author: Simon Peyton Jones <>
Date:   Mon Dec 3 16:57:30 2012 +0000

    Fix Trac #7453 on the 7.6 branch
    This patch fixes a quite egregious bug. runTcS was intialising
    the 'untouchables' to NoUntouchables, which is quite wrong for
    the invocation in TcSimplify.simplifyInfer.  Result: missed
    skolem-escape check and seg-fault city.
    All this is done differently, and better, in HEAD, so this
    patch is needed only on the branch.


 compiler/typecheck/TcSMonad.lhs |   10 +++++++++-
 1 files changed, 9 insertions(+), 1 deletions(-)

diff --git a/compiler/typecheck/TcSMonad.lhs b/compiler/typecheck/TcSMonad.lhs index eaaa8f6..8adb1d5 100644
--- a/compiler/typecheck/TcSMonad.lhs
+++ b/compiler/typecheck/TcSMonad.lhs
@@ -935,6 +935,15 @@ runTcSWithEvBinds ev_binds_var tcs
        ; inert_var <- TcM.newTcRef is 
        ; wl_var <- TcM.newTcRef wl
+       -- The "low end" of the untouchable range should come from the
+       -- ambient tcl_untch; the high end is the highest allocated to
+       -- date. 'untouch' used (in 7.6.1, entirely wrongly) to be
+       -- set to NoUntouchables, causing #7453.
+       -- All this is done much better in 7.8.
+       ; tc_lenv <- TcM.getLclEnv
+       ; tcm_high <- TcM.readTcRef (tcl_meta tc_lenv)
+       ; let untouch = TouchableRange tcm_low tcm_high
+             tcm_low = tcl_untch tc_lenv
        ; let env = TcSEnv { tcs_ev_binds = ev_binds_var
                           , tcs_ty_binds = ty_binds_var
                           , tcs_untch    = (untouch, emptyVarSet) -- No Tcs untouchables yet
@@ -960,7 +969,6 @@ runTcSWithEvBinds ev_binds_var tcs
        ; return res }
     do_unification (tv,ty) = TcM.writeMetaTyVar tv ty
-    untouch = NoUntouchables
     is = emptyInert
     wl = emptyWorkList

comment:15 Changed 5 years ago by simonpj

Owner: set to igloo

OK I think that fixes the 7.6 branch. Ian can you double check? I'm not sure not sure if it's worth adding a regression test to the branch or not.


comment:16 Changed 5 years ago by igloo

Resolution: fixed
Status: newclosed

It now works (i.e. is rejected with an error) in the 7.6 branch.

Note: See TracTickets for help on using tickets.