jvm 0.5.0 → 0.6.0
raw patch · 4 files changed
+107/−8 lines, 4 filesdep +QuickCheckdep +quickcheck-textdep ~jni
Dependencies added: QuickCheck, quickcheck-text
Dependency ranges changed: jni
Files
- benchmarks/Main.hs +15/−1
- jvm.cabal +5/−2
- src/common/Language/Java/Unsafe.hs +44/−2
- tests/Language/JavaSpec.hs +43/−3
benchmarks/Main.hs view
@@ -105,7 +105,7 @@ benchRefs :: Benchmark benchRefs =- env (Box <$> new) $ \ ~(Box (jobj :: JObject)) ->+ env (Box <$> (new >>= newGlobalRefNonFinalized)) $ \ ~(Box (jobj :: JObject)) -> bgroup "References" [ bench "local reference" $ nfIO $ do _ <- newLocalRef jobj@@ -116,6 +116,20 @@ , bench "global reference (no finalizer)" $ nfIO $ do _ <- newGlobalRefNonFinalized jobj return ()+ -- The next three benchmarks are to be compared with one another:+ -- The goal is to evaluate the cost of attaching a thread to the JVM+ -- when deleting a non-finalized global ref, versus the cost+ -- of having a dedicated thread to do the deleting+ , bench "delete global reference in attached thread" $ nfIO $+ newGlobalRefNonFinalized jobj >>= deleteGlobalRefNonFinalized+ , envWithCleanup+ detachCurrentThread+ (const attachCurrentThreadAsDaemon) $+ \_ -> bench "delete global reference in non-attached thread" $ nfIO $ runInAttachedThread $+ newGlobalRefNonFinalized jobj >>= deleteGlobalRefNonFinalized+ , bench "pass global references to another thread for deletion" $ nfIO $+ newGlobalRefNonFinalized jobj >>=+ submitToFinalizerThread . deleteGlobalRefNonFinalized , bench "Foreign.Concurrent.newForeignPtr" $ nfIO $ do _ <- Concurrent.newForeignPtr (unsafeObjectToPtr jobj) (return ()) return ()
jvm.cabal view
@@ -1,5 +1,5 @@ name: jvm-version: 0.5.0+version: 0.6.0 synopsis: Call JVM methods from Haskell. description: Please see README.md. homepage: http://github.com/tweag/inline-java/tree/master/jvm#readme@@ -35,7 +35,7 @@ choice >=0.1, distributed-closure >=0.3, exceptions >=0.8,- jni >=0.7.0 && <0.8,+ jni >=0.8.0 && <0.9, text >=1.2, template-haskell, vector >=0.11@@ -64,9 +64,12 @@ hspec, jni, jvm,+ QuickCheck,+ quickcheck-text, text default-language: Haskell2010 extra-libraries: pthread+ ghc-options: -threaded cpp-options: -DHSPEC_DISCOVER=hspec-discover benchmark micro-benchmarks
src/common/Language/Java/Unsafe.hs view
@@ -47,10 +47,12 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE GADTs #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -96,6 +98,10 @@ , Interpretation(..) , Reify(..) , Reflect(..)+ , Nullable(..)+ , pattern Null+ , pattern NotNull+ , W8Bool(..) -- * Re-exports , sing ) where@@ -525,6 +531,18 @@ default reflect :: (Coercible a, Interp a ~ Ty a) => a -> IO (J (Interp a)) reflect x = newLocalRef (jobject x) +-- | A newtype wrapper for representing Java values that can be null+newtype Nullable a = Nullable (Maybe a)+ deriving (Eq, Ord, Show)++pattern Null :: Nullable a+pattern Null <- Nullable Nothing where+ Null = Nullable Nothing++pattern NotNull :: a -> Nullable a+pattern NotNull a <- Nullable (Just a) where+ NotNull a = Nullable (Just a)+ reifyMVector :: Storable a => (JArray ty -> IO (Ptr a))@@ -539,8 +557,8 @@ jobj <- newGlobalRefNonFinalized jobj0 n <- getArrayLength jobj ptr <- mk jobj- fptr <- newForeignPtr ptr $ finalize jobj ptr- `finally` deleteGlobalRefNonFinalized jobj+ fptr <- newForeignPtr ptr $ submitToFinalizerThread $+ finalize jobj ptr `finally` deleteGlobalRefNonFinalized jobj return (MVector.unsafeFromForeignPtr0 fptr (fromIntegral n)) reflectMVector@@ -713,6 +731,16 @@ instance Reflect Float where reflect = new + instance Interpretation a => Interpretation (Nullable a) where+ type Interp (Nullable a) = Interp a++ instance Reify a => Reify (Nullable a) where+ reify jobj = if jobj == jnull then return Null else NotNull <$> reify jobj++ instance Reflect a => Reflect (Nullable a) where+ reflect Null = return jnull+ reflect (NotNull a) = reflect a+ instance Interpretation Text where type Interp Text = 'Class "java.lang.String" @@ -728,6 +756,20 @@ reflect x = Text.useAsPtr x $ \ptr len -> newString ptr (fromIntegral len)++ newtype W8Bool = W8Bool { fromW8Bool :: Word8 }+ deriving (Enum, Eq, Integral, Num, Ord, Real, Show, Storable)++ instance Interpretation (IOVector W8Bool) where+ type Interp (IOVector W8Bool) = 'Array ('Prim "boolean")++ instance Reify (IOVector W8Bool) where+ reify = fmap (Coerce.coerce :: IOVector Word8 -> IOVector W8Bool) .+ reifyMVector getBooleanArrayElements releaseBooleanArrayElements++ instance Reflect (IOVector W8Bool) where+ reflect = reflectMVector newBooleanArray setBooleanArrayRegion .+ (Coerce.coerce :: IOVector W8Bool -> IOVector Word8) instance Interpretation (IOVector Word16) where type Interp (IOVector Word16) = 'Array ('Prim "char")
tests/Language/JavaSpec.hs view
@@ -7,15 +7,22 @@ module Language.JavaSpec where +import Control.Concurrent (runInBoundThread)+import Control.Monad (join) import Data.Int import qualified Data.Text as Text-import Data.Text (Text)-import Foreign.JNI (getArrayLength)+import Data.Text (Text, isInfixOf)+import Data.Text.Arbitrary ()+import Data.Text.Encoding (encodeUtf8)+import Foreign.JNI (getArrayLength, runInAttachedThread)+import qualified Foreign.JNI.String as JNI import Language.Java import Test.Hspec+import Test.Hspec.QuickCheck+import Test.QuickCheck spec :: Spec-spec = do+spec = around_ (runInBoundThread . runInAttachedThread) $ do describe "callStatic" $ do it "can call double-returning static functions" $ do jstr <- reflect ("1.2345" :: Text)@@ -89,3 +96,36 @@ let i = maxBound :: Int32 j <- new i :: IO (J ('Class "java.lang.Integer")) reify (unsafeCast j) `shouldReturn` (fromIntegral i :: Int64)++ it "correctly encodes characters outside ASCII range" $ do+ let incorrect :: Text = "आपकी उम्र लंबी हो और आप समृद्ध बने 👋"+ let correct = Text.replace "👋" "🖖" incorrect+ hello <- reflect ("👋" :: Text)+ spock <- reflect ("🖖" :: Text)+ jincorrect <- reflect incorrect+ jcorrect :: JString <- call jincorrect "replaceFirst" hello spock+ reify jcorrect `shouldReturn` correct++ describe "strings" $ do+ -- It is known that the current implementation of JNI.String does not support embedded NULL+ prop "correctly convert back and forth from Prelude.String to JNI.String" $+ \s -> (notElem '\NUL' s) ==> (s === (JNI.toChars . JNI.fromChars) s)+ prop "correctly convert back and forth from JNI.String to Prelude.String" $+ \t -> (not $ isInfixOf "\NUL" t) ==>+ let s = JNI.fromByteString $ encodeUtf8 t+ in s === (JNI.fromChars . JNI.toChars) s++ prop "correctly convert back and forth from Data.Text to java.lang.String" $+ \(textBefore :: Text) -> ioProperty $ do+ withLocalRef (reflect textBefore) $ \jTextBefore ->+ -- call substring() to force returning a new object+ withLocalRef (call jTextBefore "substring" (0 :: Int32)) $ \(jTextAfter :: JString) -> do+ textAfter :: Text <- reify jTextAfter+ return $ textBefore === textAfter++ prop "correctly convert back and forth from java.lang.String to Data.Text" $+ \(textBefore :: Text) -> ioProperty $ do+ withLocalRef (reflect textBefore) $ \jTextBefore ->+ withLocalRef (join $ (reflect . Text.copy) <$> reify jTextBefore) $ \jTextAfter -> do+ isEqual :: Bool <- call jTextBefore "equals" (upcast jTextAfter)+ return $ isEqual === True