[project @ 2002-11-21 09:25:27 by simonpj]

Add test for pattern-match failure in do-notation

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

@@ -12,3 +12,4 @@ test('dsrun006', normal, compile_and_run, [''])
 test('dsrun007', exit_code(1), compile_and_run, [''])
 test('dsrun008', exit_code(1), compile_and_run, [''])
 test('dsrun009', normal, compile_and_run, [''])
+test('dsrun010', normal, compile_and_run, [''])

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

+-- Check that pattern match failure in do-notation
+-- is reflected by calling the monadic 'fail', not by a
+-- runtime exception
+
+import Maybe
+import Control.Monad
+
+test :: (MonadPlus m) => [a] -> m Bool
+test xs
+  =   do
+        (_:_) <- return xs
+		-- Should fail here
+        return True
+    `mplus`
+	-- Failure in LH arg should trigger RH arg
+      do
+        return False
+
+main :: IO ()
+main
+  = do  let x = fromJust (test [])
+        putStrLn (show x)

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

+False