Skip to content
GitLab
Menu
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
cca85ff0
Commit
cca85ff0
authored
Oct 17, 2011
by
dterei
Browse files
Change Safe Haskell tests for new -fpackage-trust flag
parent
29caf2ac
Changes
9
Hide whitespace changes
Inline
Side-by-side
testsuite/tests/safeHaskell/check/all.T
View file @
cca85ff0
# check tests are about checking that the transitive safety
# check of safe haskell is working properly.
# Just do the normal way, SafeHaskell is all in the frontend
def
f
(
opts
):
opts
.
only_ways
=
['
normal
']
...
...
testsuite/tests/safeHaskell/check/pkg01/ImpSafe02.hs
0 → 100644
View file @
cca85ff0
{-# LANGUAGE Safe #-}
{-# LANGUAGE NoImplicitPrelude #-}
module
ImpSafe
(
MyWord
)
where
-- While Data.Word is safe it imports trustworthy
-- modules in base, hence base needs to be trusted.
-- Note: Worthwhile giving out better error messages for cases
-- like this if I can.
import
Data.Word
type
MyWord
=
Word
testsuite/tests/safeHaskell/check/pkg01/ImpSafeOnly04.hs
0 → 100644
View file @
cca85ff0
{-# LANGUAGE Safe #-}
module
Main
where
import
M_SafePkg3
main
=
do
putStrLn
$
show
bigInt
testsuite/tests/safeHaskell/check/pkg01/Makefile
View file @
cca85ff0
...
...
@@ -45,5 +45,9 @@ safePkg01:
'
$(TEST_HC)
'
--show-iface
dist/build/M_SafePkg4.hi |
grep
-E
'^package dependencies:|^trusted:|^require own pkg trusted:'
echo
echo
'Testing setting trust'
$(LGHC_PKG)
trust safePkg01-1.0
$(LGHC_PKG)
field safePkg01-1.0 trusted
$(LGHC_PKG)
distrust safePkg01-1.0
$(LGHC_PKG)
field safePkg01-1.0 trusted
$(LGHC_PKG)
distrust safePkg01-1.0
$(LGHC_PKG)
field safePkg01-1.0 trusted
testsuite/tests/safeHaskell/check/pkg01/all.T
View file @
cca85ff0
...
...
@@ -9,6 +9,8 @@ if config.have_profiling:
else
:
prof
=
''
# Test building a package, that trust values are set correctly
# and can be changed correctly
test
('
safePkg01
',
[
# TODO: The other tests in here depend on this one not being cleaned
# clean_cmd('$MAKE -s --no-print-directory cleanSafePkg01'),
...
...
@@ -16,11 +18,19 @@ test('safePkg01',
run_command
,
['
$MAKE -s --no-print-directory safePkg01 PROF=
'
+
prof
])
test
('
ImpSafe01
',
normal
,
compile_fail
,
['
-distrust base
'])
# Fail since we enable package trust
test
('
ImpSafe01
',
normal
,
compile_fail
,
['
-fpackage-trust -distrust base
'])
# Succeed since we don't enable package trust
test
('
ImpSafe02
',
normal
,
compile
,
['
-distrust base
'])
test
('
ImpSafeOnly01
',
[
normal
,
alone
],
compile
,
['
-package-conf local.db -trust base
'])
test
('
ImpSafeOnly02
',
[
normal
,
alone
],
compile
,
['
-package-conf local.db -trust base -trust safePkg01
'])
test
('
ImpSafeOnly03
',
[
normal
,
alone
],
compile_fail
,
['
-package-conf local.db -trust base
'])
# Fail since we enable package trust
test
('
ImpSafeOnly03
',
[
normal
,
alone
],
compile_fail
,
['
-fpackage-trust -package-conf local.db -trust base
'])
# Succeed since we don't enable package trust
test
('
ImpSafeOnly04
',
[
normal
,
alone
],
compile
,
['
-package-conf local.db -trust base
'])
testsuite/tests/safeHaskell/check/pkg01/safePkg01.stdout
View file @
cca85ff0
local
.
db
:
safePkg01
-
1.0
trusted
:
Tru
e
trusted
:
Fals
e
M_SafePkg
package
dependencies
:
base
*
ghc
-
prim
integer
-
gmp
...
...
@@ -24,4 +24,6 @@ trusted: safe
require
own
pkg
trusted
:
True
Testing
setting
trust
trusted
:
True
trusted
:
False
trusted
:
False
testsuite/tests/safeHaskell/flags/all.T
View file @
cca85ff0
# flags tests are about checking that various ghc option flags
# and some language extension flags still work. This used to
# test that safe compilation was working but now safe compilation
# has been dropped.
# Just do the normal way, SafeHaskell is all in the frontend
def
f
(
opts
):
opts
.
only_ways
=
['
normal
']
...
...
testsuite/tests/safeHaskell/safeLanguage/all.T
View file @
cca85ff0
# safeLanguage tests are all about making sure the correct
# unsafe language extensions are disabled or restricted
# in the -XSafe language. Basically testing that -XSafe
# works correctly (incluidng testing safe imports a little).
# Just do the normal way, SafeHaskell is all in the frontend
def
f
(
opts
):
opts
.
only_ways
=
['
normal
']
...
...
testsuite/tests/safeHaskell/unsafeLibs/all.T
View file @
cca85ff0
# unsafeLib tests are all about testing that the correct
# standard library modules have been marked as unsafe.
# e.g no importing unsafePerformIO
# Just do the normal way, SafeHaskell is all in the frontend
def
f
(
opts
):
opts
.
only_ways
=
['
normal
']
...
...
@@ -23,4 +27,4 @@ test('BadImport02',
test
('
BadImport03
',
extra_clean
(['
BadImport03_A.o
',
'
BadImport03_A.hi
']),
multimod_compile_fail
,
['
BadImport03
',
''])
\ No newline at end of file
['
BadImport03
',
''])
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a 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