H 0.9.0.0 → 0.9.0.1
raw patch · 5 files changed
+3/−256 lines, 5 filesdep −directorydep −singletonsdep −tastydep ~inline-rdep ~vector
Dependencies removed: directory, singletons, tasty, tasty-golden, tasty-hunit, text
Dependency ranges changed: inline-r, vector
Files
- H.cabal +1/−24
- H.ghci +2/−0
- tests/qq.ghci +0/−115
- tests/qq.ghci.golden.out +0/−48
- tests/tests.hs +0/−69
H.cabal view
@@ -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
H.ghci view
@@ -2,6 +2,8 @@ :set -fno-ghci-sandbox :set -XDataKinds :set -XGADTs+:set -XPartialTypeSignatures+:set -XOverloadedLists :set -XQuasiQuotes :set -XScopedTypeVariables :set -XTemplateHaskell
− tests/qq.ghci
@@ -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) |]
− tests/qq.ghci.golden.out
@@ -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"
− tests/tests.hs
@@ -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