Merge branch 'master' of http://darcs.haskell.org/testsuite

testsuite/tests/annotations/should_run/annrun01.hs

@@ -16,29 +16,31 @@ import qualified Language.Haskell.TH as TH
 import Data.List
 import Data.Function
 
+main :: IO ()
 main = defaultErrorHandler defaultLogAction
      $ runGhc (Just cTop) $ do
     liftIO $ putStrLn "Initializing Package Database"
     dflags <- getSessionDynFlags
     let dflags' = dflags
     setSessionDynFlags dflags'
-    
+
     let mod_nm = mkModuleName "Annrun01_Help"
-    
+
     liftIO $ putStrLn "Setting Target"
     setTargets [Target (TargetModule mod_nm) True Nothing]
     liftIO $ putStrLn "Loading Targets"
     load LoadAllTargets
-    
+
     liftIO $ putStrLn "Finding Module"
     mod <- findModule mod_nm Nothing
     liftIO $ putStrLn "Getting Module Info"
     Just mod_info <- getModuleInfo mod
-    
+
     liftIO $ putStrLn "Showing Details For Module"
     showTargetAnns (ModuleTarget mod)
     liftIO $ putStrLn "Showing Details For Exports"
-    mapM (showTargetAnns . NamedTarget) $ sortBy (compare `on` getOccName) $ modInfoExports mod_info
+    let exports = sortBy (compare `on` getOccName) $ modInfoExports mod_info
+    mapM_ (showTargetAnns . NamedTarget) exports
 
 showTargetAnns :: CoreAnnTarget -> Ghc ()
 showTargetAnns target = do

testsuite/tests/dph/diophantine/dph-diophantine.T

@@ -4,6 +4,7 @@ test    ('dph-diophantine-opt'
           , skip_if_fast
           , reqlib('dph-par')
           , reqlib('dph-prim-par')
+          , expect_broken(5065)
           , only_ways(['normal', 'threaded1', 'threaded2']) ] 
         , multimod_compile_and_run 
         , [ 'Main'

testsuite/tests/simplCore/should_compile/T5303.hs

+{-# LANGUAGE KindSignatures, GADTs, TypeFamilies, MultiParamTypeClasses,  FlexibleContexts, ScopedTypeVariables, TypeSynonymInstances,  FlexibleInstances #-}  
+module T5303( showContextSeries ) where
+
+import Control.Monad.State.Strict( StateT )  
+import Control.Monad.Trans ( lift )
+
+data Tree m = Tree {}
+
+data FL (a :: * -> * -> *) x z where
+    (:>:) :: a x y -> FL a y z -> FL a x z
+    NilFL :: FL a x x
+
+class (Functor m, Monad m) => ApplyMonad m (state :: (* -> *) -> *)
+
+class Apply (p :: * -> * -> *) where
+    type ApplyState p :: (* -> *) -> *
+    apply :: ApplyMonad m (ApplyState p) => p x y -> m ()
+
+class (Functor m, Monad m, ApplyMonad (ApplyMonadOver m state) state)
+      => ApplyMonadTrans m (state :: (* -> *) -> *) where
+  type ApplyMonadOver m state :: * -> *
+  runApplyMonad :: (ApplyMonadOver m state) x -> state m -> m (x, state m)
+
+instance (Functor m, Monad m) => ApplyMonadTrans m Tree where
+  type ApplyMonadOver m Tree = TreeMonad m
+  runApplyMonad = virtualTreeMonad
+
+instance (Functor m, Monad m) => ApplyMonad (TreeMonad m) Tree
+
+-- | Internal state of the 'TreeIO' monad. Keeps track of the current Tree
+-- content, unsync'd changes and a current working directory (of the  monad).
+data TreeState m = TreeState { tree :: !(Tree m) }  
+type TreeMonad m = StateT (TreeState m) m  
+type TreeIO = TreeMonad IO
+
+virtualTreeMonad :: (Functor m, Monad m) => TreeMonad m a -> Tree m -> m  (a, Tree m)  
+virtualTreeMonad action t = undefined
+
+applyToState :: forall p m x y. (Apply p, ApplyMonadTrans m (ApplyState p))
+             => p x y -> (ApplyState p) m -> m ((ApplyState p) m)  
+applyToState _ _ = snd `fmap` runApplyMonad undefined undefined
+
+showContextSeries :: (Apply p, ApplyState p ~ Tree) => FL p x y -> TreeIO ()
+showContextSeries (p:>:_) = (undefined >>= lift . applyToState p) >>  return ()

testsuite/tests/simplCore/should_compile/all.T

@@ -123,3 +123,4 @@ test('T5168',
      ['$MAKE -s --no-print-directory T5168'])
 
 test('T5329', normal, compile, [''])
+test('T5303', reqlib('mtl'), compile, [''])   # Coercion-optimiation test