Skip to content
GitLab
Commit fcbfdfee authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

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

parents eaae5f42 db6d9cd7
Hide whitespace changes
Inline Side-by-side
testsuite/tests/deriving/should_compile/T3057.hs
View file @ fcbfdfee
{-# 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 0 → 100644
View file @ fcbfdfee
module T3057A where
data MyType a b = C1 a | C2 b
testsuite/tests/deriving/should_compile/all.T
View file @ fcbfdfee
......@@ -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
View file @ fcbfdfee
......@@ -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
View file @ fcbfdfee
......@@ -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
View file @ fcbfdfee
......@@ -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
View file @ fcbfdfee
......@@ -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
View file @ fcbfdfee
......@@ -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
View file @ fcbfdfee
......@@ -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
View file @ fcbfdfee
......@@ -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
View file @ fcbfdfee
......@@ -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
View file @ fcbfdfee
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 deleted 100644 → 0
View file @ eaae5f42
TOP=../../..
include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/test.mk
testsuite/tests/lib/haskell98/all.T deleted 100644 → 0
View file @ eaae5f42
test('instance-leaks', normal, compile, ['-hide-all-packages -package haskell98'])
testsuite/tests/lib/haskell98/instance-leaks.hs deleted 100644 → 0
View file @ eaae5f42
-- 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
View file @ fcbfdfee
......@@ -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
View file @ fcbfdfee
......@@ -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
View file @ fcbfdfee
......@@ -40,3 +40,7 @@ shiftLInteger: 1600976
shiftRInteger: 6253
quotInteger: 641
remInteger: 68
doubleFromInteger: 200131.0
floatFromInteger: 200135.0
encodeIntegerDouble: 400276.0
encodeIntegerFloat: 400280.0
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment