6 files changed, 96 insertions, 0 deletions
diff --git a/testsuite/tests/dph/dotp/DotPVect.hs b/testsuite/tests/dph/dotp/DotPVect.hs
new file mode 100644
index 0000000000..5b623017d9
--- /dev/null
+++ b/testsuite/tests/dph/dotp/DotPVect.hs
@@ -0,0 +1,15 @@
+{-# LANGUAGE ParallelArrays #-}
+{-# OPTIONS -fvectorise #-}
+module DotPVect ( dotp ) where
+
+import Data.Array.Parallel
+import Data.Array.Parallel.Prelude.Double as D
+
+import qualified Prelude
+
+dotp :: PArray Double -> PArray Double -> Double
+{-# NOINLINE dotp #-}
+dotp v w = dotp' (fromPArrayP v) (fromPArrayP w)
+
+dotp' :: [:Double:] -> [:Double:] -> Double
+dotp' v w = D.sumP (zipWithP (*) v w)
diff --git a/testsuite/tests/dph/dotp/Main.hs b/testsuite/tests/dph/dotp/Main.hs
new file mode 100644
index 0000000000..436beb07fd
--- /dev/null
+++ b/testsuite/tests/dph/dotp/Main.hs
@@ -0,0 +1,54 @@
+import DotPVect ( dotp )
+
+import Control.Exception (evaluate)
+import System.Console.GetOpt
+import qualified System.Random as R
+
+import qualified Data.Array.Parallel.Unlifted as U
+import qualified Data.Array.Parallel.PArray   as P
+import Data.Array.Parallel.PArray (PArray)
+
+
+
+generateVectorU :: Int -> IO (U.Array Double)
+generateVectorU n =
+  do
+    let seed = 42742
+    let rg   = R.mkStdGen seed
+    let -- The std random function is too slow to generate really big vectors
+        -- with.  Instead, we generate a short random vector and repeat that.
+        randvec = U.randomRs k (-100, 100) rg
+        vec     = U.map (\i -> randvec U.!: (i `mod` k)) (U.enumFromTo 0 (n-1))
+    evaluate vec
+    return vec
+  where
+    k = 1000
+
+generateVector :: Int -> IO (PArray Double)
+generateVector n 
+  = do
+      vec <- generateVectorU n
+      return $ P.fromUArrPA' vec
+
+generateVectors :: Int -> IO (PArray Double, PArray Double)
+generateVectors n =
+  do
+    v <- generateVector n
+    w <- generateVector n
+    return (v,w)
+
+main 
+ = do	-- compute dot product with NDP
+	vectors			<- generateVectors 100000
+	let resultViaNDP	= (uncurry dotp) vectors
+
+	-- compute with lists
+	let (aVecX, aVecY) = vectors
+	let vecX		= P.toList aVecX
+	let vecY		= P.toList aVecY
+	let resultViaList	= sum $ zipWith (*) vecX vecY
+
+	-- ignore wibbles in low order bits
+	putStr $ (take 12 $ show resultViaNDP) ++ "\n"
+	putStr $ (take 12 $ show resultViaList) ++ "\n"
+	
diff --git a/testsuite/tests/dph/dotp/Makefile b/testsuite/tests/dph/dotp/Makefile
new file mode 100644
index 0000000000..9101fbd40a
--- /dev/null
+++ b/testsuite/tests/dph/dotp/Makefile
@@ -0,0 +1,3 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
diff --git a/testsuite/tests/dph/dotp/dph-dotp-fast.stdout b/testsuite/tests/dph/dotp/dph-dotp-fast.stdout
new file mode 100644
index 0000000000..e8f012cbc6
--- /dev/null
+++ b/testsuite/tests/dph/dotp/dph-dotp-fast.stdout
@@ -0,0 +1,2 @@
+3.3659625259
+3.3659625259
diff --git a/testsuite/tests/dph/dotp/dph-dotp-opt.stdout b/testsuite/tests/dph/dotp/dph-dotp-opt.stdout
new file mode 100644
index 0000000000..e8f012cbc6
--- /dev/null
+++ b/testsuite/tests/dph/dotp/dph-dotp-opt.stdout
@@ -0,0 +1,2 @@
+3.3659625259
+3.3659625259
diff --git a/testsuite/tests/dph/dotp/dph-dotp.T b/testsuite/tests/dph/dotp/dph-dotp.T
new file mode 100644
index 0000000000..2ebab9da24
--- /dev/null
+++ b/testsuite/tests/dph/dotp/dph-dotp.T
@@ -0,0 +1,20 @@
+
+test    ('dph-dotp-opt' 
+        , [ alone
+          , skip_if_fast
+          , reqlib('dph-par')
+          , reqlib('dph-prim-par')
+          , only_ways(['normal', 'threaded1', 'threaded2']) ] 
+        , multimod_compile_and_run 
+        , [ 'Main'
+          , '-Odph -fdph-par'])
+
+test    ('dph-dotp-fast' 
+        , [ reqlib('dph-par')
+          , reqlib('dph-prim-par')
+          , only_ways(['normal', 'threaded1', 'threaded2']) ] 
+        , multimod_compile_and_run 
+        , [ 'Main'
+          , '-O -fno-enable-rewrite-rules -fdph-par'])
+
+