Repository : ssh://darcs.haskell.org//srv/darcs/testsuite On branch : master
http://hackage.haskell.org/trac/ghc/changeset/e19ec33bf59a30bbd61d7100f5dbeadae13bd5a9 >--------------------------------------------------------------- commit e19ec33bf59a30bbd61d7100f5dbeadae13bd5a9 Author: Geoffrey Mainland <[email protected]> Date: Fri Sep 30 17:23:09 2011 +0100 Add test case for #5204. >--------------------------------------------------------------- tests/quasiquotation/T5204.hs | 39 +++++++++++++++++++++++++++++++++++++ tests/quasiquotation/T5204.stderr | 2 + tests/quasiquotation/all.T | 2 + 3 files changed, 43 insertions(+), 0 deletions(-) diff --git a/tests/quasiquotation/T5204.hs b/tests/quasiquotation/T5204.hs new file mode 100755 index 0000000..00c976b --- /dev/null +++ b/tests/quasiquotation/T5204.hs @@ -0,0 +1,39 @@ +{-# LANGUAGE TypeSynonymInstances, TemplateHaskell, QuasiQuotes, MultiParamTypeClasses, FlexibleInstances, DeriveDataTypeable, NamedFieldPuns, ScopedTypeVariables #-} +module Pnm where +import qualified Data.Char as Char +-- import Language.Pads.Padsc +import Control.Monad + +_ws = one_or_more Char.isSpace + where one_or_more = undefined + +ws, wsnl, whitechar :: RE + +ws = REd "[ \t\n\r]+" " " -- whitespace +wsnl = let REd wplus _ = ws in REd wplus "\n" -- whitespace output as \n +whitechar = REd "[ \t\n\r]" "\n" -- one white character + + +[pads| + + data PGMx a = PGM "P5" ws Header whitechar (Pixmap a) + + data Header = Header -- fields should be separated by whitespace + { width :: Int + ws , height :: Int + wsnl , constrain denominator :: Int + where <| 0 <= denominator && denominator < 65536 |> + } + + data Pixmap a (h::Header) = Rows [Row a h | wsnl] length <| height h |> + data Row a (h::Header) = Pixels [a h | ws] length <| width h |> + + newtype Greypix (h::Header) = + G constrain g::Int16 where <| 0 <= g && g <= denominator h |> + + data PGM = PGMx Int16 Greypix + +] + +pgm file = do (rep, md) <- parseFile file + return rep diff --git a/tests/quasiquotation/T5204.stderr b/tests/quasiquotation/T5204.stderr new file mode 100644 index 0000000..8f19d65 --- /dev/null +++ b/tests/quasiquotation/T5204.stderr @@ -0,0 +1,2 @@ + +T5204.hs:17:7: unterminated quasiquotation at end of input diff --git a/tests/quasiquotation/all.T b/tests/quasiquotation/all.T index 2fa0427..6193001 100644 --- a/tests/quasiquotation/all.T +++ b/tests/quasiquotation/all.T @@ -5,3 +5,5 @@ test('T4150', extra_clean(['T4150A.hi', 'T4150A.o', 'T4150.hi', 'T4150.o'])], run_command, ['$MAKE -s --no-print-directory T4150']) +test('T5204', [req_interp, only_compiler_types(['ghc'])], + compile_fail, ['']) _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
