Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Tobias Decking
GHC
Commits
8756fa1d
Commit
8756fa1d
authored
Dec 04, 2010
by
Ian Lynagh
Browse files
Add a test for deprecated [$foo| ... |] quaosquote syntax
parent
3b356932
Changes
5
Hide whitespace changes
Inline
Side-by-side
testsuite/tests/ghc-regress/quasiquotation/qq008/Makefile
0 → 100644
View file @
8756fa1d
TOP
=
../../../..
include
$(TOP)/mk/boilerplate.mk
include
$(TOP)/mk/test.mk
testsuite/tests/ghc-regress/quasiquotation/qq008/QQ.hs
0 → 100644
View file @
8756fa1d
{-# LANGUAGE TemplateHaskell #-}
module
QQ
where
import
Language.Haskell.TH.Quote
import
Language.Haskell.TH
pq
=
QuasiQuoter
{
quoteDec
=
\
_
->
[
d
|
f x = x
|]
,
quoteType
=
\
_
->
[
t
|
Int -> Int
|]
,
quoteExp
=
\
_
->
[
|
$
(
varE
(
mkName
"x"
))
+
1
::
Int
|
],
quotePat
=
\
_
->
[
p
|
Just x
|]
}
testsuite/tests/ghc-regress/quasiquotation/qq008/Test.hs
0 → 100644
View file @
8756fa1d
{-# LANGUAGE QuasiQuotes #-}
module
Test
where
import
QQ
f
::
[
pq
|
foo
|]
-- Expands to Int -> Int
[
pq
|
blah
|]
-- Expands to f x = x
h
[
pq
|
foo
|]
=
f
[
$
pq
|
blah
|
]
*
8
-- Expands to h (Just x) = f (x+1) * 8
testsuite/tests/ghc-regress/quasiquotation/qq008/qq008.stderr
0 → 100644
View file @
8756fa1d
Test.hs:9:19:
Warning: Deprecated syntax:
quasiquotes no longer need a dollar sign: $pq
testsuite/tests/ghc-regress/quasiquotation/qq008/test.T
0 → 100644
View file @
8756fa1d
test
('
qq008
',
[
skip_if_fast
,
extra_clean
(['
QQ.hi
',
'
QQ.o
',
'
Test.hi
',
'
Test.o
']),
# We'd need to jump through some hoops to run this test the
# profiling ways, due to the TH use, so for now we just
# omit the profiling ways
omit_ways
(['
profc
','
profasm
','
profthreaded
']),
only_compiler_types
(['
ghc
'])],
multimod_compile
,
['
Test
',
'
-v0
'])
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