diff options
Diffstat (limited to 'testsuite/tests')
-rw-r--r-- | testsuite/tests/stranal/should_run/T11076.hs | 15 | ||||
-rw-r--r-- | testsuite/tests/stranal/should_run/T11076.stdout | 1 | ||||
-rw-r--r-- | testsuite/tests/stranal/should_run/T11076A.hs | 21 | ||||
-rw-r--r-- | testsuite/tests/stranal/should_run/T11076_prim.cmm | 10 | ||||
-rw-r--r-- | testsuite/tests/stranal/should_run/all.T | 1 | ||||
-rw-r--r-- | testsuite/tests/stranal/sigs/T8598.stderr | 2 |
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 |