Repository : ssh://darcs.haskell.org//srv/darcs/testsuite On branch : master
http://hackage.haskell.org/trac/ghc/changeset/3affe828b8ddce474ff47fd7399614ed21fbdfa7 >--------------------------------------------------------------- commit 3affe828b8ddce474ff47fd7399614ed21fbdfa7 Author: David Terei <[email protected]> Date: Tue Nov 15 11:43:07 2011 -0800 fix up 5054 test >--------------------------------------------------------------- tests/llvm/should_compile/5054.hs | 13 ++-------- tests/llvm/should_compile/5054_2.hs | 44 +++++++--------------------------- tests/llvm/should_compile/all.T | 4 +- 3 files changed, 14 insertions(+), 47 deletions(-) diff --git a/tests/llvm/should_compile/5054.hs b/tests/llvm/should_compile/5054.hs index f4b38b8..79b01f6 100644 --- a/tests/llvm/should_compile/5054.hs +++ b/tests/llvm/should_compile/5054.hs @@ -8,6 +8,9 @@ import Foreign.Storable import Foreign.Ptr import Foreign.Marshal.Utils +main :: IO () +main = print $ arst (zeroMatrix 10 10) (Constant 9) + data ComputeElement = Constant !Double | Value !Double @@ -24,14 +27,6 @@ fromComputeElement (Value v) = v sizeofDouble = sizeOf (undefined :: Double) sizeofInt64 = sizeOf (undefined :: Int64) -{- -typedef struct -{ - double v; - int64_t c; -} ComputeElement; --} - instance Storable ComputeElement where sizeOf _ = sizeofDouble + sizeofInt64 alignment _ = 16 @@ -58,5 +53,3 @@ arst mat v = runST $ do zeroMatrix m n = buildMatrix m n (const (Value 0)) -main = print $ arst (zeroMatrix 10 10) (Constant 9) - diff --git a/tests/llvm/should_compile/5054_2.hs b/tests/llvm/should_compile/5054_2.hs index 4ca7d0f..29a7ed8 100644 --- a/tests/llvm/should_compile/5054_2.hs +++ b/tests/llvm/should_compile/5054_2.hs @@ -6,17 +6,20 @@ import Data.Packed import Data.Packed.ST import Control.Applicative import Control.Monad ---import qualified Control.Monad.Parallel as Parallel import Control.Monad.ST import Foreign.Storable import Foreign.Ptr import Foreign.Marshal.Utils import Control.Parallel.Strategies ---import Data.Vector.Strategies import Graphics.Plot + +main :: IO () +main = let whee = jacobiST zeroRho (0, 1) (constLeftBorder 100 128) + in writeFile "Something.pgm" $ matrixToPGM (computeElementMatrixToDouble whee) + inParallel = parMap rwhnf id zeroMatrix m n = buildMatrix m n (const 0) @@ -38,19 +41,10 @@ isConstant (Constant _) = True isConstant _ = False fromComputeElement (Constant v) = v -fromComputeElement (Value v) = v +fromComputeElement (Value v) = v sizeofDouble = sizeOf (undefined :: Double) -sizeofInt64 = sizeOf (undefined :: Int64) - - -{- -typedef struct -{ - double v; - int64_t c; -} ComputeElement; --} +sizeofInt64 = sizeOf (undefined :: Int64) instance Storable ComputeElement where sizeOf _ = sizeofDouble + sizeofInt64 @@ -67,27 +61,20 @@ instance Storable ComputeElement where poke (castPtr p) (fromComputeElement v) poke (castPtr p `plusPtr` sizeofDouble) c - - jacobi :: Element a => Int -> Matrix a -> Matrix a jacobi n mat = undefined where core = subMatrix (1, 1) (rows mat - 1, cols mat - 1) mat - applyComputeElement _ v@(Constant _) = v -applyComputeElement f (Value v) = Value (f v) +applyComputeElement f (Value v) = Value (f v) writeMatrix' = uncurry . writeMatrix -readMatrix' = uncurry . readMatrix - +readMatrix' = uncurry . readMatrix zeroRho _ _ = 0 ---jacobiST :: Storable t => Matrix t -> Matrix ComputeElement --- rho :: Double -> Double -> Double - type STComputeMatrix s = STMatrix s ComputeElement type RelaxationFunction s = STComputeMatrix s -- initial matrix @@ -96,9 +83,6 @@ type RelaxationFunction s = STComputeMatrix s -- initial matrix -> Int -- j -> ST s Double -- new element - - - applyMethod :: RelaxationFunction s -> STComputeMatrix s -> STComputeMatrix s -> Int -> Int -> ST s () applyMethod f mat mat' i j = do c <- readMatrix mat i j @@ -164,20 +148,10 @@ jacobiST rho (rangeX, rangeY) origMat = runST $ do freezeMatrix mat' - - - constLeftBorder v n = fromColumns (border:replicate (n - 1) rest) where border = buildVector n (const (Constant v)) rest = buildVector n (const (Value 0)) - computeElementMatrixToDouble :: Matrix ComputeElement -> Matrix Double computeElementMatrixToDouble = liftMatrix (mapVector fromComputeElement) - -herp = let whee = jacobiST zeroRho (0, 1) (constLeftBorder 100 128) - in writeFile "Something.pgm" $ matrixToPGM (computeElementMatrixToDouble whee) - -main = herp - diff --git a/tests/llvm/should_compile/all.T b/tests/llvm/should_compile/all.T index f24494a..8c90892 100644 --- a/tests/llvm/should_compile/all.T +++ b/tests/llvm/should_compile/all.T @@ -5,6 +5,6 @@ def f( opts ): setTestOpts(f) -test('5054', normal, compile, ['']) -test('5054_2', normal, compile, ['']) +test('5054', reqlib('hmatrix'), compile, ['-package hmatrix']) +test('5054_2', reqlib('hmatrix'), compile, ['-package hmatrix']) _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
