Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
10
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
cca85ff0
Commit
cca85ff0
authored
Oct 17, 2011
by
dterei
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Change Safe Haskell tests for new -fpackage-trust flag
parent
29caf2ac
Changes
9
Hide whitespace changes
Inline
Side-by-side
Showing
9 changed files
with
57 additions
and
4 deletions
+57
-4
testsuite/tests/safeHaskell/check/all.T
testsuite/tests/safeHaskell/check/all.T
+3
-0
testsuite/tests/safeHaskell/check/pkg01/ImpSafe02.hs
testsuite/tests/safeHaskell/check/pkg01/ImpSafe02.hs
+12
-0
testsuite/tests/safeHaskell/check/pkg01/ImpSafeOnly04.hs
testsuite/tests/safeHaskell/check/pkg01/ImpSafeOnly04.hs
+8
-0
testsuite/tests/safeHaskell/check/pkg01/Makefile
testsuite/tests/safeHaskell/check/pkg01/Makefile
+4
-0
testsuite/tests/safeHaskell/check/pkg01/all.T
testsuite/tests/safeHaskell/check/pkg01/all.T
+12
-2
testsuite/tests/safeHaskell/check/pkg01/safePkg01.stdout
testsuite/tests/safeHaskell/check/pkg01/safePkg01.stdout
+3
-1
testsuite/tests/safeHaskell/flags/all.T
testsuite/tests/safeHaskell/flags/all.T
+5
-0
testsuite/tests/safeHaskell/safeLanguage/all.T
testsuite/tests/safeHaskell/safeLanguage/all.T
+5
-0
testsuite/tests/safeHaskell/unsafeLibs/all.T
testsuite/tests/safeHaskell/unsafeLibs/all.T
+5
-1
No files found.
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
Markdown
is supported
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