Repository : ssh://darcs.haskell.org//srv/darcs/testsuite On branch : master
http://hackage.haskell.org/trac/ghc/changeset/8e549602ffd64876296ab76d81cc86646695ee4b >--------------------------------------------------------------- commit 8e549602ffd64876296ab76d81cc86646695ee4b Author: Manuel M T Chakravarty <[email protected]> Date: Sun Jun 19 11:52:46 2011 +1000 Adapt DPH tests to recent changes in the DPH libraries. >--------------------------------------------------------------- .gitignore | 2 + .../ghc-regress/dph/diophantine/DiophantineVect.hs | 47 +++++++++++-------- .../dph/diophantine/dph-diophantine-fast | Bin 0 -> 16854700 bytes .../dph/diophantine/dph-diophantine-opt | Bin 0 -> 17017376 bytes tests/ghc-regress/dph/dotp/DotPVect.hs | 2 +- tests/ghc-regress/dph/primespj/PrimesVect.hs | 2 +- tests/ghc-regress/dph/primespj/dph-primespj-fast | Bin 0 -> 16783780 bytes tests/ghc-regress/dph/primespj/dph-primespj.T | 1 - tests/ghc-regress/dph/quickhull/QuickHullVect.hs | 2 +- tests/ghc-regress/dph/quickhull/Types.hs | 2 +- tests/ghc-regress/dph/quickhull/dph-quickhull-fast | Bin 0 -> 17092732 bytes tests/ghc-regress/dph/quickhull/dph-quickhull.T | 1 - tests/ghc-regress/dph/smvm/SMVMVect.hs | 2 +- tests/ghc-regress/dph/smvm/dph-smvm | Bin 0 -> 16581028 bytes tests/ghc-regress/dph/sumnats/dph-sumnats | Bin 0 -> 16101268 bytes tests/ghc-regress/dph/words/WordsVect.hs | 2 +- tests/ghc-regress/dph/words/dph-words-fast | Bin 0 -> 17580076 bytes 17 files changed, 35 insertions(+), 28 deletions(-) diff --git a/.gitignore b/.gitignore index fa0feac..58e5cf3 100644 --- a/.gitignore +++ b/.gitignore @@ -101,3 +101,5 @@ tests/ghc-regress/typecheck/should_fail/T3468.o-boot timeout/calibrate.out timeout/install-inplace/ timeout/dist/ + +/tests/ghc-regress/dph/dotp/dph-dotp-fast \ No newline at end of file diff --git a/tests/ghc-regress/dph/diophantine/DiophantineVect.hs b/tests/ghc-regress/dph/diophantine/DiophantineVect.hs index e76e19a..bef6694 100644 --- a/tests/ghc-regress/dph/diophantine/DiophantineVect.hs +++ b/tests/ghc-regress/dph/diophantine/DiophantineVect.hs @@ -2,30 +2,37 @@ {-# OPTIONS -fvectorise -XParallelListComp #-} module DiophantineVect (solution3) where -import Data.Array.Parallel.Prelude +import Data.Array.Parallel import Data.Array.Parallel.Prelude.Int import qualified Prelude as P -solution3 - = let pow x i = productP (replicateP i x) - primes = [: 2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73 :] - sumpri xx = productP [: pow p x | p <- primes | x <- xx :] - distinct xx = productP [: x + 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) :] +solution3' + = let + pow x i = productP (replicateP i x) + primes = [: 2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73 :] + sumpri xx = productP [: pow p x | p <- primes | x <- xx :] + distinct xx = productP [: x + 1 | x <- xx :] - prob x y - = let xx = [: (sumpri m ,m) - | m <- series (enumFromToP 1 3) x - , distinct [: x * 2 | x <- m :] > y :] - i = minIndexP [: a | (a, b) <- xx :] - in xx !: i + series :: [:Int:] -> Int -> [:[:Int:]:] + series xs n + | n == 1 = [: [: 0 :] :] + | otherwise = [: [: x :] +:+ ps + | x <- xs + , ps <- series (enumFromToP 0 x) (n-1) :] - in prob 7 2000 + prob x y + = let xx = [: (sumpri m ,m) + | m <- series (enumFromToP 1 3) x + , distinct [: x * 2 | x <- m :] > y :] + i = minIndexP [: a | (a, b) <- xx :] + in xx !: i + in + prob 7 2000 +solution3 :: (Int, PArray Int) +{-# NOINLINE solution3 #-} +solution3 + = let (i, is) = solution3' + in + (i, toPArrayP is) diff --git a/tests/ghc-regress/dph/diophantine/dph-diophantine-fast b/tests/ghc-regress/dph/diophantine/dph-diophantine-fast new file mode 100755 index 0000000..81f538e Binary files /dev/null and b/tests/ghc-regress/dph/diophantine/dph-diophantine-fast differ diff --git a/tests/ghc-regress/dph/diophantine/dph-diophantine-opt b/tests/ghc-regress/dph/diophantine/dph-diophantine-opt new file mode 100755 index 0000000..4b64bb4 Binary files /dev/null and b/tests/ghc-regress/dph/diophantine/dph-diophantine-opt differ diff --git a/tests/ghc-regress/dph/dotp/DotPVect.hs b/tests/ghc-regress/dph/dotp/DotPVect.hs index 500de2e..5b62301 100644 --- a/tests/ghc-regress/dph/dotp/DotPVect.hs +++ b/tests/ghc-regress/dph/dotp/DotPVect.hs @@ -2,7 +2,7 @@ {-# OPTIONS -fvectorise #-} module DotPVect ( dotp ) where -import Data.Array.Parallel.Prelude +import Data.Array.Parallel import Data.Array.Parallel.Prelude.Double as D import qualified Prelude diff --git a/tests/ghc-regress/dph/primespj/PrimesVect.hs b/tests/ghc-regress/dph/primespj/PrimesVect.hs index 0b96679..34b3a56 100644 --- a/tests/ghc-regress/dph/primespj/PrimesVect.hs +++ b/tests/ghc-regress/dph/primespj/PrimesVect.hs @@ -3,7 +3,7 @@ module PrimesVect (primesVect) where -import Data.Array.Parallel.Prelude +import Data.Array.Parallel import Data.Array.Parallel.Prelude.Int import qualified Prelude diff --git a/tests/ghc-regress/dph/primespj/dph-primespj-fast b/tests/ghc-regress/dph/primespj/dph-primespj-fast new file mode 100755 index 0000000..4509099 Binary files /dev/null and b/tests/ghc-regress/dph/primespj/dph-primespj-fast differ diff --git a/tests/ghc-regress/dph/primespj/dph-primespj.T b/tests/ghc-regress/dph/primespj/dph-primespj.T index 04b9de9..4584904 100644 --- a/tests/ghc-regress/dph/primespj/dph-primespj.T +++ b/tests/ghc-regress/dph/primespj/dph-primespj.T @@ -12,7 +12,6 @@ test ('dph-primespj-opt' test ('dph-primespj-fast' , [ reqlib('dph-par') , reqlib('dph-prim-par') - , expect_broken(5065) , only_ways(['normal', 'threaded1', 'threaded2']) ] , multimod_compile_and_run , [ 'Main' diff --git a/tests/ghc-regress/dph/quickhull/QuickHullVect.hs b/tests/ghc-regress/dph/quickhull/QuickHullVect.hs index 92a7bb6..29aaa4a 100644 --- a/tests/ghc-regress/dph/quickhull/QuickHullVect.hs +++ b/tests/ghc-regress/dph/quickhull/QuickHullVect.hs @@ -5,7 +5,7 @@ module QuickHullVect (quickhull) where import Types -import Data.Array.Parallel.Prelude +import Data.Array.Parallel import Data.Array.Parallel.Prelude.Double import qualified Data.Array.Parallel.Prelude.Int as Int diff --git a/tests/ghc-regress/dph/quickhull/Types.hs b/tests/ghc-regress/dph/quickhull/Types.hs index eebc392..162458f 100644 --- a/tests/ghc-regress/dph/quickhull/Types.hs +++ b/tests/ghc-regress/dph/quickhull/Types.hs @@ -3,7 +3,7 @@ module Types ( Point, Line, points, xsOf, ysOf) where -import Data.Array.Parallel.Prelude +import Data.Array.Parallel type Point = (Double, Double) type Line = (Point, Point) diff --git a/tests/ghc-regress/dph/quickhull/dph-quickhull-fast b/tests/ghc-regress/dph/quickhull/dph-quickhull-fast new file mode 100755 index 0000000..ef83e50 Binary files /dev/null and b/tests/ghc-regress/dph/quickhull/dph-quickhull-fast differ diff --git a/tests/ghc-regress/dph/quickhull/dph-quickhull.T b/tests/ghc-regress/dph/quickhull/dph-quickhull.T index 0f856e5..f1a1deb 100644 --- a/tests/ghc-regress/dph/quickhull/dph-quickhull.T +++ b/tests/ghc-regress/dph/quickhull/dph-quickhull.T @@ -12,7 +12,6 @@ test ('dph-quickhull-opt' test ('dph-quickhull-fast' , [ reqlib('dph-par') , reqlib('dph-prim-par') - , expect_broken(5065) , only_ways(['normal', 'threaded1', 'threaded2']) ] , multimod_compile_and_run , [ 'Main' diff --git a/tests/ghc-regress/dph/smvm/SMVMVect.hs b/tests/ghc-regress/dph/smvm/SMVMVect.hs index 21ba6b1..93f3775 100644 --- a/tests/ghc-regress/dph/smvm/SMVMVect.hs +++ b/tests/ghc-regress/dph/smvm/SMVMVect.hs @@ -2,7 +2,7 @@ {-# OPTIONS -fvectorise #-} module SMVMVect (smvm) where -import Data.Array.Parallel.Prelude +import Data.Array.Parallel import Data.Array.Parallel.Prelude.Double as D import Data.Array.Parallel.Prelude.Int as I diff --git a/tests/ghc-regress/dph/smvm/dph-smvm b/tests/ghc-regress/dph/smvm/dph-smvm new file mode 100755 index 0000000..2cf446f Binary files /dev/null and b/tests/ghc-regress/dph/smvm/dph-smvm differ diff --git a/tests/ghc-regress/dph/sumnats/dph-sumnats b/tests/ghc-regress/dph/sumnats/dph-sumnats new file mode 100755 index 0000000..b9d671e Binary files /dev/null and b/tests/ghc-regress/dph/sumnats/dph-sumnats differ diff --git a/tests/ghc-regress/dph/words/WordsVect.hs b/tests/ghc-regress/dph/words/WordsVect.hs index 940aa91..43880fd 100644 --- a/tests/ghc-regress/dph/words/WordsVect.hs +++ b/tests/ghc-regress/dph/words/WordsVect.hs @@ -20,7 +20,7 @@ where import qualified Data.Array.Parallel.Prelude.Word8 as W import Data.Array.Parallel.Prelude.Word8 (Word8) import Data.Array.Parallel.Prelude.Int -import Data.Array.Parallel.Prelude +import Data.Array.Parallel import qualified Prelude as Prel diff --git a/tests/ghc-regress/dph/words/dph-words-fast b/tests/ghc-regress/dph/words/dph-words-fast new file mode 100755 index 0000000..ba2942f Binary files /dev/null and b/tests/ghc-regress/dph/words/dph-words-fast differ _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
