diff --git a/Config.hs b/Config.hs --- a/Config.hs +++ b/Config.hs @@ -96,13 +96,9 @@ cs ',' = ' ' cs x = x -config = do - info <- maybeGetPersistBuildConfig "dist" - case info of - Nothing -> putStrLn "Please run \"cabal clean\" first." >> exitFailure - Just bInfo -> mainOk bInfo - -mainOk bInfo = do +config :: LocalBuildInfo -> IO HookedBuildInfo + +config bInfo = do putStr "Checking foreign libraries..." args <- getArgs @@ -123,6 +119,7 @@ createDirectoryIfMissing True $ buildDir bInfo r <- try bInfo buildInfo base fwks fullOpts + case r of Nothing -> do putStrLn " FAIL" @@ -132,14 +129,13 @@ else putStrLn " *** Sorry, I can't link GSL." putStrLn " *** Please make sure that the appropriate -dev packages are installed." putStrLn " *** You can also specify the required libraries using" - putStrLn " *** cabal install hmatrix --configure-option=link:lib1,lib2,lib3,etc." - writeFile "hmatrix.buildinfo" ("buildable: False\n") + putStrLn " *** cabal install hmatrix --configure-option=link:lib1,lib2,lib3,etc." + return (Just emptyBuildInfo { buildable = False }, []) Just ops -> do - putStrLn " OK" + putStrLn $ " OK " ++ ops g <- checkCommand $ gsl112 bInfo buildInfo - writeFile "hmatrix.buildinfo" $ "extra-libraries: " ++ - ops ++ "\n" ++ - if g - then "" - else "cc-options: -DGSL110\n" + let hbi = if g + then emptyBuildInfo { extraLibs = words ops} + else emptyBuildInfo { extraLibs = words ops, ccOptions = ["-DGSL110"]} + return (Just hbi, []) diff --git a/Setup.lhs b/Setup.lhs --- a/Setup.lhs +++ b/Setup.lhs @@ -1,43 +1,20 @@ #! /usr/bin/env runhaskell > import Distribution.Simple -> import System.Process(system) -> -> import Config(config) -> > import Distribution.Simple.Setup > import Distribution.PackageDescription > import Distribution.Simple.LocalBuildInfo -> import Distribution.Simple.Command -> import Distribution.PackageDescription.Parse -> import Distribution.Simple.Utils(info) -> import Distribution.Verbosity -> main = do -> defaultMainWithHooks autoconfUserHooks { -> runTests = t, -> postConf = modifiedPostConf } -> where modifiedPostConf :: Args -> ConfigFlags -> PackageDescription -> LocalBuildInfo -> IO () -> modifiedPostConf args flags pkg_descr lbi -> = do let verbosity = fromFlag (configVerbosity flags) -> noExtraFlags args -> -> config -> -> pbi <- getHookedBuildInfo verbosity -> let pkg_descr' = updatePackageDescription pbi pkg_descr -> postConf simpleUserHooks args flags pkg_descr' lbi - +> import System.Process(system) +> import Config(config) -> getHookedBuildInfo :: Verbosity -> IO HookedBuildInfo -> getHookedBuildInfo verbosity = do -> maybe_infoFile <- defaultHookedPackageDesc -> case maybe_infoFile of -> Nothing -> return emptyHookedBuildInfo -> Just infoFile -> do -> info verbosity $ "Reading parameters from " ++ infoFile -> readHookedBuildInfo verbosity infoFile +> main = defaultMainWithHooks simpleUserHooks { confHook = c, runTests = t } +> c x y = do +> binfo <- confHook simpleUserHooks x y +> pbi <- config binfo +> let pkg_descr = localPkgDescr binfo +> return $ binfo { localPkgDescr = updatePackageDescription pbi pkg_descr } > t _ _ _ _ = system ( "runhaskell examples/tests.hs") >> return() diff --git a/THANKS b/THANKS --- a/THANKS +++ b/THANKS @@ -92,5 +92,5 @@ found a tolerance problem in test "1E5 rots". - Duncan Coutts reported a problem with configure.hs and contributed - a solution. + a solution and a simplified a Setup.lhs. diff --git a/hmatrix.cabal b/hmatrix.cabal --- a/hmatrix.cabal +++ b/hmatrix.cabal @@ -1,5 +1,5 @@ Name: hmatrix -Version: 0.11.0.3 +Version: 0.11.0.4 License: GPL License-file: LICENSE Author: Alberto Ruiz @@ -29,7 +29,6 @@ extra-source-files: lib/Numeric/LinearAlgebra/Tests/quickCheckCompat.h Config.hs THANKS INSTALL CHANGES -extra-tmp-files: hmatrix.buildinfo extra-source-files: examples/tests.hs examples/deriv.hs @@ -87,6 +86,14 @@ description: Force FPU initialization in foreing calls default: False +flag debugfpu + description: Check FPU stack + default: False + +flag debugnan + description: Check NaN + default: False + library Build-Depends: base >= 4 && < 5, @@ -164,12 +171,21 @@ if impl(ghc < 6.10.2) cpp-options: -DFINIT - if impl(ghc >= 7.0.1) + if impl(ghc == 7.0.1) cpp-options: -DFINIT + if impl(ghc == 7.0.2) + cpp-options: -DFINIT + if flag(finit) cpp-options: -DFINIT + if flag(debugfpu) + cc-options: -DFPUDEBUG + + if flag(debugnan) + cc-options: -DNANDEBUG + if impl(ghc == 7.0.1) cpp-options: -DNONORMVTEST @@ -202,4 +218,8 @@ type: darcs location: http://patch-tag.com/r/aruiz/hmatrix -- location: http://code.haskell.org/hmatrix + +-- Test-Suite tests +-- type: exitcode-stdio-1.0 +-- main-is: examples/tests.hs diff --git a/lib/Numeric/LinearAlgebra/LAPACK/lapack-aux.c b/lib/Numeric/LinearAlgebra/LAPACK/lapack-aux.c --- a/lib/Numeric/LinearAlgebra/LAPACK/lapack-aux.c +++ b/lib/Numeric/LinearAlgebra/LAPACK/lapack-aux.c @@ -47,11 +47,58 @@ //--------------------------------------- void asm_finit() { #ifdef i386 - asm("finit"); + +// asm("finit"); + + static unsigned char buf[108]; + asm("FSAVE %0":"=m" (buf)); + + #if FPUDEBUG + if(buf[8]!=255 || buf[9]!=255) { // print warning in red + printf("%c[;31mWarning: FPU TAG = %x %x\%c[0m\n",0x1B,buf[8],buf[9],0x1B); + } + #endif + + #if NANDEBUG + asm("FRSTOR %0":"=m" (buf)); + #endif + #endif } + //--------------------------------------- +#if NANDEBUG + +#define CHECKNANR(M,msg) \ +{ int k; \ +for(k=0; k<(M##r * M##c); k++) { \ + if(M##p[k] != M##p[k]) { \ + printf(msg); \ + TRACEMAT(M) \ + /*exit(1);*/ \ + } \ +} \ +} + +#define CHECKNANC(M,msg) \ +{ int k; \ +for(k=0; k<(M##r * M##c); k++) { \ + if( M##p[k].r != M##p[k].r \ + || M##p[k].i != M##p[k].i) { \ + printf(msg); \ + /*exit(1);*/ \ + } \ +} \ +} + +#else +#define CHECKNANC(M,msg) +#define CHECKNANR(M,msg) +#endif + +//--------------------------------------- + //////////////////// real svd //////////////////////////////////// int svd_l_R(KDMAT(a),DMAT(u), DVEC(s),DMAT(v)) { @@ -1014,6 +1061,8 @@ int multiplyR(int ta, int tb, KDMAT(a),KDMAT(b),DMAT(r)) { //REQUIRES(ac==br && ar==rr && bc==rc,BAD_SIZE); DEBUGMSG("dgemm_"); + CHECKNANR(a,"NaN multR Input\n") + CHECKNANR(b,"NaN multR Input\n") integer m = ta?ac:ar; integer n = tb?br:bc; integer k = ta?ar:ac; @@ -1023,6 +1072,7 @@ double alpha = 1; double beta = 0; dgemm_(ta?"T":"N",tb?"T":"N",&m,&n,&k,&alpha,ap,&lda,bp,&ldb,&beta,rp,&ldc); + CHECKNANR(r,"NaN multR Output\n") OK } @@ -1033,6 +1083,8 @@ int multiplyC(int ta, int tb, KCMAT(a),KCMAT(b),CMAT(r)) { //REQUIRES(ac==br && ar==rr && bc==rc,BAD_SIZE); DEBUGMSG("zgemm_"); + CHECKNANC(a,"NaN multC Input\n") + CHECKNANC(b,"NaN multC Input\n") integer m = ta?ac:ar; integer n = tb?br:bc; integer k = ta?ar:ac; @@ -1045,6 +1097,7 @@ ap,&lda, bp,&ldb,&beta, rp,&ldc); + CHECKNANC(r,"NaN multC Output\n") OK } diff --git a/lib/Numeric/LinearAlgebra/Tests.hs b/lib/Numeric/LinearAlgebra/Tests.hs --- a/lib/Numeric/LinearAlgebra/Tests.hs +++ b/lib/Numeric/LinearAlgebra/Tests.hs @@ -17,7 +17,7 @@ module Numeric.LinearAlgebra.Tests( -- module Numeric.LinearAlgebra.Tests.Instances, -- module Numeric.LinearAlgebra.Tests.Properties, - qCheck, runTests, runBenchmarks + qCheck, runTests, runBenchmarks, findNaN --, runBigTests ) where @@ -512,6 +512,8 @@ putStrLn "------ chol" test (cholProp . rPosDef) test (cholProp . cPosDef) + test (exactProp . rPosDef) + test (exactProp . cPosDef) putStrLn "------ expm" test (expmDiagProp . complex. rSqWC) test (expmDiagProp . cSqWC) @@ -593,6 +595,11 @@ -- -- | Some additional tests on big matrices. They take a few minutes. -- runBigTests :: IO () -- runBigTests = undefined + +-- testcase for nonempty fpu stack +findNaN :: Int -> Bool +findNaN n = all (bugProp . eye) (take n $ cycle [1..20]) + where eye m = ident m :: Matrix ( Double) -------------------------------------------------------------------------------- diff --git a/lib/Numeric/LinearAlgebra/Tests/Properties.hs b/lib/Numeric/LinearAlgebra/Tests/Properties.hs --- a/lib/Numeric/LinearAlgebra/Tests/Properties.hs +++ b/lib/Numeric/LinearAlgebra/Tests/Properties.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP, FlexibleContexts #-} {-# OPTIONS_GHC -fno-warn-unused-imports #-} ----------------------------------------------------------------------------- {- | @@ -29,13 +29,14 @@ pinvProp, detProp, nullspaceProp, + bugProp, svdProp1, svdProp1a, svdProp1b, svdProp2, svdProp3, svdProp4, svdProp5a, svdProp5b, svdProp6a, svdProp6b, svdProp7, eigProp, eigSHProp, eigProp2, eigSHProp2, qrProp, rqProp, rqProp1, rqProp2, rqProp3, hessProp, schurProp1, schurProp2, - cholProp, + cholProp, exactProp, expmDiagProp, multProp1, multProp2, subProp, @@ -132,6 +133,15 @@ ------------------------------------------------------------------ +-- testcase for nonempty fpu stack +-- uncommenting unitary' signature eliminates the problem +bugProp m = m |~| u <> real d <> trans v && unitary' u && unitary' v + where (u,d,v) = fullSVD m + -- unitary' :: (Num (Vector t), Field t) => Matrix t -> Bool + unitary' a = unitary a + +------------------------------------------------------------------ + -- fullSVD svdProp1 m = m |~| u <> real d <> trans v && unitary u && unitary v where (u,d,v) = fullSVD m @@ -237,7 +247,8 @@ cholProp m = m |~| ctrans c <> c && upperTriang c where c = chol m - -- pos = positiveDefinite m + +exactProp m = chol m == chol (m+0) expmDiagProp m = expm (logm m) :~ 7 ~: complex m where logm = matFunc log