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

testsuite/tests/deriving/should_compile/T3057.hs

 {-# LANGUAGE StandaloneDeriving, DeriveFunctor #-}
 module T3057 where
 
-deriving instance Functor (Either a)
+import T3057A
+
+deriving instance Functor (MyType a)
 
 

testsuite/tests/deriving/should_compile/T3057A.hs

+
+module T3057A where
+
+data MyType a b = C1 a | C2 b

testsuite/tests/deriving/should_compile/all.T

@@ -18,7 +18,7 @@ test('drv021', normal, compile, [''])
 test('deriving-1935', normal, compile, [''])
 test('T2378', normal, compile, [''])
 test('T2856', normal, compile, [''])
-test('T3057', normal, compile, [''])
+test('T3057', extra_clean(['T3057A.o', 'T3057A.hi']), multimod_compile, ['T3057', '-v0'])
 test('T3012', normal, compile, [''])
 test('T3965', normal, compile, [''])
 test('T4220', normal, compile, [''])

testsuite/tests/dph/classes/DefsVect.hs

@@ -4,26 +4,12 @@
 module DefsVect where
 
 import Data.Array.Parallel
-import Data.Array.Parallel.Prelude.Bool
-import Data.Array.Parallel.Prelude.Int  (Int, sumP)
 
 
-{-# VECTORISE class Eq #-}
-{-# VECTORISE SCALAR instance Eq Bool #-}
 -- {-# VECTORISE SCALAR instance Eq Char #-}
-{-# VECTORISE SCALAR instance Eq Int #-}
-{-# VECTORISE SCALAR instance Eq Word8 #-}
 -- {-# VECTORISE SCALAR instance Eq Float #-}
-{-# VECTORISE SCALAR instance Eq Double #-}
-{-# VECTORISE SCALAR instance Eq Ordering #-}
-{-# VECTORISE class Ord #-}
-{-# VECTORISE SCALAR instance Ord Bool #-}
 -- {-# VECTORISE SCALAR instance Ord Char #-}
-{-# VECTORISE SCALAR instance Ord Int #-}
-{-# VECTORISE SCALAR instance Ord Word8 #-}
 -- {-# VECTORISE SCALAR instance Ord Float #-}
-{-# VECTORISE SCALAR instance Ord Double #-}
-{-# VECTORISE SCALAR instance Ord Ordering #-}
 
 
 data MyBool = MyTrue | MyFalse
@@ -31,6 +17,11 @@ data MyBool = MyTrue | MyFalse
 class Eq a => Cmp a where
   cmp :: a -> a -> Bool
 
+-- FIXME:
+-- instance Cmp Int where
+--   cmp = (==)
+
+-- isFive :: (Eq a, Num a) => a -> Bool
 isFive :: Int -> Bool
 isFive x = x == 5
 

testsuite/tests/dph/diophantine/DiophantineVect.hs

@@ -3,7 +3,7 @@
 module DiophantineVect (solution3) where
 
 import Data.Array.Parallel
-import Data.Array.Parallel.Prelude.Int
+import Data.Array.Parallel.Prelude.Int as I
 
 import qualified Prelude as P
 
@@ -13,19 +13,19 @@ solution3'
      primes      = [: 2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73 :]
      a `cutTo` b = sliceP 0 (lengthP b) a
      sumpri xx   = productP [: pow p x | p <- primes `cutTo` xx | x <- xx :]
-     distinct xx = productP [: x + 1   | x <- xx :]
+     distinct xx = productP [: x I.+ 1   | x <- xx :]
      
      series :: [:Int:] -> Int -> [:[:Int:]:]
      series xs n     
        | n == 1      = [: [: 0 :] :]
        | otherwise   = [: [: x :] +:+ ps 
                              | x <- xs
-                             , ps <- series (enumFromToP 0 x) (n-1) :]
+                             , ps <- series (I.enumFromToP 0 x) (n I.- 1) :]
      
      prob x y        
       = let  xx      = [: (sumpri m ,m) 
-                             | m <- series (enumFromToP 1 3) x
-                             , distinct [: x * 2 | x <- m :] > y :]          
+                             | m <- series (I.enumFromToP 1 3) x
+                             , distinct [: x I.* 2 | x <- m :] > y :]          
              i       = minIndexP [: a | (a, b) <- xx :]
         in   xx !: i 
    in

testsuite/tests/dph/dotp/DotPVect.hs

@@ -12,4 +12,4 @@ dotp :: PArray Double -> PArray Double -> Double
 dotp v w = dotp' (fromPArrayP v) (fromPArrayP w)
 
 dotp' :: [:Double:] -> [:Double:] -> Double
-dotp' v w = D.sumP (zipWithP (*) v w)
+dotp' v w = D.sumP (zipWithP (D.*) v w)

testsuite/tests/dph/nbody/Solver.hs

@@ -5,7 +5,7 @@ module Solver
 where
 import Data.Array.Parallel
 import Data.Array.Parallel.Prelude.Bool
-import Data.Array.Parallel.Prelude.Double
+import Data.Array.Parallel.Prelude.Double as D
 import qualified Data.Array.Parallel.Prelude.Int as I
 import qualified Prelude
 
@@ -67,9 +67,9 @@ buildTree bb particles
         subTrees                = [:buildTree bb' ps | (bb', ps) <- zipP boxes splitPnts:]
   
         (Box llx lly rux ruy)   = bb
-        sx                      = rux - llx
-        sy                      = ruy - lly
-        s                       = if sx < sy then sx else sy
+        sx                      = rux D.- llx
+        sy                      = ruy D.- lly
+        s                       = if sx D.< sy then sx else sy
 
 
 -- | Split massPoints according to their locations in the quadrants.
@@ -93,13 +93,13 @@ splitPoints b@(Box llx lly rux  ruy) particles
         b4              = Box midx lly  rux  midy
         boxes           = singletonP b1  +:+ singletonP b2  +:+ singletonP b3 +:+ singletonP b4 
         splitPars       = singletonP lls +:+ singletonP lus +:+ singletonP rus +:+ singletonP rls
-        (midx,  midy)   = ((llx + rux) / 2.0 , (lly + ruy) / 2.0) 
+        (midx,  midy)   = ((llx D.+ rux) D./ 2.0 , (lly D.+ ruy) D./ 2.0) 
 
 
 -- | Checks if particle is in box (excluding left and lower border)
 inBox :: BoundingBox -> MassPoint -> Bool
 inBox (Box llx  lly rux  ruy) (MP px  py  _) 
-        = (px > llx) && (px <= rux) && (py > lly) && (py <= ruy)
+        = (px D.> llx) && (px D.<= rux) && (py D.> lly) && (py D.<= ruy)
 
 
 -- | Calculate the centroid of some points.
@@ -107,7 +107,7 @@ calcCentroid:: [:MassPoint:] -> MassPoint
 calcCentroid mpts 
  = MP  (sumP xs / mass) (sumP ys / mass) mass
  where  mass     = sumP [: m | MP _ _ m  <- mpts :]
-        (xs, ys) = unzipP [: (m * x, m * y) | MP x y m <- mpts :]   
+        (xs, ys) = unzipP [: (m D.* x, m D.* y) | MP x y m <- mpts :]   
 
 
 -- | Calculate the accelleration of a point due to the points in the given tree.
@@ -132,12 +132,12 @@ accel   :: Double       -- ^ If the distance between the points is smaller than
         -> Accel
 
 accel epsilon (MP x1 y1 _) (MP x2 y2 m)  
- = (aabs * dx / r , aabs * dy / r)  
- where  rsqr = (dx * dx) + (dy * dy) + epsilon * epsilon
+ = (aabs D.* dx D./ r , aabs D.* dy D./ r)  
+ where  rsqr = (dx D.* dx) D.+ (dy D.* dy) D.+ epsilon D.* epsilon
         r    = sqrt rsqr 
-        dx   = x1 - x2 
-        dy   = y1 - y2 
-        aabs = m / rsqr 
+        dx   = x1 D.- x2 
+        dy   = y1 D.- y2 
+        aabs = m D./ rsqr 
 
 
 -- | If the point is far from a cell in the tree then we can use
@@ -149,8 +149,8 @@ isFar   :: MassPoint    -- point being accelerated
         -> Bool
 
 isFar (MP x1 y1 m) s x2 y2 
- = let  dx      = x2 - x1
-        dy      = y2 - y1
-        dist    = sqrt (dx * dx + dy * dy)
-   in   (s / dist) < 1
+ = let  dx      = x2 D.- x1
+        dy      = y2 D.- y1
+        dist    = sqrt (dx D.* dx D.+ dy D.* dy)
+   in   (s D./ dist) D.< 1
 

testsuite/tests/dph/quickhull/QuickHullVect.hs

@@ -6,14 +6,14 @@ module QuickHullVect (quickhull) where
 import Types
 
 import Data.Array.Parallel
-import Data.Array.Parallel.Prelude.Double
+import Data.Array.Parallel.Prelude.Double as D
 import qualified Data.Array.Parallel.Prelude.Int as Int
 
 import qualified Prelude as P
 
 distance :: Point -> Line -> Double
 distance (xo, yo) ((x1, y1), (x2, y2))
-  = (x1-xo) * (y2 - yo) - (y1 - yo) * (x2 - xo)
+  = (x1 D.- xo) D.* (y2 D.- yo) D.- (y1 D.- yo) D.* (x2 D.- xo)
 
 hsplit :: [:Point:] -> Line -> [:Point:]
 hsplit points line@(p1, p2)
@@ -22,7 +22,7 @@ hsplit points line@(p1, p2)
   = concatP [: hsplit packed ends | ends <- [:(p1, pm), (pm, p2):] :]
   where
     cross  = [: distance p line | p <- points :]
-    packed = [: p | (p,c) <- zipP points cross, c > 0.0 :]
+    packed = [: p | (p,c) <- zipP points cross, c D.> 0.0 :]
     pm     = points !: maxIndexP cross
 
 quickHull' :: [:Point:] -> [:Point:]

testsuite/tests/dph/sumnats/SumNatsVect.hs

@@ -3,12 +3,12 @@
 module SumNatsVect (sumNats) where
 
 import Data.Array.Parallel.Prelude
-import Data.Array.Parallel.Prelude.Int 
+import Data.Array.Parallel.Prelude.Int as I
 
 import qualified Prelude as P
 
 sumNats :: Int -> Int
 sumNats maxN 
-	= sumP [: x 	| x <- enumFromToP 0 (maxN - 1)
-			, (x `mod` 3 == 0) || (x `mod` 5 == 0) :]
-			
+  = sumP [: x | x <- enumFromToP 0 (maxN I.- 1)
+         , (x `mod` 3 I.== 0) || (x `mod` 5 I.== 0) :]
+

testsuite/tests/dph/words/WordsVect.hs

@@ -14,12 +14,12 @@
 {-# OPTIONS -fvectorise #-}
 
 module WordsVect
-	( wordsOfPArray
-	, wordCountOfPArray )
+  ( wordsOfPArray
+  , wordCountOfPArray )
 where
-import qualified Data.Array.Parallel.Prelude.Word8	as W
-import Data.Array.Parallel.Prelude.Word8		(Word8)
-import Data.Array.Parallel.Prelude.Int
+import qualified Data.Array.Parallel.Prelude.Word8 as W
+import Data.Array.Parallel.Prelude.Word8 (Word8)
+import Data.Array.Parallel.Prelude.Int as I
 import Data.Array.Parallel
 
 import qualified Prelude as Prel
@@ -34,24 +34,24 @@ type String	= [: Char :]
 
 -- | Word state
 data State
-	= Chunk	String
-	| Seg 	String 		-- initial word chunk
-		[:String:] 	-- complete words in the middle of the segment
-		String		-- final word chunk
+  = Chunk String
+  | Seg   String  -- initial word chunk
+    [:String:]    -- complete words in the middle of the segment
+    String        -- final word chunk
 
 
 -- | Compose two wordstates.
 plusState :: State -> State -> State
 plusState str1 str2
  = case (str1, str2) of
-	(Chunk as, Chunk bs)		-> Chunk (as +:+ bs)
-	(Chunk as, Seg bl bss br)	-> Seg (as +:+ bl) bss br
-	(Seg al ass ar,	Chunk bs)	-> Seg al ass (ar +:+ bs)
-	(Seg al ass ar,	Seg bl bss br)	-> Seg al (ass +:+ joinEmpty [:ar +:+ bl:] +:+ bss) br
+  (Chunk as, Chunk bs)    -> Chunk (as +:+ bs)
+  (Chunk as, Seg bl bss br) -> Seg (as +:+ bl) bss br
+  (Seg al ass ar, Chunk bs) -> Seg al ass (ar +:+ bs)
+  (Seg al ass ar, Seg bl bss br)  -> Seg al (ass +:+ joinEmpty [:ar +:+ bl:] +:+ bss) br
 
 joinEmpty :: [:[:Word8:]:] -> [:[:Word8:]:]
 joinEmpty ws 
-	| lengthP ws == 1 && lengthP (ws !: 0) == 0	= [::]
+	| lengthP ws I.== 1 && lengthP (ws !: 0) I.== 0	= [::]
 	| otherwise					= ws
 
 
@@ -67,12 +67,12 @@ stateOfString :: String -> State
 stateOfString str
  = let 	len	= lengthP str
    	result
-	 | len == 0	= Chunk [::]
-	 | len == 1	= stateOfChar (str !: 0)
+	 | len I.== 0	= Chunk [::]
+	 | len I.== 1	= stateOfChar (str !: 0)
 	 | otherwise	
 	 =  let	half	= len `div` 2
 		s1	= sliceP 0    half       str
-		s2	= sliceP half (len-half) str
+		s2	= sliceP half (len I.- half) str
 	    in	plusState (stateOfString s1) (stateOfString s2)
     in	result
 
@@ -82,11 +82,11 @@ countWordsOfState :: State -> Int
 countWordsOfState state
  = case state of
 	Chunk c		-> wordsInChunkArr c
-	Seg c1 ws c2 	-> wordsInChunkArr c1 + lengthP ws + wordsInChunkArr c2
+	Seg c1 ws c2 	-> wordsInChunkArr c1 I.+ lengthP ws I.+ wordsInChunkArr c2
 	
 wordsInChunkArr :: [:Word8:] -> Int
 wordsInChunkArr arr
-	| lengthP arr == 0	= 0
+	| lengthP arr I.== 0	= 0
 	| otherwise		= 1
 
 

testsuite/tests/ghci/scripts/ghci011.stdout

@@ -16,6 +16,7 @@ data (,) a b = (,) a b 	-- Defined in `GHC.Tuple'
 instance (Bounded a, Bounded b) => Bounded (a, b)
   -- Defined in `GHC.Enum'
 instance (Eq a, Eq b) => Eq (a, b) -- Defined in `GHC.Classes'
+instance Functor ((,) a) -- Defined in `GHC.Base'
 instance (Ord a, Ord b) => Ord (a, b) -- Defined in `GHC.Classes'
 instance (Read a, Read b) => Read (a, b) -- Defined in `GHC.Read'
 instance (Show a, Show b) => Show (a, b) -- Defined in `GHC.Show'

testsuite/tests/ghci/scripts/ghci020.stdout

 data (->) a b 	-- Defined in `GHC.Prim'
+instance Monad ((->) r) -- Defined in `GHC.Base'
+instance Functor ((->) r) -- Defined in `GHC.Base'

testsuite/tests/lib/haskell98/Makefile

-TOP=../../..
-include $(TOP)/mk/boilerplate.mk
-include $(TOP)/mk/test.mk

testsuite/tests/lib/haskell98/all.T

-test('instance-leaks', normal, compile, ['-hide-all-packages -package haskell98'])

testsuite/tests/lib/haskell98/instance-leaks.hs

--- Check that the instances in Control.Monad.Instances do not leak
--- into any Haskell 98 modules.
-module Main where
-
--- import all Haskell 98 modules
-import Array
-import Char
-import Complex
-import CPUTime
-import Directory
-import IO
-import Ix
-import List
-import Locale
-import Maybe
-import Monad
-import Numeric
-import Random
-import Ratio
-import System
-import Time
-
--- This will fail if any of the Haskell 98 modules indirectly import
--- Control.Monad.Instances
-instance Functor ((->) r) where fmap = (.)
-
-main = undefined

testsuite/tests/lib/integer/Makefile

@@ -30,5 +30,9 @@ integerConstantFolding:
 	$(call CHECK,\<6253\>,shiftRInteger)
 	$(call CHECK,\<641\>,quotInteger)
 	$(call CHECK,\<68\>,remInteger)
+	$(call CHECK,\<200131.0\>,doubleFromInteger)
+	$(call CHECK,\<200135.0\>,floatFromInteger)
+	$(call CHECK,\<400276.0\>,encodeIntegerDouble)
+	$(call CHECK,\<400280.0\>,encodeIntegerFloat)
 	./integerConstantFolding
 

testsuite/tests/lib/integer/integerConstantFolding.hs

@@ -46,6 +46,10 @@ main = do p "plusInteger"        plusInteger
           p "shiftRInteger"     shiftRInteger
           p "quotInteger"       quotInteger
           p "remInteger"        remInteger
+          p "doubleFromInteger" doubleFromInteger
+          p "floatFromInteger"  floatFromInteger
+          p "encodeIntegerDouble" encodeIntegerDouble
+          p "encodeIntegerFloat"  encodeIntegerFloat
 
     where p :: Show a => String -> a -> IO ()
           p str x = putStrLn (str ++ ": " ++ show x)
@@ -159,3 +163,19 @@ quotInteger = 100063 `quot` 156
 remInteger :: Integer
 remInteger = 100064 `rem` 156
 
+-- For the conversion functions, we can't just check that e.g. 100065
+-- is in the resulting core, because it will be regardless of whether
+-- the rules fire or not. So we add 100066, and thus rely on the
+-- Double addition rule also firing.
+doubleFromInteger :: Double
+doubleFromInteger = fromInteger 100065 + 100066
+
+floatFromInteger :: Float
+floatFromInteger = fromInteger 100067 + 100068
+
+encodeIntegerDouble :: Double
+encodeIntegerDouble = encodeFloat 100069 2
+
+encodeIntegerFloat :: Float
+encodeIntegerFloat = encodeFloat 100070 2
+

testsuite/tests/lib/integer/integerConstantFolding.stdout

@@ -40,3 +40,7 @@ shiftLInteger: 1600976
 shiftRInteger: 6253
 quotInteger: 641
 remInteger: 68
+doubleFromInteger: 200131.0
+floatFromInteger: 200135.0
+encodeIntegerDouble: 400276.0
+encodeIntegerFloat: 400280.0