diff --git a/benchmarks/Main.hs b/benchmarks/Main.hs --- a/benchmarks/Main.hs +++ b/benchmarks/Main.hs @@ -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 () diff --git a/jvm.cabal b/jvm.cabal --- a/jvm.cabal +++ b/jvm.cabal @@ -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 diff --git a/src/common/Language/Java/Unsafe.hs b/src/common/Language/Java/Unsafe.hs --- a/src/common/Language/Java/Unsafe.hs +++ b/src/common/Language/Java/Unsafe.hs @@ -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") diff --git a/tests/Language/JavaSpec.hs b/tests/Language/JavaSpec.hs --- a/tests/Language/JavaSpec.hs +++ b/tests/Language/JavaSpec.hs @@ -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