summaryrefslogtreecommitdiff
path: root/testsuite/tests
diff options
context:
space:
mode:
Diffstat (limited to 'testsuite/tests')
-rw-r--r--testsuite/tests/stranal/should_run/T11076.hs15
-rw-r--r--testsuite/tests/stranal/should_run/T11076.stdout1
-rw-r--r--testsuite/tests/stranal/should_run/T11076A.hs21
-rw-r--r--testsuite/tests/stranal/should_run/T11076_prim.cmm10
-rw-r--r--testsuite/tests/stranal/should_run/all.T1
-rw-r--r--testsuite/tests/stranal/sigs/T8598.stderr2
6 files changed, 49 insertions, 1 deletions
diff --git a/testsuite/tests/stranal/should_run/T11076.hs b/testsuite/tests/stranal/should_run/T11076.hs
new file mode 100644
index 0000000000..f095cc1ff8
--- /dev/null
+++ b/testsuite/tests/stranal/should_run/T11076.hs
@@ -0,0 +1,15 @@
+{-
+ Test case for a problem where GHC had incorrect strictness
+ information for foreign calls with lifted arguments
+ -}
+{-# OPTIONS_GHC -O0 #-}
+module Main where
+
+import T11076A
+import Control.Exception
+x :: Bool
+x = error "OK: x has been forced"
+
+main :: IO ()
+main = print (testBool x) `catch`
+ \(ErrorCall e) -> putStrLn e -- x should be forced
diff --git a/testsuite/tests/stranal/should_run/T11076.stdout b/testsuite/tests/stranal/should_run/T11076.stdout
new file mode 100644
index 0000000000..8a17d8b29b
--- /dev/null
+++ b/testsuite/tests/stranal/should_run/T11076.stdout
@@ -0,0 +1 @@
+OK: x has been forced
diff --git a/testsuite/tests/stranal/should_run/T11076A.hs b/testsuite/tests/stranal/should_run/T11076A.hs
new file mode 100644
index 0000000000..153a887ef6
--- /dev/null
+++ b/testsuite/tests/stranal/should_run/T11076A.hs
@@ -0,0 +1,21 @@
+{-# OPTIONS_GHC -O #-}
+{-# LANGUAGE MagicHash,
+ ForeignFunctionInterface,
+ UnliftedFFITypes,
+ GHCForeignImportPrim,
+ BangPatterns
+ #-}
+module T11076A where
+
+import GHC.Exts
+import Unsafe.Coerce
+
+{-
+ If the demand type for the foreign call argument is incorrectly strict,
+ the bang pattern can be optimized out
+ -}
+testBool :: Bool -> Int
+testBool !x = I# (cmm_testPrim (unsafeCoerce x))
+{-# INLINE testBool #-}
+
+foreign import prim "testPrim" cmm_testPrim :: Any -> Int#
diff --git a/testsuite/tests/stranal/should_run/T11076_prim.cmm b/testsuite/tests/stranal/should_run/T11076_prim.cmm
new file mode 100644
index 0000000000..6e738a78a1
--- /dev/null
+++ b/testsuite/tests/stranal/should_run/T11076_prim.cmm
@@ -0,0 +1,10 @@
+#include "Cmm.h"
+#include "MachDeps.h"
+
+testPrim(gcptr x)
+{
+ W_ a;
+ a = 123;
+ return (a);
+}
+
diff --git a/testsuite/tests/stranal/should_run/all.T b/testsuite/tests/stranal/should_run/all.T
index 8a82ce86a5..efd1afaa35 100644
--- a/testsuite/tests/stranal/should_run/all.T
+++ b/testsuite/tests/stranal/should_run/all.T
@@ -10,3 +10,4 @@ test('T7649', normal, compile_and_run, [''])
test('T9254', normal, compile_and_run, [''])
test('T10148', normal, compile_and_run, [''])
test('T10218', normal, compile_and_run, [''])
+test('T11076', normal, multimod_compile_and_run, ['T11076.hs', 'T11076_prim.cmm'])
diff --git a/testsuite/tests/stranal/sigs/T8598.stderr b/testsuite/tests/stranal/sigs/T8598.stderr
index 28d5dd0c7d..477d408157 100644
--- a/testsuite/tests/stranal/sigs/T8598.stderr
+++ b/testsuite/tests/stranal/sigs/T8598.stderr
@@ -1,6 +1,6 @@
==================== Strictness signatures ====================
T8598.$trModule: m
-T8598.fun: <S(S),1*U(U)>m
+T8598.fun: <S,1*U(U)>m