diff --git a/H.cabal b/H.cabal --- a/H.cabal +++ b/H.cabal @@ -1,5 +1,5 @@ name: H -version: 0.9.0.0 +version: 0.9.0.1 license: BSD3 license-file: LICENSE copyright: Copyright (c) 2013-2015 Amgen, Inc. @@ -14,8 +14,6 @@ homepage: https://tweag.github.io/HaskellR cabal-version: >=1.10 extra-source-files: H.ghci - tests/qq.ghci - tests/qq.ghci.golden.out source-repository head type: git @@ -36,24 +34,3 @@ , vector >= 0.10 default-language: Haskell2010 ghc-options: -Wall -threaded - -test-suite tests - main-is: tests.hs - type: exitcode-stdio-1.0 - build-depends: base >= 4.6 && < 5 - , bytestring >= 0.10 - , directory >= 1.2 - , inline-r >= 0.9 && < 0.10 - , process >= 1.2 - , tasty >= 0.3 - , tasty-golden >= 2.3 - , tasty-hunit >= 0.4.1 - , text >= 0.11 - , vector - , singletons - -- Adding -j4 causes quasiquoters to be compiled concurrently - -- in tests, which helps testing for race conditions when - -- trying to initialize R from multiple threads. - ghc-options: -Wall -threaded -j4 - hs-source-dirs: tests - default-language: Haskell2010 diff --git a/H.ghci b/H.ghci --- a/H.ghci +++ b/H.ghci @@ -2,6 +2,8 @@ :set -fno-ghci-sandbox :set -XDataKinds :set -XGADTs +:set -XPartialTypeSignatures +:set -XOverloadedLists :set -XQuasiQuotes :set -XScopedTypeVariables :set -XTemplateHaskell diff --git a/tests/qq.ghci b/tests/qq.ghci deleted file mode 100644 --- a/tests/qq.ghci +++ /dev/null @@ -1,115 +0,0 @@ -:set -XScopedTypeVariables -:m +Data.Int -import qualified Foreign.R as R -import Control.Applicative ((<$>)) - --- Should be: [1] 1 -p [r| 1 |] - --- Should be: [1] 2 -p [r| 1 + 2 |] - --- Should be: [1] "1" "2" "3" -p [r| c(1,2,"3") |] :: IO () - --- Should be: [1] 2 -p [r| x <<- 2 |] :: IO () - --- Should be: [1] 3 -p [r| x+1 |] - ----- Should be: [1] 6 -let y = (5::Double) -p [r| y_hs + 1 |] - --- Printing of functions gives non deterministic output (env names change). ---p [r| function(y) y_hs + y |] - --- Should be 8 -p [r| z <- function(y) y_hs + y; z(3) |] - --- Should be [1] 1 2 3 4 5 6 7 8 9 10 -p [r| y <<- c(1:10) |] -let foo1 = (\x -> (return $ x+1 :: R s Double)) -let foo2 = (\x -> (return $ map (+1) x :: R s [Int32])) - --- Should be [1] 2 -p [r| mapply(foo1_hs, 2) |] - --- Should be [1] 2 3 4 5 6 7 8 9 10 11 -p [r| mapply(foo2_hs, y) |] - --- Should be [1] 43 -p [r| x <<- 42 ; x + 1 |] - --- Should be [1] 1 2 3 -let xs = [1,2,3]::[Double] -p [r| xs_hs |] - --- Should be [1] 8 -p [r| foo1_hs(7) |] - --- Should be NULL -p (return nilValue) - --- Should be [1] 3 -let foo3 = (\n -> fmap fromSomeSEXP [r| n_hs |]) :: Int32 -> R s Int32 -p [r| foo3_hs(3L) |] - --- | should be 3 -let foo4 = (\n m -> return $ n + m) :: Double -> Double -> R s Double -p [r| foo4_hs(33, 66) |] - --- Should be [1] 120 but it doesn't work -let fact n = if n == (0 :: Int32) then (return 1 :: R s Int32) else fmap fromSomeSEXP [r| as.integer(n_hs * fact_hs(n_hs - 1L)) |] -p [r| fact_hs(5L) |] - --- Should be [1] 29 -let foo5 = (\n -> return (n+1)) :: Int32 -> R s Int32 -let apply = (\n m -> [r| n_hs(m_hs) |]) :: SEXP s 'R.Closure -> Int32 -> R s (R.SomeSEXP s) -p [r| apply_hs(foo5_hs, 28L ) |] - -p $ install "blah" - -:{ -let hFib :: SEXP s 'R.Int -> R s (SEXP s 'R.Int) - hFib n@(fromSEXP -> 0 :: Int32) = fmap (flip R.asTypeOf n) [r| 0L |] - hFib n@(fromSEXP -> 1 :: Int32) = fmap (flip R.asTypeOf n) [r| 1L |] - hFib n = (`R.asTypeOf` n) <$> [r| hFib_hs(n_hs - 1L) + hFib_hs(n_hs - 2L) |] -:} - --- Should be [1] 4181 --- p Prelude.runR defaultConfig (hFib (Prelude.mkSEXP (19 :: Int32))) -- XXX produces wrong result. - --- s4 objects test --- Create an S4 class -p [r| setClass("x-test",representation(a = "numeric", b = "numeric"), prototype(a=1,b=2)) |] --- instantiate and object in R -p [r| x <<- new("x-test") |] --- instantiate and object and pass it to H as-is -x <- [r| new("x-test") |] -p (return x) --- Should be 1. Use slot accessor on R object. -p [r| x@a |] --- Should be 2. Use slot accessor on H object. -p [r| x_hs@b |] --- Should be "S4". Get type of R object. -p [r| typeof(x) |] --- Should be "S4". Get type of H object. -p [r| typeof(x_hs) |] - -:{ -let testpm :: SomeSEXP s -> IO () - testpm (SomeSEXP z@(hexp -> S4 _)) - | R.TRUE <- dynSEXP [rsafe| z_hs @ a > 0 |] = p (return z) - | otherwise = print "unexpected value" -:} - -testpm x - --- Should be "S4". Get type of H object. --- XXX This is a workaround to avoid the test hanging on windows. --- For some reason, if the output of ghci is redirected and the last --- command in the test is `testpm x`, then ghci executes all commands --- but does not produce any R output and seems to block forever. -p [r| typeof(x_hs) |] diff --git a/tests/qq.ghci.golden.out b/tests/qq.ghci.golden.out deleted file mode 100644 --- a/tests/qq.ghci.golden.out +++ /dev/null @@ -1,48 +0,0 @@ -[1] 1 -[1] 3 -[1] "1" "2" "3" -[1] 2 -[1] 3 -[1] 6 -[1] 8 - [1] 1 2 3 4 5 6 7 8 9 10 -[1] 3 - [1] 2 3 4 5 6 7 8 9 10 11 -[1] 43 -[1] 1 2 3 -[1] 8 -NULL -[1] 3 -[1] 99 -[1] 120 -[1] 29 -blah -class generator function for class "x-test" from package '.GlobalEnv' -function (...) -new("x-test", ...) -An object of class "x-test" -Slot "a": -[1] 1 - -Slot "b": -[1] 2 - -An object of class "x-test" -Slot "a": -[1] 1 - -Slot "b": -[1] 2 - -[1] 1 -[1] 2 -[1] "S4" -[1] "S4" -An object of class "x-test" -Slot "a": -[1] 1 - -Slot "b": -[1] 2 - -[1] "S4" diff --git a/tests/tests.hs b/tests/tests.hs deleted file mode 100644 --- a/tests/tests.hs +++ /dev/null @@ -1,69 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ViewPatterns #-} - --- | Contains golden tests. To reset the expected output with the actual output, --- run with @--accept@ or remove the golden file that you want to reset. - -module Main where - -import Control.Applicative -import Data.Text (Text) -import qualified Data.Text as Text -import qualified Data.Text.IO as Text -import qualified Language.R.Instance as R -import System.Environment (setEnv) -import System.IO -import System.Process -import Test.Tasty -import Test.Tasty.Golden.Advanced -import Prelude -- silence AMP warning - --- | Pipe input to given command and return stdout, stderr. -cat :: FilePath -> [String] -> FilePath -> IO (Text, Text) -cat cmd args fp = do - inh <- openFile fp ReadMode - (_, Just outh, Just errh, _) <- createProcess $ (proc cmd args) - { std_in = UseHandle inh - , std_out = CreatePipe - , std_err = CreatePipe - } - (,) <$> Text.hGetContents outh <*> Text.hGetContents errh - -invokeH :: FilePath -> IO (Text, Text) -invokeH = cat "H" [] - -gold :: TestName -> FilePath -> IO Text -> TestTree -gold name golden action = - goldenTest - name - (Text.readFile golden) - action - (\(scrub -> expected) (scrub -> actual) -> - if Text.words expected == Text.words actual - then return Nothing - else return $ Just $ - unlines ["Outputs don't match." - , "Expected:" - , Text.unpack expected - , "" - , "Actual:" - , Text.unpack actual - ]) - (Text.writeFile golden) - where - scrub = Text.replace "\r\n" "\n" - -tests :: TestTree -tests = testGroup "Integration tests" - [ gold - "qq" - "tests/qq.ghci.golden.out" - (fst <$> invokeH "tests/qq.ghci") - ] - -main :: IO () -main = do - -- Normalize internalization settings. - setEnv "LC_ALL" "C" - _ <- R.initialize R.defaultConfig - defaultMain tests