[Git][ghc/ghc][master] Add test cases for #24664

[Marge Bot (@marge-bot)]

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
a19201d4 by Matthew Craven at 2024-05-06T19:54:29-04:00
Add test cases for #24664

...since none are present in the original MR !12463 fixing this issue.

- - - - -


5 changed files:

- + testsuite/tests/codeGen/should_run/T24664a.hs
- + testsuite/tests/codeGen/should_run/T24664a.stdout
- + testsuite/tests/codeGen/should_run/T24664b.hs
- + testsuite/tests/codeGen/should_run/T24664b.stdout
- testsuite/tests/codeGen/should_run/all.T


Changes:

=====================================
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#)


=====================================
testsuite/tests/codeGen/should_run/T24664a.stdout
=====================================
@@ -0,0 +1,2 @@
+first string to print
+second string to print


=====================================
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#)


=====================================
testsuite/tests/codeGen/should_run/T24664b.stdout
=====================================
@@ -0,0 +1,2 @@
+first string to print
+second string to print


=====================================
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'])
+



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a19201d42cfd3aa54faeb1b5a95b715b9a67a01a

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a19201d42cfd3aa54faeb1b5a95b715b9a67a01a
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240506/05672eac/attachment-0001.html>