Commit 0424de2d authored by Ömer Sinan Ağacan's avatar Ömer Sinan Ağacan Committed by Marge Bot

Add test for #16893

parent 422ffce0
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
module Complex
( Type(..)
, OpenComplex(..)
, CloseComplex(..)
, Complex(..)
, closeComplex
) where
import Data.ByteString as B
import Data.ByteString.Short as BS
import Data.Typeable
data Type
= OpenType
| CloseType
data OpenComplex = OpenComplex
{ openComplexSource :: ByteString
}
data CloseComplex = CloseComplex
{ closeComplexHash :: ByteString
, closeComplexSource :: !ByteString
}
data Complex (t :: Type) = Complex
{ complexInner :: !(ComplexFamily t)
}
type family ComplexFamily (t :: Type) where
ComplexFamily 'OpenType = OpenComplex
ComplexFamily 'CloseType = CloseComplex
handleComplex ::
forall t a. Typeable t
=> Complex t
-> (Complex 'CloseType -> a)
-> a
handleComplex complex onClose =
case toCloseComplex complex of
Just receiveComplex -> onClose receiveComplex
Nothing -> undefined
toCloseComplex ::
forall t. Typeable t
=> Complex t
-> Maybe (Complex 'CloseType)
toCloseComplex x = fmap (\Refl -> x) (eqT :: Maybe (t :~: 'CloseType))
closeComplex :: Typeable t => Complex t -> Close
closeComplex complex =
handleComplex
complex
receiveComplexToProtocolCloseComplex
receiveComplexToProtocolCloseComplex :: Complex 'CloseType -> Close
receiveComplexToProtocolCloseComplex Complex {complexInner = inner} =
Close (hashToLink (closeComplexSource inner))
data Close = Close !ShortByteString
hashToLink :: ByteString -> ShortByteString
hashToLink bh = BS.toShort bh
{-# LANGUAGE DataKinds #-}
module Main (main) where
import Complex
badComplex :: Complex 'OpenType
badComplex =
Complex
{ complexInner =
OpenComplex
{ openComplexSource = undefined
}
}
segFaultTrigger :: IO ()
segFaultTrigger =
closeComplex badComplex `seq` pure ()
main :: IO ()
main = segFaultTrigger
test('T16893',
[expect_broken(16893), extra_files(['Complex.hs'])],
compile_and_run,
['-O1'])
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment