diff --git a/testsuite/tests/ghc-api/T25577.hs b/testsuite/tests/ghc-api/T25577.hs new file mode 100644 index 0000000000000000000000000000000000000000..036c3c73b8f16a0b04bf3a02599c651e6ed77e76 --- /dev/null +++ b/testsuite/tests/ghc-api/T25577.hs @@ -0,0 +1,40 @@ +{-# LANGUAGE BangPatterns #-} + +module Main where + +import GHC +import GHC.Paths +import Unsafe.Coerce +import Control.Monad.IO.Class +import System.Environment (getArgs) +import Control.Monad (unless) + +main :: IO () +main = do + [libdir] <- getArgs + runGhc (Just libdir) run + +run :: Ghc () +run = do + dyn_flags <- getSessionDynFlags + _ <- setSessionDynFlags dyn_flags + + setContext [ IIDecl . simpleImportDecl . mkModuleName $ "Prelude" + , IIDecl . simpleImportDecl . mkModuleName $ "Unsafe.Coerce" ] + + wrong + +expected :: Double +expected = 5.5626902089526504e-303 + +wrong :: Ghc () +wrong = do + let chck = "5.5626902089526504e-303 :: Double" + v <- compileExpr chck + let !v' = unsafeCoerce v :: Double + unless (v' == expected) $ fail "case 1 failed" + + let chck2 = "5.5626902089526504e-303 :: Rational" + v2 <- compileExpr chck2 + let !v2' = unsafeCoerce v2 :: Rational + unless (realToFrac v2' == expected) $ fail "case 2 failed" diff --git a/testsuite/tests/ghc-api/all.T b/testsuite/tests/ghc-api/all.T index 26fa1859549295c1b1ac1084b8193b0b76636038..02f38a3aee60865576e176fba6fcdfa523bf5337 100644 --- a/testsuite/tests/ghc-api/all.T +++ b/testsuite/tests/ghc-api/all.T @@ -42,3 +42,8 @@ test('T20757', [unless(opsys('mingw32'), skip), exit_code(1), normalise_version( compile_and_run, ['-package ghc']) test('PrimOpEffect_Sanity', normal, compile_and_run, ['-Wall -Werror -package ghc']) +test('T25577', [ extra_run_opts(f'"{config.libdir}"') + # doesn't work in wasm/js due to lack of pipe(2) + # support + , when(arch('wasm32') or arch('javascript'), skip) + ], compile_and_run, ['-package ghc'])