Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
2a68da8b
Commit
2a68da8b
authored
Feb 10, 2012
by
dterei
Browse files
Add some tests for ghci under -XSafe
parent
8ebdadb0
Changes
47
Hide whitespace changes
Inline
Side-by-side
testsuite/tests/safeHaskell/ghci/A.hs
0 → 100644
View file @
2a68da8b
{-# LANGUAGE Trustworthy #-}
module
A
(
a
)
where
import
System.IO.Unsafe
a
::
Int
a
=
1
unsafe
=
unsafePerformIO
testsuite/tests/safeHaskell/ghci/B.hs
0 → 100644
View file @
2a68da8b
{-# LANGUAGE Unsafe #-}
module
B
where
import
System.IO.Unsafe
a
::
Int
a
=
1
testsuite/tests/safeHaskell/ghci/C.hs
0 → 100644
View file @
2a68da8b
{-# LANGUAGE Safe #-}
module
C
(
a
,
C
(),
D
(
..
))
where
a
::
Int
a
=
1
b
::
Int
b
=
2
data
C
a
=
C
a
Int
data
D
a
=
D
a
Int
testsuite/tests/safeHaskell/ghci/D.hs
0 → 100644
View file @
2a68da8b
module
D
where
a
::
Int
a
=
1
b
::
Int
b
=
2
testsuite/tests/safeHaskell/ghci/E.hs
0 → 100644
View file @
2a68da8b
module
E
where
import
System.IO.Unsafe
a
::
Int
a
=
1
testsuite/tests/safeHaskell/ghci/Makefile
0 → 100644
View file @
2a68da8b
TOP
=
../../..
include
$(TOP)/mk/boilerplate.mk
include
$(TOP)/mk/test.mk
testsuite/tests/safeHaskell/ghci/P13_A.hs
0 → 100644
View file @
2a68da8b
{-# LANGUAGE OverlappingInstances, FlexibleInstances #-}
module
P13_A
where
class
Pos
a
where
{
res
::
a
->
Bool
}
instance
Pos
[
a
]
where
{
res
_
=
True
}
instance
Pos
Char
where
{
res
_
=
True
}
testsuite/tests/safeHaskell/ghci/all.T
0 → 100644
View file @
2a68da8b
# Test GHCi works with Safe Haskell
test
('
p1
',
normal
,
ghci_script
,
['
p1.script
'])
test
('
p2
',
normal
,
ghci_script
,
['
p2.script
'])
test
('
p3
',
normal
,
ghci_script
,
['
p3.script
'])
test
('
p4
',
normal
,
ghci_script
,
['
p4.script
'])
test
('
p5
',
normal
,
ghci_script
,
['
p5.script
'])
test
('
p6
',
normal
,
ghci_script
,
['
p6.script
'])
test
('
p7
',
normal
,
ghci_script
,
['
p7.script
'])
test
('
p8
',
normal
,
ghci_script
,
['
p8.script
'])
test
('
p9
',
normal
,
ghci_script
,
['
p9.script
'])
test
('
p10
',
normal
,
ghci_script
,
['
p10.script
'])
test
('
p11
',
normal
,
ghci_script
,
['
p11.script
'])
test
('
p12
',
normal
,
ghci_script
,
['
p12.script
'])
test
('
p13
',
normal
,
ghci_script
,
['
p13.script
'])
test
('
p14
',
normal
,
ghci_script
,
['
p14.script
'])
test
('
p15
',
normal
,
ghci_script
,
['
p15.script
'])
test
('
p16
',
normal
,
ghci_script
,
['
p16.script
'])
testsuite/tests/safeHaskell/ghci/p1.script
0 → 100644
View file @
2a68da8b
-- Test disabled language extensions
:unset +s
:set -XSafe
:set -XTemplateHaskell
:set -XGeneralizedNewtypeDeriving
testsuite/tests/safeHaskell/ghci/p1.stderr
0 → 100644
View file @
2a68da8b
<no location info>: Warning:
-XTemplateHaskell is not allowed in Safe Haskell; ignoring -XTemplateHaskell
<no location info>: Warning:
-XGeneralizedNewtypeDeriving is not allowed in Safe Haskell; ignoring -XGeneralizedNewtypeDeriving
testsuite/tests/safeHaskell/ghci/p10.script
0 → 100644
View file @
2a68da8b
-- Test load works
:unset +s
:set -XSafe
:load D
a
b
testsuite/tests/safeHaskell/ghci/p10.stdout
0 → 100644
View file @
2a68da8b
Warning: can't use * imports with Safe Haskell; ignoring *
1
2
testsuite/tests/safeHaskell/ghci/p11.script
0 → 100644
View file @
2a68da8b
-- Test load works
:unset +s
:set -XSafe
:load E
testsuite/tests/safeHaskell/ghci/p11.stderr
0 → 100644
View file @
2a68da8b
E.hs:3:1:
base:System.IO.Unsafe can't be safely imported! The module itself isn't safe.
testsuite/tests/safeHaskell/ghci/p12.script
0 → 100644
View file @
2a68da8b
-- Test you can't unset options
:unset +s
:set -XSafe
:unset -XSafe
:set -fpackage-trust
:unset -fpackage-trust
import Data.ByteString
testsuite/tests/safeHaskell/ghci/p12.stdout
0 → 100644
View file @
2a68da8b
don't know how to reverse -XSafe
Some flags have not been recognized: -fno-package-trust
*** Exception: bytestring-0.9.2.0:Data.ByteString can't be safely imported! The package (bytestring-0.9.2.0) the module resides in isn't trusted.
testsuite/tests/safeHaskell/ghci/p13.script
0 → 100644
View file @
2a68da8b
-- Test restricted functionality: Overlapping
:unset +s
:set -XSafe
:set -XOverlappingInstances
:set -XFlexibleInstances
:l P13_A
instance Pos [Int] where { res _ = error "This curry is poisoned!" }
res [1::Int, 2::Int]
-- res 'c'
-- res ['c']
testsuite/tests/safeHaskell/ghci/p13.stderr
0 → 100644
View file @
2a68da8b
<interactive>:12:1:
Unsafe overlapping instances for Pos [Int]
arising from a use of `res'
The matching instance is:
instance [overlap ok] [safe] Pos [Int]
-- Defined at <interactive>:10:10
It is compiled in a Safe module and as such can only
overlap instances from the same module, however it
overlaps the following instances from different modules:
instance [overlap ok] [safe] Pos [a] -- Defined at P13_A.hs:6:10
In the expression: res [1 :: Int, 2 :: Int]
In an equation for `it': it = res [1 :: Int, 2 :: Int]
testsuite/tests/safeHaskell/ghci/p13.stdout
0 → 100644
View file @
2a68da8b
Warning: can't use * imports with Safe Haskell; ignoring *
testsuite/tests/safeHaskell/ghci/p14.script
0 → 100644
View file @
2a68da8b
-- Test restricted functionality: RULES
:unset +s
:set -XSafe
:set -fenable-rewrite-rules
let f x = x - 1
{-# RULES "id/Int" id = f #-}
Prev
1
2
3
Next
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment