Commit 00314570 authored by dterei's avatar dterei

Add Safe Haskell tests for new '-fwarn-safe', '-fwarn-unsafe'

and '-fno-safe-infer' flags.
parent f9073a7e
{-# OPTIONS_GHC -fwarn-unsafe #-}
-- | Basic test to see if Safe warning flags compile
-- Warn if module is infered unsafe
-- In this test the warning _shouldn't_ fire
module SafeFlags21 where
f :: Int
f = 1
{-# OPTIONS_GHC -fwarn-unsafe #-}
-- | Basic test to see if Safe warning flags compile
-- Warn if module is infered unsafe
-- In this test the warning _should_ fire
module SafeFlags22 where
import System.IO.Unsafe
f :: Int
f = 1
SafeFlags22.hs:1:16:
Warning: `SafeFlags22' has been infered as unsafe!
Reason:
base:System.IO.Unsafe can't be safely imported! The module itself isn't safe.
{-# OPTIONS_GHC -fwarn-unsafe -Werror #-}
-- | Basic test to see if Safe warning flags compile
-- Warn if module is infered unsafe
-- In this test the warning _should_ fire and cause a compile fail
module SafeFlags22 where
import System.IO.Unsafe
f :: Int
f = 1
SafeFlags23.hs:1:16:
Warning: `SafeFlags22' has been infered as unsafe!
Reason:
base:System.IO.Unsafe can't be safely imported! The module itself isn't safe.
<no location info>:
Failing due to -Werror.
{-# OPTIONS_GHC -fwarn-safe #-}
-- | Basic test to see if Safe warning flags compile
-- Warn if module is infered safe
-- In this test the warning _shouldn't_ fire
module SafeFlags23 where
import System.IO.Unsafe
f :: Int
f = 1
{-# OPTIONS_GHC -fwarn-safe #-}
-- | Basic test to see if Safe warning flags compile
-- Warn if module is infered safe
-- In this test the warning _should_ fire
module SafeFlags25 where
f :: Int
f = 1
SafeFlags25.hs:1:16:
Warning: `SafeFlags25' has been infered as safe!
{-# OPTIONS_GHC -fwarn-safe -Werror #-}
-- | Basic test to see if Safe warning flags compile
-- Warn if module is infered safe
-- In this test the warning _should_ fire and cause a compile fail
module SafeFlags26 where
f :: Int
f = 1
SafeFlags26.hs:1:16:
Warning: `SafeFlags26' has been infered as safe!
<no location info>:
Failing due to -Werror.
{-# OPTIONS_GHC -fno-safe-infer #-}
-- | Basic test to see if no safe infer flag compiles
-- This module would usually infer safely, so it shouldn't be safe now.
-- We don't actually check that here though, see test '' for that.
module SafeFlags27 where
f :: Int
f = 1
...@@ -41,6 +41,20 @@ test('SafeFlags18', normal, compile, ['-trust base']) ...@@ -41,6 +41,20 @@ test('SafeFlags18', normal, compile, ['-trust base'])
test('SafeFlags19', normal, compile_fail, ['']) test('SafeFlags19', normal, compile_fail, [''])
test('SafeFlags20', normal, compile, ['-trust base']) test('SafeFlags20', normal, compile, ['-trust base'])
test('Flags01', normal, compile, ['']) # test -Wunsafe flag
test('Flags02', normal, compile, ['']) test('SafeFlags21', normal, compile, [''])
test('SafeFlags22', normal, compile, [''])
test('SafeFlags23', normal, compile_fail, [''])
# test -Wsafe flag
test('SafeFlags24', normal, compile, [''])
test('SafeFlags25', normal, compile, [''])
test('SafeFlags26', normal, compile_fail, [''])
# test -fno-safe-infer
test('SafeFlags27', normal, compile, [''])
# test certain flags are still allowed under -XSafe
test('Flags01', normal, compile, ['-XSafe'])
test('Flags02', normal, compile, ['-XSafe'])
{-# LANGUAGE Safe #-}
-- | Basic test to see if no safe infer flag works
module UnsafeInfered10 where
import UnsafeInfered10_A
g :: Int
g = f
[1 of 2] Compiling UnsafeInfered10_A ( UnsafeInfered10_A.hs, UnsafeInfered10_A.o )
[2 of 2] Compiling UnsafeInfered10 ( UnsafeInfered10.hs, UnsafeInfered10.o )
UnsafeInfered10.hs:5:1:
main:UnsafeInfered10_A can't be safely imported! The module itself isn't safe.
{-# OPTIONS_GHC -fno-safe-infer #-}
-- | Basic test to see if no safe infer flag works
-- This module would usually infer safely, so it shouldn't be safe now.
module UnsafeInfered10_A where
f :: Int
f = 1
{-# LANGUAGE Safe #-}
-- | Basic test to see if no safe infer flag works
module UnsafeInfered11 where
import UnsafeInfered11_A
g :: Int
g = f
[1 of 2] Compiling UnsafeInfered11_A ( UnsafeInfered11_A.hs, UnsafeInfered11_A.o )
UnsafeInfered11_A.hs:1:16:
Warning: `UnsafeInfered11_A' has been infered as unsafe!
Reason:
Rule "lookupx/T" ignored
User defined rules are disabled under Safe Haskell
[2 of 2] Compiling UnsafeInfered11 ( UnsafeInfered11.hs, UnsafeInfered11.o )
UnsafeInfered11.hs:5:1:
main:UnsafeInfered11_A can't be safely imported! The module itself isn't safe.
{-# OPTIONS_GHC -fwarn-unsafe #-}
{-# OPTIONS_GHC -fenable-rewrite-rules #-}
-- | Basic test to see if no safe infer flag works
-- This module would usually infer safely, so it shouldn't be safe now.
module UnsafeInfered11_A where
f :: Int
f = 1
data T = T1 | T2 | T3 deriving ( Eq, Ord, Show )
lookupx :: Ord key => Show val => [(key,val)] -> key -> Maybe val
lookupx [] _ = Nothing
lookupx ((t,a):xs) t' | t == t' = Just a
| otherwise = lookupx xs t'
{-# RULES "lookupx/T" lookupx = tLookup #-}
tLookup :: [(T,a)] -> T -> Maybe a
tLookup [] _ = Nothing
tLookup ((t,a):xs) t' | t /= t' = Just a
| otherwise = tLookup xs t'
space = [(T1,"a"),(T2,"b"),(T3,"c")]
key = T3
main = do
putStrLn $ "looking for " ++ show key
putStrLn $ "in space " ++ show space
putStrLn $ "Found: " ++ show (fromMaybe "Not Found!" $ lookupx space key)
let b | Just "c" <- lookupx space key = "YES"
| otherwise = "NO"
putStrLn $ "Rules Disabled: " ++ b
fromMaybe :: a -> Maybe a -> a
fromMaybe a Nothing = a
fromMaybe _ (Just a) = a
...@@ -48,6 +48,14 @@ test('UnsafeInfered09', ...@@ -48,6 +48,14 @@ test('UnsafeInfered09',
'UnsafeInfered09_B.hi', 'UnsafeInfered09_B.o']) ], 'UnsafeInfered09_B.hi', 'UnsafeInfered09_B.o']) ],
multimod_compile_fail, ['UnsafeInfered09', '']) multimod_compile_fail, ['UnsafeInfered09', ''])
# Test that should fail as we disable safe inference
test('UnsafeInfered10',
[ extra_clean(['UnsafeInfered10_A.hi', 'UnsafeInfered10_A.o']) ],
multimod_compile_fail, ['UnsafeInfered10', ''])
test('UnsafeInfered11',
[ extra_clean(['UnsafeInfered11_A.hi', 'UnsafeInfered11_A.o']) ],
multimod_compile_fail, ['UnsafeInfered11', ''])
# Mixed tests # Mixed tests
test('Mixed01', normal, compile_fail, ['']) test('Mixed01', normal, compile_fail, [''])
test('Mixed02', normal, compile_fail, ['']) test('Mixed02', normal, compile_fail, [''])
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment