[commit: ghc] master: Testsuite: delete T5054 and T5054_2 (#5054) (e20b3ed)

git at git.haskell.org git at git.haskell.org
Thu Apr 28 21:09:35 UTC 2016


Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/e20b3ed0d0a3eda9b52544f06694667ddc2dd3a1/ghc

>---------------------------------------------------------------

commit e20b3ed0d0a3eda9b52544f06694667ddc2dd3a1
Author: Thomas Miedema <thomasmiedema at gmail.com>
Date:   Mon Apr 25 17:22:55 2016 +0200

    Testsuite: delete T5054 and T5054_2 (#5054)
    
    These tests no longer compile, because the hmatrix api has completely
    changed. Even if we managed to fix the tests, I don't think they would
    provided much value, since the ghc/llvm bug from #5054 was not
    reproducible in the first place.
    
    Reviewed by: bgamari
    
    Differential Revision: https://phabricator.haskell.org/D2139


>---------------------------------------------------------------

e20b3ed0d0a3eda9b52544f06694667ddc2dd3a1
 testsuite/tests/llvm/should_compile/T5054.hs   |  55 ---------
 testsuite/tests/llvm/should_compile/T5054_2.hs | 157 -------------------------
 testsuite/tests/llvm/should_compile/all.T      |   2 -
 3 files changed, 214 deletions(-)

diff --git a/testsuite/tests/llvm/should_compile/T5054.hs b/testsuite/tests/llvm/should_compile/T5054.hs
deleted file mode 100644
index 79b01f6..0000000
--- a/testsuite/tests/llvm/should_compile/T5054.hs
+++ /dev/null
@@ -1,55 +0,0 @@
-{-# OPTIONS_GHC -W #-}
-
-import Data.Int
-import Data.Packed
-import Data.Packed.ST
-import Control.Monad.ST
-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
-  deriving (Eq)
-
-isConstant (Constant _) = True
-isConstant _            = False
-
-instance Element ComputeElement
-
-fromComputeElement (Constant v) = v
-fromComputeElement (Value    v) = v
-
-sizeofDouble = sizeOf (undefined :: Double)
-sizeofInt64  = sizeOf (undefined :: Int64)
-
-instance Storable ComputeElement where
-    sizeOf    _ = sizeofDouble + sizeofInt64
-    alignment _ = 16
-
-    peek p = do
-        v <- peek (castPtr p)
-        c <- peek (castPtr (p `plusPtr` sizeofDouble))
-        return $ if toBool (c :: Int64)
-            then Constant v
-            else Value v
-
-    poke p v = do
-        let c :: Int64
-            c = fromBool (isConstant v)
-        poke (castPtr p) (fromComputeElement v)
-        poke (castPtr p `plusPtr` sizeofDouble) c
-
-
-arst mat v = runST $ do
-    mat' <- thawMatrix mat
-    writeMatrix mat' 1 2 v
-    x <- fromComputeElement `fmap` readMatrix mat' 1 9
-    return (x > 0)
-
-zeroMatrix m n = buildMatrix m n (const (Value 0))
-
diff --git a/testsuite/tests/llvm/should_compile/T5054_2.hs b/testsuite/tests/llvm/should_compile/T5054_2.hs
deleted file mode 100644
index 29a7ed8..0000000
--- a/testsuite/tests/llvm/should_compile/T5054_2.hs
+++ /dev/null
@@ -1,157 +0,0 @@
-{-# LANGUAGE NoMonomorphismRestriction #-}
-{-# OPTIONS_GHC -W #-}
-
-import Data.Int
-import Data.Packed
-import Data.Packed.ST
-import Control.Applicative
-import Control.Monad
-import Control.Monad.ST
-import Foreign.Storable
-import Foreign.Ptr
-import Foreign.Marshal.Utils
-
-import Control.Parallel.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)
-
-twoMatrix m n = buildMatrix m n (const (Value 2))
-
-data ComputeElement = Constant !Double
-                    | Value !Double
-                    deriving (Eq)
-
--- We don't care about showing if it's constant or not
-instance Show ComputeElement where
-  show (Constant v) = show v
-  show (Value v) = show v
-
-instance Element ComputeElement
-
-isConstant (Constant _) = True
-isConstant _            = False
-
-fromComputeElement (Constant v) = v
-fromComputeElement (Value    v) = v
-
-sizeofDouble = sizeOf (undefined :: Double)
-sizeofInt64  = sizeOf (undefined :: Int64)
-
-instance Storable ComputeElement where
-  sizeOf _ = sizeofDouble + sizeofInt64
-  alignment _ = 16
-
-  peek p = do v <- peek (castPtr p)
-              c <- peek (castPtr (p `plusPtr` sizeofDouble))
-              return $ if toBool (c :: Int64)
-                         then Constant v
-                         else Value v
-
-  poke p v = do let c :: Int64
-                    c = fromBool (isConstant v)
-                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)
-
-
-writeMatrix' = uncurry . writeMatrix
-readMatrix'  = uncurry . readMatrix
-
-zeroRho _ _ = 0
-
-type STComputeMatrix s = STMatrix s ComputeElement
-
-type RelaxationFunction s =  STComputeMatrix s    -- initial matrix
-                          -> STComputeMatrix s -- new matrix
-                          -> Int               -- i
-                          -> 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
-  u <- f mat mat' i j
-  writeMatrix mat' i j $ if isConstant c
-                           then c
-                           else Value u
-
-{-# INLINE readElement #-}
-readElement mat x y = fromComputeElement <$> readMatrix mat x y
-
-jacobiST :: (Double -> Double -> Double) -> (Double, Double) -> Matrix ComputeElement -> Matrix ComputeElement
-jacobiST rho (rangeX, rangeY) origMat = runST $ do
-  let m = rows origMat
-      n = cols origMat
-
-      dx = rangeX / fromIntegral (m - 1)
-      dy = rangeY / fromIntegral (n - 1)
-      dd = dx * dy
-
-      rs = [1 .. (m - 2)] -- without borders
-      cs = [1 .. (n - 2)]
-
-      evalRho i j = rho (fromIntegral i * dx) (fromIntegral j * dy)
-
-      gaussSeidel f mat mat' i j = do
-        -- Read from old matrix
-        a1 <- readElement mat (i + 1) j
-        a2 <- readElement mat i       (j + 1)
-
-        -- Read from new matrix
-        b1 <- readElement mat' (i - 1) j
-        b2 <- readElement mat' i       (j - 1)
-        let f = evalRho i j
-            u = 0.25 * (a1 + a2 + b1 + b2) + (pi * f * dd)
-        return u
-
-
-      jacobi mat mat' i j = do
-        a <- readElement mat (i + 1) j
-        b <- readElement mat (i - 1) j
-        c <- readElement mat i       (j + 1)
-        d <- readElement mat i       (j - 1)
-
-        let f = evalRho i j
-            u = 0.25 * (a + b + c + d) + (pi * f * dd)
-        return u
-
-      jacobiThings = applyMethod jacobi
-
-      --iterateJacobi mat mat' = sequence_ [jacobiThings mat mat' r c | r <- rs, c <- cs]
-
-      -- faster
-      iterateJacobi mat mat' = sequence_ $ map (uncurry (jacobiThings mat mat')) [(r, c) | r <- rs, c <- cs]
-
-      -- Swap the matrices. Iterations will be an event number, 2 * n
-      iterateNJacobi n mat mat' = replicateM n (iterateJacobi mat mat' >> iterateJacobi mat' mat)
-
-  mat  <- thawMatrix origMat
-  mat' <- thawMatrix origMat
-
-  iterateNJacobi 4000 mat mat'
-
-  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)
-
diff --git a/testsuite/tests/llvm/should_compile/all.T b/testsuite/tests/llvm/should_compile/all.T
index 6806c25..0708615 100644
--- a/testsuite/tests/llvm/should_compile/all.T
+++ b/testsuite/tests/llvm/should_compile/all.T
@@ -5,8 +5,6 @@ def f( name, opts ):
 
 setTestOpts(f)
 
-test('T5054', reqlib('hmatrix'), compile, ['-package hmatrix'])
-test('T5054_2', reqlib('hmatrix'), compile, ['-package hmatrix'])
 # test('T5486', reqlib('integer-gmp'), compile, [''])
 test('T5681', normal, compile, [''])
 test('T6158', [reqlib('vector'), reqlib('primitive')], compile, ['-package vector -package primitive'])



More information about the ghc-commits mailing list