16 files changed, 219 insertions, 0 deletions
diff --git a/testsuite/tests/parser/should_run/Makefile b/testsuite/tests/parser/should_run/Makefile
new file mode 100644
index 0000000000..9101fbd40a
--- /dev/null
+++ b/testsuite/tests/parser/should_run/Makefile
@@ -0,0 +1,3 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
diff --git a/testsuite/tests/parser/should_run/T1344.hs b/testsuite/tests/parser/should_run/T1344.hs
new file mode 100644
index 0000000000..cba7f3fdf6
--- /dev/null
+++ b/testsuite/tests/parser/should_run/T1344.hs
@@ -0,0 +1,10 @@
+-- Just new test.  This would work without the bug being fixed.
+
+a = '\x10ffff'
+b = "Hello\x000000002c\32World\o00000000000000000000000000000000041"
+c = "♯\00\&00\0"
+
+main = do print a
+          putStrLn b
+          print c
+
diff --git a/testsuite/tests/parser/should_run/T1344.stdout b/testsuite/tests/parser/should_run/T1344.stdout
new file mode 100644
index 0000000000..a83f165d74
--- /dev/null
+++ b/testsuite/tests/parser/should_run/T1344.stdout
@@ -0,0 +1,3 @@
+'\1114111'
+Hello, World!
+"\9839\NUL00\NUL"
diff --git a/testsuite/tests/parser/should_run/all.T b/testsuite/tests/parser/should_run/all.T
new file mode 100644
index 0000000000..17d6bc0199
--- /dev/null
+++ b/testsuite/tests/parser/should_run/all.T
@@ -0,0 +1,7 @@
+test('readRun001', normal, compile_and_run, [''])
+test('readRun002', normal, compile_and_run, [''])
+test('readRun003', normal, compile_and_run, [''])
+test('readRun004', expect_broken_for(1257, ['ghci']), compile_and_run, [''])
+test('T1344', normal, compile_and_run, [''])
+test('operator', normal, compile_and_run, [''])
+test('operator2', normal, compile_and_run, [''])
diff --git a/testsuite/tests/parser/should_run/operator.hs b/testsuite/tests/parser/should_run/operator.hs
new file mode 100644
index 0000000000..5a7bcf9e97
--- /dev/null
+++ b/testsuite/tests/parser/should_run/operator.hs
@@ -0,0 +1,23 @@
+module Main where
+
+data Hash = Hash { (#) :: Int }
+  deriving (Show,Read)
+
+main = do
+  let h = Hash 3
+      s = show h
+      x = read s :: Hash
+      y = show x
+  print h
+  putStrLn s
+  print x
+  putStrLn y
+  let h' = Hash { (#) = 3 }
+      s' = show h'
+      x' = read s' :: Hash
+      y' = show x'
+  print h'
+  putStrLn s'
+  print x'
+  putStrLn y'
+
diff --git a/testsuite/tests/parser/should_run/operator.stdout b/testsuite/tests/parser/should_run/operator.stdout
new file mode 100644
index 0000000000..b56f190ce6
--- /dev/null
+++ b/testsuite/tests/parser/should_run/operator.stdout
@@ -0,0 +1,8 @@
+Hash {(#) = 3}
+Hash {(#) = 3}
+Hash {(#) = 3}
+Hash {(#) = 3}
+Hash {(#) = 3}
+Hash {(#) = 3}
+Hash {(#) = 3}
+Hash {(#) = 3}
diff --git a/testsuite/tests/parser/should_run/operator2.hs b/testsuite/tests/parser/should_run/operator2.hs
new file mode 100644
index 0000000000..f38ebc3bc8
--- /dev/null
+++ b/testsuite/tests/parser/should_run/operator2.hs
@@ -0,0 +1,7 @@
+
+(|..) :: a -> a -> a
+x |.. y = y
+
+f = [2|..3]
+
+main = putStrLn (show f)
diff --git a/testsuite/tests/parser/should_run/operator2.stdout b/testsuite/tests/parser/should_run/operator2.stdout
new file mode 100644
index 0000000000..048026337a
--- /dev/null
+++ b/testsuite/tests/parser/should_run/operator2.stdout
@@ -0,0 +1 @@
+[3]
diff --git a/testsuite/tests/parser/should_run/readRun001.hs b/testsuite/tests/parser/should_run/readRun001.hs
new file mode 100644
index 0000000000..d80f2adb7c
--- /dev/null
+++ b/testsuite/tests/parser/should_run/readRun001.hs
@@ -0,0 +1,57 @@
+-- !!! Haskell-98 prefix negate operator
+
+-- Make sure the parsing is actually the correct
+-- one by running this after it's compiled.
+
+negatedExpression = - (3 + 4)
+
+negatedTightlyBinding = -3^4
+
+negatedNonSection = (- 3)
+
+negatedNonSectionWithHighPrecedenceOp =
+  let { f = (+); infix 9 `f` } in ( -3 `f` 4 )
+
+negatedNonSectionWithLowPrecedenceOp =
+  let { f = (+); infix 1 `f` } in ( -3 `f` 4 )
+
+negatedRightHandSide =
+-- This is actually not legal syntax:  3 * - 4
+-- However, lower-precedence binary ops work.
+-- (see H98 syntax for exp, or imagine it's because it
+--  would parse differently as 3 * 0 - 4)
+  let { f = (+); infix 1 `f` } in ( 3 `f` - 4 )
+
+
+subtractionNotNegation = 3 -4
+
+negativePattern =
+    case -3 of { (- 3) ->
+    case -4 of { - 4 ->
+    True } }
+-- not legal H98 syntax:  case -4 of { _x @ -4 ->
+-- (parentheses needed)    case -5 of { ~ -5 ->
+
+subtractionNotNegationPattern =
+    -- defines infix '-' (shadowing Prelude definition)
+    let { 3 -4 = True } in (3 - 4)
+
+precedenceOfNegationCantBeChanged =
+    let { (-) = undefined; infix 9 - } in (- 3 * 4)
+
+negationCantBeQualified =
+    (Prelude.-3) 4
+
+main = do
+  print negatedExpression
+  print negatedTightlyBinding
+  print negatedNonSection
+  print negatedNonSectionWithHighPrecedenceOp
+  print negatedNonSectionWithLowPrecedenceOp
+  print negatedRightHandSide
+  print subtractionNotNegation
+  print negativePattern
+  print subtractionNotNegationPattern
+  print precedenceOfNegationCantBeChanged
+  print negationCantBeQualified
+
diff --git a/testsuite/tests/parser/should_run/readRun001.stdout b/testsuite/tests/parser/should_run/readRun001.stdout
new file mode 100644
index 0000000000..08d7d27203
--- /dev/null
+++ b/testsuite/tests/parser/should_run/readRun001.stdout
@@ -0,0 +1,11 @@
+-7
+-81
+-3
+-7
+1
+-1
+-1
+True
+True
+-12
+1
diff --git a/testsuite/tests/parser/should_run/readRun002.hs b/testsuite/tests/parser/should_run/readRun002.hs
new file mode 100644
index 0000000000..58ba8861ab
--- /dev/null
+++ b/testsuite/tests/parser/should_run/readRun002.hs
@@ -0,0 +1,35 @@
+{-# LANGUAGE MagicHash #-}
+-- !!! Negative unboxed literals, part 1
+-- They don't have to be as standards-compliant
+-- or follow so many weird cases as the normal
+-- boxed version.  In particular, normal unboxed
+-- subtraction is -#, `minusFloat#`, -##, `minusInteger#`
+-- and unboxed negation is negate{Int,Float,Double}#
+-- .  (-) and negate are kind errors.  So we will
+-- assume that we don't need to parse infix (-) nicely
+-- when unboxed numbers are involved (even though someone
+-- "could" hide the Prelude's version and define (-) themself).
+-- Also we won't care here whether having a space (- 3#) works.
+
+-- Make sure the parsing is actually the correct
+-- one by running this after it's compiled.
+
+import GHC.Exts
+
+--is floating-point consistently safe to test like this,
+--if we stick to integral values?
+main = do
+  --These work with any ghc
+  print (I# (negateInt# (-3# -# -4#)))
+  print (F# (negateFloat# (-3.0# `minusFloat#` -4.0#)))
+  print (D# (negateDouble# (-3.0## -## -4.0##)))
+  print (I# (-3# ^# 4#)) --different from (boxed) Haskell98 (-3 ^ 4)
+  print ( case -1# of { -1# -> True } )
+  print ( case 1# of { -1# -> True; _ -> False } )
+  print ( case -0# of { 0# -> True } )
+
+infixr 8  ^#  --just like ^, binds tighter than - (which is infixl 6)
+( ^# ) :: Int# -> Int# -> Int#
+base ^# 0# = 1#
+base ^# exponent = base *# (base ^# ( exponent -# 1# ))
+
diff --git a/testsuite/tests/parser/should_run/readRun002.stdout b/testsuite/tests/parser/should_run/readRun002.stdout
new file mode 100644
index 0000000000..fc761860c4
--- /dev/null
+++ b/testsuite/tests/parser/should_run/readRun002.stdout
@@ -0,0 +1,7 @@
+-1
+-1.0
+-1.0
+81
+True
+False
+True
diff --git a/testsuite/tests/parser/should_run/readRun003.hs b/testsuite/tests/parser/should_run/readRun003.hs
new file mode 100644
index 0000000000..578e2d18db
--- /dev/null
+++ b/testsuite/tests/parser/should_run/readRun003.hs
@@ -0,0 +1,13 @@
+{-# LANGUAGE MagicHash #-}
+-- !!! Negative unboxed literals, part 2
+
+import GHC.Exts
+
+main = do
+  --Newly implemented: don't parse this as subtraction (Prelude.-):
+  print (I# (negateInt# -3#))
+  print (F# (negateFloat# -3.0#))
+  print (D# (negateDouble# -3.0##))
+  --nor this as  let (-) f 1# = ...
+  print (let { f -1# = True } in f (-1#))
+
diff --git a/testsuite/tests/parser/should_run/readRun003.stdout b/testsuite/tests/parser/should_run/readRun003.stdout
new file mode 100644
index 0000000000..5953eb3a28
--- /dev/null
+++ b/testsuite/tests/parser/should_run/readRun003.stdout
@@ -0,0 +1,4 @@
+3
+3.0
+3.0
+True
diff --git a/testsuite/tests/parser/should_run/readRun004.hs b/testsuite/tests/parser/should_run/readRun004.hs
new file mode 100644
index 0000000000..5e6545adb1
--- /dev/null
+++ b/testsuite/tests/parser/should_run/readRun004.hs
@@ -0,0 +1,28 @@
+{-# LANGUAGE UnboxedTuples, MagicHash #-}
+
+-- should_run to make sure linking succeeds
+-- (curried unboxed tuples with both boxed
+--  and unboxed components).
+-- See Trac #1509; also Note [Primop wrappers] in Id.lhs
+
+import GHC.Exts
+
+main = do
+  case curried 9.0## 't'# of
+    (# i#, u@(), d1#, c1#, f#, w#, d2#, c2# #)
+       -> print ( I# i#, u, D# d1#, C# c1#, F# f#, W# w#, D# d2#, C# c2# )
+  print $ map_ ((#,#) True) ['a','b','c']
+
+-- try NOINLINE to make sure the currying isn't eliminated
+-- too soon, but also test the other one without NOINLINE
+-- for variety of testing
+{-# NOINLINE curried #-}
+curried :: Double# -> Char# ->
+   (# Int#, (), Double#, Char#, Float#, Word#, Double#, Char# #)
+curried = (#,,,,,,,#) 3# () 4.0## 'f'# 5.0# 32##
+
+map_ :: (a -> (# b, c #)) -> [a] -> [(b,c)]
+map_ f [] = []
+map_ f (a:as) = case f a of
+   (# b, c #) -> (b, c) : map_ f as
+
diff --git a/testsuite/tests/parser/should_run/readRun004.stdout b/testsuite/tests/parser/should_run/readRun004.stdout
new file mode 100644
index 0000000000..9c27fdf9d5
--- /dev/null
+++ b/testsuite/tests/parser/should_run/readRun004.stdout
@@ -0,0 +1,2 @@
+(3,(),4.0,'f',5.0,32,9.0,'t')
+[(True,'a'),(True,'b'),(True,'c')]