diff --git a/testsuite/tests/codeGen/should_run/T24664a.hs b/testsuite/tests/codeGen/should_run/T24664a.hs new file mode 100644 index 0000000000000000000000000000000000000000..c6988ad1d2a7844162316a5541cb001ee0f74c7a --- /dev/null +++ b/testsuite/tests/codeGen/should_run/T24664a.hs @@ -0,0 +1,27 @@ +-- This program tests the passing of RUBBISH values +-- with the Int64 representation, which were found +-- to by mis-handled by the JS backend in #24664. + +{-# LANGUAGE MagicHash #-} + +module Main where + +import GHC.Exts (Int64#, intToInt64#) + +takesInt64a :: String -> Int64# -> String -> IO () +{-# OPAQUE takesInt64a #-} +-- Idea: This function takes an Int64# but doesn't use it, +-- so that its argument might be turned into a rubbish literal. +-- We don't want WW to remove the argument entirely, so OPAQUE +takesInt64a str1 _ str2 = putStrLn str1 >> putStrLn str2 + +takesInt64b :: Int64# -> IO () +{-# NOINLINE takesInt64b #-} +-- Idea: This function will get a worker that doesn't take an +-- Int64# at all, and the body of that worker will pass a +-- rubbish literal to takesInt64a since no real arg exists. +takesInt64b x = takesInt64a "first string to print" x "second string to print" + +main :: IO () +main = do + takesInt64b (intToInt64# 12345#) diff --git a/testsuite/tests/codeGen/should_run/T24664a.stdout b/testsuite/tests/codeGen/should_run/T24664a.stdout new file mode 100644 index 0000000000000000000000000000000000000000..f3565beac52980e87c84dff546a50e222d0ef4d0 --- /dev/null +++ b/testsuite/tests/codeGen/should_run/T24664a.stdout @@ -0,0 +1,2 @@ +first string to print +second string to print diff --git a/testsuite/tests/codeGen/should_run/T24664b.hs b/testsuite/tests/codeGen/should_run/T24664b.hs new file mode 100644 index 0000000000000000000000000000000000000000..5835d61f9abf85e28d71de5a2f6dc2c34e604eea --- /dev/null +++ b/testsuite/tests/codeGen/should_run/T24664b.hs @@ -0,0 +1,31 @@ +-- This is a variant of T24664a that could reproduce +-- the compiler crash originally observed in #24664. + +{-# LANGUAGE MagicHash #-} + +module Main where + +import GHC.Exts (Int64#, intToInt64#, uncheckedIShiftRL64#) + +takesInt64a :: String -> Int64# -> String -> IO () +{-# OPAQUE takesInt64a #-} +-- Idea: This function takes an Int64# but doesn't use it, +-- so that its argument might be turned into a rubbish literal. +-- We don't want WW to remove the argument entirely, so OPAQUE +takesInt64a str1 _ str2 = putStrLn str1 >> putStrLn str2 + +takesInt64b :: String -> Int64# -> String -> IO () +{-# NOINLINE takesInt64b #-} +-- Idea: This function will get a worker that doesn't take an +-- Int64# at all, and the body of that worker will pass a +-- rubbish literal to takesInt64a since no real arg exists. +takesInt64b s1 x s2 + = takesInt64a (s1 ++ t) (x `uncheckedIShiftRL64#` 13#) (s2 ++ t) + where t = " string to print" + +takesInt64c :: Int64# -> IO () +takesInt64c x = takesInt64b "first" x "second" + +main :: IO () +main = do + takesInt64c (intToInt64# 12345#) diff --git a/testsuite/tests/codeGen/should_run/T24664b.stdout b/testsuite/tests/codeGen/should_run/T24664b.stdout new file mode 100644 index 0000000000000000000000000000000000000000..f3565beac52980e87c84dff546a50e222d0ef4d0 --- /dev/null +++ b/testsuite/tests/codeGen/should_run/T24664b.stdout @@ -0,0 +1,2 @@ +first string to print +second string to print diff --git a/testsuite/tests/codeGen/should_run/all.T b/testsuite/tests/codeGen/should_run/all.T index 4bfa5b3be465cea9544c2409648f7de12f152d7a..6dba6116d4dffc5d10aac634f80ddb1be6a34968 100644 --- a/testsuite/tests/codeGen/should_run/all.T +++ b/testsuite/tests/codeGen/should_run/all.T @@ -243,3 +243,6 @@ test('MulMayOflo_full', test('T24264run', normal, compile_and_run, ['']) test('T24295a', normal, compile_and_run, ['-O -floopification']) test('T24295b', normal, compile_and_run, ['-O -floopification -fpedantic-bottoms']) +test('T24664a', normal, compile_and_run, ['-O']) +test('T24664b', normal, compile_and_run, ['-O']) +