Add tests for Trac #246 and #3126

testsuite/tests/ghc-regress/deSugar/should_run/T246.hs

+{-# LANGUAGE ScopedTypeVariables #-}
+-- Test Trac #246
+
+module Main where
+
+import Control.Exception
+
+data T = T { x :: Bool, y :: Bool }
+
+f (T { y=True, x=True }) = "Odd"
+f _                      = "OK"
+
+g (T { x=True, y=True }) = "Odd2"
+g _                      = "Odd3"
+
+funny = T { x = undefined, y = False }
+
+main = do { print (f funny)  -- Should work, because we test
+       	    	     	     -- y first, which fails, and falls
+			     -- through to "OK"
+
+          ; Control.Exception.catch 
+	          (print (g funny))        -- Should fail, because we test
+	    	  (\(_::SomeException) -> print "caught")   -- x first, and hit "undefined"
+	  }

testsuite/tests/ghc-regress/deSugar/should_run/T246.stdout

+"OK"
+"caught"

testsuite/tests/ghc-regress/deSugar/should_run/T3126.hs

+{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE OverloadedStrings #-}
+module Main where
+import Data.String
+
+-- {{{ Num literals
+newtype N = N Int deriving (Show,Eq)
+
+instance Num N where
+  fromInteger 0 = error "0"
+  fromInteger 1 = N 0
+  fromInteger _ = N 1
+
+f x = case x of
+        1 -> False
+        0 -> True
+
+g x = case x of
+        1 -> False
+        _ -> case x of
+              0 -> True
+              _ -> error "No match"
+
+testNum = do
+  print $ g (N 0)
+  print $ f (N 0)
+
+-- }}}
+
+-- {{{ IsString literals
+newtype S = S String deriving Eq
+
+instance IsString S where 
+  fromString []    = error "[]"
+  fromString (_:_) = S "."
+
+fs x = case x of
+        "." -> False
+        ""  -> True
+
+gs x = case x of
+        "." -> False
+        _   -> case x of
+                 "" -> True
+                 _  -> error "No match"
+
+testIsString = do
+  print $ gs (S ".")
+  print $ fs (S ".")
+
+-- }}}
+
+main = do { testNum; testIsString }
+

testsuite/tests/ghc-regress/deSugar/should_run/T3126.stdout

+False
+False
+False
+False

testsuite/tests/ghc-regress/deSugar/should_run/all.T

@@ -26,3 +26,5 @@ test('dsrun020', normal, compile_and_run, [''])
 test('dsrun021', normal, compile_and_run, [''])
 test('dsrun022', normal, compile_and_run, [''])
 test('dsrun023', normal, compile_and_run, [''])
+test('T246', normal, compile_and_run, [''])
+test('T3126', normal, compile_and_run, [''])