Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Dylan Yudaken
GHC
Commits
0f15c505
Commit
0f15c505
authored
Jul 11, 2011
by
dterei
Browse files
Add some more safe haskell tests
parent
8564b059
Changes
15
Hide whitespace changes
Inline
Side-by-side
testsuite/tests/ghc-regress/safeHaskell/check/pkg01/ImpSafe01.hs
0 → 100644
View file @
0f15c505
{-# 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/ghc-regress/safeHaskell/check/pkg01/ImpSafe01.stderr
0 → 100644
View file @
0f15c505
ImpSafe01.hs:9:1:
base:Data.Word can't be safely imported! The package (base) the module resides in isn't trusted.
testsuite/tests/ghc-regress/safeHaskell/check/pkg01/ImpSafeOnly01.hs
0 → 100644
View file @
0f15c505
{-# LANGUAGE Safe #-}
module
Main
where
import
M_SafePkg
main
=
do
putStrLn
$
show
bigInt
testsuite/tests/ghc-regress/safeHaskell/check/pkg01/ImpSafeOnly02.hs
0 → 100644
View file @
0f15c505
{-# LANGUAGE Safe #-}
module
Main
where
import
M_SafePkg2
main
=
do
putStrLn
$
show
bigInt
testsuite/tests/ghc-regress/safeHaskell/check/pkg01/ImpSafeOnly03.hs
0 → 100644
View file @
0f15c505
{-# LANGUAGE Safe #-}
module
Main
where
import
M_SafePkg3
main
=
do
putStrLn
$
show
bigInt
testsuite/tests/ghc-regress/safeHaskell/check/pkg01/ImpSafeOnly03.stderr
0 → 100644
View file @
0f15c505
ImpSafeOnly03.hs:4:1:
safePkg01-1.0:M_SafePkg3 can't be safely imported! The package (safePkg01-1.0) the module resides in isn't trusted.
testsuite/tests/ghc-regress/safeHaskell/check/pkg01/M_SafePkg.hs
0 → 100644
View file @
0f15c505
{-# LANGUAGE Safe #-}
module
M_SafePkg
where
bigInt
::
Int
bigInt
=
9
testsuite/tests/ghc-regress/safeHaskell/check/pkg01/M_SafePkg2.hs
0 → 100644
View file @
0f15c505
{-# LANGUAGE Trustworthy #-}
module
M_SafePkg2
where
bigInt
::
Int
bigInt
=
9
testsuite/tests/ghc-regress/safeHaskell/check/pkg01/M_SafePkg3.hs
0 → 100644
View file @
0f15c505
{-# LANGUAGE Safe #-}
module
M_SafePkg3
where
import
qualified
M_SafePkg2
as
M2
bigInt
::
Int
bigInt
=
M2
.
bigInt
testsuite/tests/ghc-regress/safeHaskell/check/pkg01/M_SafePkg4.hs
0 → 100644
View file @
0f15c505
{-# LANGUAGE Safe #-}
module
M_SafePkg4
where
import
qualified
M_SafePkg3
as
M3
import
Data.Word
bigInt
::
Int
bigInt
=
M3
.
bigInt
type
MyWord
=
Word
testsuite/tests/ghc-regress/safeHaskell/check/pkg01/Makefile
0 → 100644
View file @
0f15c505
TOP
=
../../../../..
include
$(TOP)/mk/boilerplate.mk
include
$(TOP)/mk/test.mk
clean
:
rm
-rf
setup a.out
rm
-rf
dist
find
.
-name
"*.o"
| xargs
rm
-f
find
.
-name
"*.hi"
| xargs
rm
-f
rm
-rf
local.db
rm
-rf
install
# We use the global package database as there's no easy way to tell
# ghc-pkg (via Cabal) to use one in ., and the global one at least
# won't affect the installed GHC and is more likely to work
PREFIX
:=
$(
abspath
install
)
$(eval
$(call
canonicalise,PREFIX))
PKGCONF
=
local.db
LGHC_PKG
=
'
$(GHC_PKG)
'
--no-user-package-conf
-f
$(PKGCONF)
safePkg01
:
$(MAKE)
clean
'
$(TEST_HC)
'
--make
-o
setup Setup.hs
-v0
'$(GHC_PKG)'
init
local.db
./setup
configure
-v0
--prefix
=
$(PREFIX)
--with-compiler
=
'
$(TEST_HC)
'
--ghc-options
=
'
$(TEST_HC_OPTS)
-trust base'
--with-hc-pkg
=
'
$(GHC_PKG)
'
--package-db
=
${PKGCONF}
$(PROF)
./setup
build
-v0
./setup
copy
-v0
./setup
register
--inplace
-v0
$(LGHC_PKG)
list
$(LGHC_PKG)
field
safePkg01-1.0
trusted
echo
echo
'M_SafePkg'
$(TEST_HC) --show-iface dist/build/M_SafePkg.hi | grep -E '^package dependencies
:
|^trusted:|^require own pkg trusted:'
echo
echo
'M_SafePkg2'
$(TEST_HC)
--show-iface
dist/build/M_SafePkg2.hi |
grep
-E
'^package dependencies:|^trusted:|^require own pkg trusted:'
echo
echo
'M_SafePkg3'
$(TEST_HC)
--show-iface
dist/build/M_SafePkg3.hi |
grep
-E
'^package dependencies:|^trusted:|^require own pkg trusted:'
echo
echo
'M_SafePkg4'
$(TEST_HC)
--show-iface
dist/build/M_SafePkg4.hi |
grep
-E
'^package dependencies:|^trusted:|^require own pkg trusted:'
testsuite/tests/ghc-regress/safeHaskell/check/pkg01/Setup.hs
0 → 100644
View file @
0f15c505
import
Distribution.Simple
main
=
defaultMain
testsuite/tests/ghc-regress/safeHaskell/check/pkg01/all.T
0 → 100644
View file @
0f15c505
# Just do the normal way, SafeHaskell is all in the frontend
def
f
(
opts
):
opts
.
only_ways
=
['
normal
']
setTestOpts
(
f
)
if
config
.
have_profiling:
prof
=
'
--enable-library-profiling
'
else
:
prof
=
''
test
('
safePkg01
',
normal
,
run_command
,
['
$MAKE -s --no-print-directory safePkg01 PROF=
'
+
prof
])
test
('
ImpSafe01
',
normal
,
compile_fail
,
[''])
test
('
ImpSafeOnly01
',
normal
,
compile
,
['
-package-conf local.db -trust base
'])
test
('
ImpSafeOnly02
',
normal
,
compile
,
['
-package-conf local.db -trust base -trust safePkg01
'])
test
('
ImpSafeOnly03
',
normal
,
compile_fail
,
['
-package-conf local.db -trust base
'])
testsuite/tests/ghc-regress/safeHaskell/check/pkg01/p.cabal
0 → 100644
View file @
0f15c505
Name: safePkg01
Version: 1.0
Description: SafeHaskell Test Package
License: BSD3
Build-Type: Simple
Library {
Build-Depends: base >= 4
Exposed-Modules:
M_SafePkg
M_SafePkg2
M_SafePkg3
M_SafePkg4
}
testsuite/tests/ghc-regress/safeHaskell/check/pkg01/safePkg01.stdout
0 → 100644
View file @
0f15c505
local
.
db
:
safePkg01
-
1.0
trusted
:
False
M_SafePkg
package
dependencies
:
base
*
ghc
-
prim
integer
-
gmp
trusted
:
safe
require
own
pkg
trusted
:
False
M_SafePkg2
package
dependencies
:
base
ghc
-
prim
integer
-
gmp
trusted
:
trustworthy
require
own
pkg
trusted
:
False
M_SafePkg3
package
dependencies
:
base
*
ghc
-
prim
integer
-
gmp
trusted
:
safe
require
own
pkg
trusted
:
True
M_SafePkg4
package
dependencies
:
base
*
ghc
-
prim
integer
-
gmp
trusted
:
safe
require
own
pkg
trusted
:
True
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