THRIFT-932. hs: Haskell tests need to be run through 'make check' (and probably 'cabal check') too
Tests are now self-contained and correctly exit after running. There's a single run script which has improved error messages and defaults to the thrift binary compiled in the current source directory instead of those in PATH. And as a bonus hooks both cabal check and running the tests to make check.
Patch: Christian Lavoie
git-svn-id: https://svn.apache.org/repos/asf/incubator/thrift/trunk@1004861 13f79535-47bb-0310-9956-ffa450edef68
diff --git a/configure.ac b/configure.ac
index dc08344..bf8ef6d 100644
--- a/configure.ac
+++ b/configure.ac
@@ -203,14 +203,18 @@
AX_THRIFT_LIB(haskell, [Haskell], yes)
have_haskell=no
RUNHASKELL=true
+CABAL=true
if test "$with_haskell" = "yes"; then
+ AC_PATH_PROG([CABAL], [cabal])
AC_PATH_PROG([RUNHASKELL], [runhaskell])
- if test "x$RUNHASKELL" != "x"; then
+ if test "x$CABAL" != "x" -a "x$RUNHASKELL" != "x"; then
have_haskell="yes"
else
RUNHASKELL=true
+ CABAL=true
fi
fi
+AC_SUBST(CABAL)
AC_SUBST(RUNHASKELL)
AM_CONDITIONAL(WITH_HASKELL, [test "$have_haskell" = "yes"])
@@ -351,9 +355,9 @@
lib/Makefile
lib/cpp/Makefile
lib/cpp/test/Makefile
- lib/cpp/thrift.pc
lib/cpp/thrift-nb.pc
lib/cpp/thrift-z.pc
+ lib/cpp/thrift.pc
lib/csharp/Makefile
lib/erl/Makefile
lib/erl/src/Makefile
@@ -365,6 +369,7 @@
lib/py/Makefile
lib/rb/Makefile
test/Makefile
+ test/hs/Makefile
test/py/Makefile
test/rb/Makefile
])
@@ -417,6 +422,7 @@
if test "$have_haskell" = "yes" ; then
echo
echo "Using Haskell ................ : $RUNHASKELL"
+ echo "Using Cabal .................. : $CABAL"
fi
if test "$have_perl" = "yes" ; then
echo
diff --git a/lib/hs/Makefile.am b/lib/hs/Makefile.am
index 4c4208d..95734f0 100644
--- a/lib/hs/Makefile.am
+++ b/lib/hs/Makefile.am
@@ -37,3 +37,6 @@
maintainer-clean-local:
$(RUNHASKELL) Setup.lhs clean
+
+check-local:
+ $(CABAL) check
diff --git a/test/Makefile.am b/test/Makefile.am
index 7256f21..86b0067 100644
--- a/test/Makefile.am
+++ b/test/Makefile.am
@@ -27,6 +27,9 @@
SUBDIRS += rb
endif
+if WITH_HASKELL
+SUBDIRS += hs
+endif
EXTRA_DIST = \
cpp \
diff --git a/test/hs/ConstantsDemo_Main.hs b/test/hs/ConstantsDemo_Main.hs
new file mode 100644
index 0000000..28de4f7
--- /dev/null
+++ b/test/hs/ConstantsDemo_Main.hs
@@ -0,0 +1,68 @@
+--
+-- Licensed to the Apache Software Foundation (ASF) under one
+-- or more contributor license agreements. See the NOTICE file
+-- distributed with this work for additional information
+-- regarding copyright ownership. The ASF licenses this file
+-- to you under the Apache License, Version 2.0 (the
+-- "License"); you may not use this file except in compliance
+-- with the License. You may obtain a copy of the License at
+--
+-- http://www.apache.org/licenses/LICENSE-2.0
+--
+-- Unless required by applicable law or agreed to in writing,
+-- software distributed under the License is distributed on an
+-- "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+-- KIND, either express or implied. See the License for the
+-- specific language governing permissions and limitations
+-- under the License.
+--
+
+module Main where
+
+
+import qualified Control.Exception
+import qualified Network
+
+import Thrift.Protocol.Binary
+import Thrift.Server
+import Thrift.Transport.Handle
+
+import qualified ThriftTestUtils
+
+import qualified Yowza
+import qualified Yowza_Client as Client
+import qualified Yowza_Iface as Iface
+
+
+data YowzaHandler = YowzaHandler
+instance Iface.Yowza_Iface YowzaHandler where
+ blingity _ = do
+ ThriftTestUtils.serverLog "SERVER: Got blingity"
+ return ()
+
+ blangity _ = do
+ ThriftTestUtils.serverLog "SERVER: Got blangity"
+ return $ 31
+
+
+client :: (String, Network.PortID) -> IO ()
+client addr = do
+ to <- hOpen addr
+ let ps = (BinaryProtocol to, BinaryProtocol to)
+
+ Client.blingity ps
+
+ rv <- Client.blangity ps
+ ThriftTestUtils.clientLog $ show rv
+
+ tClose to
+
+server :: Network.PortNumber -> IO ()
+server port = do
+ ThriftTestUtils.serverLog "Ready..."
+ (runBasicServer YowzaHandler Yowza.process port)
+ `Control.Exception.catch`
+ (\(TransportExn s _) -> error $ "FAILURE: " ++ show s)
+
+main :: IO ()
+main = ThriftTestUtils.runTest server client
diff --git a/test/hs/ConstantsDemo_TestClient.hs b/test/hs/ConstantsDemo_TestClient.hs
deleted file mode 100644
index 1cc350d..0000000
--- a/test/hs/ConstantsDemo_TestClient.hs
+++ /dev/null
@@ -1,44 +0,0 @@
-{-# LANGUAGE ScopedTypeVariables #-}
---
--- Licensed to the Apache Software Foundation (ASF) under one
--- or more contributor license agreements. See the NOTICE file
--- distributed with this work for additional information
--- regarding copyright ownership. The ASF licenses this file
--- to you under the Apache License, Version 2.0 (the
--- "License"); you may not use this file except in compliance
--- with the License. You may obtain a copy of the License at
---
--- http://www.apache.org/licenses/LICENSE-2.0
---
--- Unless required by applicable law or agreed to in writing,
--- software distributed under the License is distributed on an
--- "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
--- KIND, either express or implied. See the License for the
--- specific language governing permissions and limitations
--- under the License.
---
-
-module ConstantsDemo_TestClient where
-
-
-import Network
-
-import Thrift
-import Thrift.Protocol.Binary
-import Thrift.Transport.Handle
-
-import Yowza_Client
-
-
-serverAddress :: (String, PortID)
-serverAddress = ("127.0.0.1", PortNumber 9090)
-
-main :: IO ()
-main = do
- to <- hOpen serverAddress
- let p = BinaryProtocol to
- let ps = (p,p)
- blingity ps
- print =<< blangity ps
- tClose to
-
diff --git a/test/hs/ConstantsDemo_TestServer.hs b/test/hs/ConstantsDemo_TestServer.hs
deleted file mode 100644
index 10b2177..0000000
--- a/test/hs/ConstantsDemo_TestServer.hs
+++ /dev/null
@@ -1,47 +0,0 @@
---
--- Licensed to the Apache Software Foundation (ASF) under one
--- or more contributor license agreements. See the NOTICE file
--- distributed with this work for additional information
--- regarding copyright ownership. The ASF licenses this file
--- to you under the Apache License, Version 2.0 (the
--- "License"); you may not use this file except in compliance
--- with the License. You may obtain a copy of the License at
---
--- http://www.apache.org/licenses/LICENSE-2.0
---
--- Unless required by applicable law or agreed to in writing,
--- software distributed under the License is distributed on an
--- "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
--- KIND, either express or implied. See the License for the
--- specific language governing permissions and limitations
--- under the License.
---
-
-module ConstantsDemo_TestServer where
-
-
-import Control.Exception
-
-import Thrift
-import Thrift.Server
-
-import Yowza
-import Yowza_Iface
-
-
-data YowzaHandler = YowzaHandler
-instance Yowza_Iface YowzaHandler where
- blingity _ = do
- print $ "Got blingity"
- return ()
-
- blangity _ = do
- print $ "Got blangity"
- return $ 31
-
-
-main :: IO ()
-main = do putStrLn "Server ready..."
- (runBasicServer YowzaHandler process 9090)
- `Control.Exception.catch`
- (\(TransportExn s _) -> print s)
diff --git a/test/hs/DebugProtoTest_Main.hs b/test/hs/DebugProtoTest_Main.hs
new file mode 100644
index 0000000..816eee3
--- /dev/null
+++ b/test/hs/DebugProtoTest_Main.hs
@@ -0,0 +1,164 @@
+--
+-- Licensed to the Apache Software Foundation (ASF) under one
+-- or more contributor license agreements. See the NOTICE file
+-- distributed with this work for additional information
+-- regarding copyright ownership. The ASF licenses this file
+-- to you under the Apache License, Version 2.0 (the
+-- "License"); you may not use this file except in compliance
+-- with the License. You may obtain a copy of the License at
+--
+-- http://www.apache.org/licenses/LICENSE-2.0
+--
+-- Unless required by applicable law or agreed to in writing,
+-- software distributed under the License is distributed on an
+-- "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+-- KIND, either express or implied. See the License for the
+-- specific language governing permissions and limitations
+-- under the License.
+--
+
+module Main where
+
+
+import qualified Control.Exception
+import qualified Data.ByteString.Lazy as DBL
+import qualified Maybe
+import qualified Network
+
+import Thrift.Protocol.Binary
+import Thrift.Server
+import Thrift.Transport.Handle
+
+import qualified ThriftTestUtils
+
+import qualified DebugProtoTest_Types as Types
+import qualified Inherited
+import qualified Inherited_Client as IClient
+import qualified Inherited_Iface as IIface
+import qualified Srv_Client as SClient
+import qualified Srv_Iface as SIface
+
+-- we don't actually need this import, but force it to check the code generator exports proper Haskell syntax
+import qualified Srv()
+
+
+data InheritedHandler = InheritedHandler
+instance SIface.Srv_Iface InheritedHandler where
+ janky _ arg = do
+ ThriftTestUtils.serverLog $ "Got janky method call: " ++ show arg
+ return $ 31
+
+ voidMethod _ = do
+ ThriftTestUtils.serverLog "Got voidMethod method call"
+ return ()
+
+ primitiveMethod _ = do
+ ThriftTestUtils.serverLog "Got primitiveMethod call"
+ return $ 42
+
+ structMethod _ = do
+ ThriftTestUtils.serverLog "Got structMethod call"
+ return $ Types.CompactProtoTestStruct {
+ Types.f_CompactProtoTestStruct_a_byte = Just 0x01,
+ Types.f_CompactProtoTestStruct_a_i16 = Just 0x02,
+ Types.f_CompactProtoTestStruct_a_i32 = Just 0x03,
+ Types.f_CompactProtoTestStruct_a_i64 = Just 0x04,
+ Types.f_CompactProtoTestStruct_a_double = Just 0.1,
+ Types.f_CompactProtoTestStruct_a_string = Just "abcdef",
+ Types.f_CompactProtoTestStruct_a_binary = Just DBL.empty,
+ Types.f_CompactProtoTestStruct_true_field = Just True,
+ Types.f_CompactProtoTestStruct_false_field = Just False,
+ Types.f_CompactProtoTestStruct_empty_struct_field = Just Types.Empty,
+
+ Types.f_CompactProtoTestStruct_byte_list = Nothing,
+ Types.f_CompactProtoTestStruct_i16_list = Nothing,
+ Types.f_CompactProtoTestStruct_i32_list = Nothing,
+ Types.f_CompactProtoTestStruct_i64_list = Nothing,
+ Types.f_CompactProtoTestStruct_double_list = Nothing,
+ Types.f_CompactProtoTestStruct_string_list = Nothing,
+ Types.f_CompactProtoTestStruct_binary_list = Nothing,
+ Types.f_CompactProtoTestStruct_boolean_list = Nothing,
+ Types.f_CompactProtoTestStruct_struct_list = Just [Types.Empty],
+
+ Types.f_CompactProtoTestStruct_byte_set = Nothing,
+ Types.f_CompactProtoTestStruct_i16_set = Nothing,
+ Types.f_CompactProtoTestStruct_i32_set = Nothing,
+ Types.f_CompactProtoTestStruct_i64_set = Nothing,
+ Types.f_CompactProtoTestStruct_double_set = Nothing,
+ Types.f_CompactProtoTestStruct_string_set = Nothing,
+ Types.f_CompactProtoTestStruct_binary_set = Nothing,
+ Types.f_CompactProtoTestStruct_boolean_set = Nothing,
+ Types.f_CompactProtoTestStruct_struct_set = Nothing,
+
+ Types.f_CompactProtoTestStruct_byte_byte_map = Nothing,
+ Types.f_CompactProtoTestStruct_i16_byte_map = Nothing,
+ Types.f_CompactProtoTestStruct_i32_byte_map = Nothing,
+ Types.f_CompactProtoTestStruct_i64_byte_map = Nothing,
+ Types.f_CompactProtoTestStruct_double_byte_map = Nothing,
+ Types.f_CompactProtoTestStruct_string_byte_map = Nothing,
+ Types.f_CompactProtoTestStruct_binary_byte_map = Nothing,
+ Types.f_CompactProtoTestStruct_boolean_byte_map = Nothing,
+
+ Types.f_CompactProtoTestStruct_byte_i16_map = Nothing,
+ Types.f_CompactProtoTestStruct_byte_i32_map = Nothing,
+ Types.f_CompactProtoTestStruct_byte_i64_map = Nothing,
+ Types.f_CompactProtoTestStruct_byte_double_map = Nothing,
+ Types.f_CompactProtoTestStruct_byte_string_map = Nothing,
+ Types.f_CompactProtoTestStruct_byte_binary_map = Nothing,
+ Types.f_CompactProtoTestStruct_byte_boolean_map = Nothing,
+
+ Types.f_CompactProtoTestStruct_list_byte_map = Nothing,
+ Types.f_CompactProtoTestStruct_set_byte_map = Nothing,
+ Types.f_CompactProtoTestStruct_map_byte_map = Nothing,
+
+ Types.f_CompactProtoTestStruct_byte_map_map = Nothing,
+ Types.f_CompactProtoTestStruct_byte_set_map = Nothing,
+ Types.f_CompactProtoTestStruct_byte_list_map = Nothing }
+
+ methodWithDefaultArgs _ arg = do
+ ThriftTestUtils.serverLog $ "Got methodWithDefaultArgs: " ++ show arg
+ return ()
+
+ onewayMethod _ = do
+ ThriftTestUtils.serverLog "Got onewayMethod"
+
+instance IIface.Inherited_Iface InheritedHandler where
+ identity _ arg = do
+ ThriftTestUtils.serverLog $ "Got identity method: " ++ show arg
+ return $ Maybe.fromJust arg
+
+client :: (String, Network.PortID) -> IO ()
+client addr = do
+ to <- hOpen addr
+ let p = BinaryProtocol to
+ let ps = (p,p)
+
+ v1 <- SClient.janky ps 42
+ ThriftTestUtils.clientLog $ show v1
+
+ SClient.voidMethod ps
+
+ v2 <- SClient.primitiveMethod ps
+ ThriftTestUtils.clientLog $ show v2
+
+ v3 <- SClient.structMethod ps
+ ThriftTestUtils.clientLog $ show v3
+
+ SClient.methodWithDefaultArgs ps 42
+
+ SClient.onewayMethod ps
+
+ v4 <- IClient.identity ps 42
+ ThriftTestUtils.clientLog $ show v4
+
+ return ()
+
+server :: Network.PortNumber -> IO ()
+server port = do
+ ThriftTestUtils.serverLog "Ready..."
+ (runBasicServer InheritedHandler Inherited.process port)
+ `Control.Exception.catch`
+ (\(TransportExn s _) -> error $ "FAILURE: " ++ show s)
+
+main :: IO ()
+main = ThriftTestUtils.runTest server client
diff --git a/test/hs/DebugProtoTest_TestClient.hs b/test/hs/DebugProtoTest_TestClient.hs
deleted file mode 100644
index fc1582b..0000000
--- a/test/hs/DebugProtoTest_TestClient.hs
+++ /dev/null
@@ -1,49 +0,0 @@
-{-# LANGUAGE ScopedTypeVariables #-}
---
--- Licensed to the Apache Software Foundation (ASF) under one
--- or more contributor license agreements. See the NOTICE file
--- distributed with this work for additional information
--- regarding copyright ownership. The ASF licenses this file
--- to you under the Apache License, Version 2.0 (the
--- "License"); you may not use this file except in compliance
--- with the License. You may obtain a copy of the License at
---
--- http://www.apache.org/licenses/LICENSE-2.0
---
--- Unless required by applicable law or agreed to in writing,
--- software distributed under the License is distributed on an
--- "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
--- KIND, either express or implied. See the License for the
--- specific language governing permissions and limitations
--- under the License.
---
-
-module DebugProtoTest_TestClient where
-
-
-import Network
-
-import Thrift.Transport.Handle
-import Thrift.Protocol.Binary
-
-import Inherited_Client
-import Srv_Client
-
-
-serverAddress :: (String, PortID)
-serverAddress = ("127.0.0.1", PortNumber 9090)
-
-main :: IO ()
-main = do to <- hOpen serverAddress
- let p = BinaryProtocol to
- let ps = (p,p)
- print =<< janky ps 42
- voidMethod ps
- _ <- primitiveMethod ps
- _ <- structMethod ps
- methodWithDefaultArgs ps 42
- onewayMethod ps
- _ <- identity ps 42
- return ()
-
-
diff --git a/test/hs/DebugProtoTest_TestServer.hs b/test/hs/DebugProtoTest_TestServer.hs
deleted file mode 100644
index af3e5a9..0000000
--- a/test/hs/DebugProtoTest_TestServer.hs
+++ /dev/null
@@ -1,125 +0,0 @@
---
--- Licensed to the Apache Software Foundation (ASF) under one
--- or more contributor license agreements. See the NOTICE file
--- distributed with this work for additional information
--- regarding copyright ownership. The ASF licenses this file
--- to you under the Apache License, Version 2.0 (the
--- "License"); you may not use this file except in compliance
--- with the License. You may obtain a copy of the License at
---
--- http://www.apache.org/licenses/LICENSE-2.0
---
--- Unless required by applicable law or agreed to in writing,
--- software distributed under the License is distributed on an
--- "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
--- KIND, either express or implied. See the License for the
--- specific language governing permissions and limitations
--- under the License.
---
-
-module DebugProtoTest_TestServer where
-
-
-import Control.Exception
-import qualified Data.ByteString.Lazy as DBL
-import Maybe
-
-import Thrift
-import Thrift.Server
-
-import DebugProtoTest_Types
-import Inherited
-import Inherited_Iface
-import Srv_Iface
-
-
-data InheritedHandler = InheritedHandler
-instance Srv_Iface InheritedHandler where
- janky _ arg = do
- print $ "Got janky method call: " ++ show arg
- return $ 31
-
- voidMethod _ = do
- print "Got voidMethod method call"
- return ()
-
- primitiveMethod _ = do
- print "Got primitiveMethod call"
- return $ 42
-
- structMethod _ = do
- print "Got structMethod call"
- return $ CompactProtoTestStruct {
- f_CompactProtoTestStruct_a_byte = Just 0x01,
- f_CompactProtoTestStruct_a_i16 = Just 0x02,
- f_CompactProtoTestStruct_a_i32 = Just 0x03,
- f_CompactProtoTestStruct_a_i64 = Just 0x04,
- f_CompactProtoTestStruct_a_double = Just 0.1,
- f_CompactProtoTestStruct_a_string = Just "abcdef",
- f_CompactProtoTestStruct_a_binary = Just DBL.empty,
- f_CompactProtoTestStruct_true_field = Just True,
- f_CompactProtoTestStruct_false_field = Just False,
- f_CompactProtoTestStruct_empty_struct_field = Just Empty,
-
- f_CompactProtoTestStruct_byte_list = Nothing,
- f_CompactProtoTestStruct_i16_list = Nothing,
- f_CompactProtoTestStruct_i32_list = Nothing,
- f_CompactProtoTestStruct_i64_list = Nothing,
- f_CompactProtoTestStruct_double_list = Nothing,
- f_CompactProtoTestStruct_string_list = Nothing,
- f_CompactProtoTestStruct_binary_list = Nothing,
- f_CompactProtoTestStruct_boolean_list = Nothing,
- f_CompactProtoTestStruct_struct_list = Just [Empty],
-
- f_CompactProtoTestStruct_byte_set = Nothing,
- f_CompactProtoTestStruct_i16_set = Nothing,
- f_CompactProtoTestStruct_i32_set = Nothing,
- f_CompactProtoTestStruct_i64_set = Nothing,
- f_CompactProtoTestStruct_double_set = Nothing,
- f_CompactProtoTestStruct_string_set = Nothing,
- f_CompactProtoTestStruct_binary_set = Nothing,
- f_CompactProtoTestStruct_boolean_set = Nothing,
- f_CompactProtoTestStruct_struct_set = Nothing,
-
- f_CompactProtoTestStruct_byte_byte_map = Nothing,
- f_CompactProtoTestStruct_i16_byte_map = Nothing,
- f_CompactProtoTestStruct_i32_byte_map = Nothing,
- f_CompactProtoTestStruct_i64_byte_map = Nothing,
- f_CompactProtoTestStruct_double_byte_map = Nothing,
- f_CompactProtoTestStruct_string_byte_map = Nothing,
- f_CompactProtoTestStruct_binary_byte_map = Nothing,
- f_CompactProtoTestStruct_boolean_byte_map = Nothing,
-
- f_CompactProtoTestStruct_byte_i16_map = Nothing,
- f_CompactProtoTestStruct_byte_i32_map = Nothing,
- f_CompactProtoTestStruct_byte_i64_map = Nothing,
- f_CompactProtoTestStruct_byte_double_map = Nothing,
- f_CompactProtoTestStruct_byte_string_map = Nothing,
- f_CompactProtoTestStruct_byte_binary_map = Nothing,
- f_CompactProtoTestStruct_byte_boolean_map = Nothing,
-
- f_CompactProtoTestStruct_list_byte_map = Nothing,
- f_CompactProtoTestStruct_set_byte_map = Nothing,
- f_CompactProtoTestStruct_map_byte_map = Nothing,
-
- f_CompactProtoTestStruct_byte_map_map = Nothing,
- f_CompactProtoTestStruct_byte_set_map = Nothing,
- f_CompactProtoTestStruct_byte_list_map = Nothing }
-
- methodWithDefaultArgs _ arg = do
- print $ "Got methodWithDefaultArgs: " ++ show arg
- return ()
-
- onewayMethod _ = do
- print "Got onewayMethod"
-
-instance Inherited_Iface InheritedHandler where
- identity _ arg = do
- print $ "Got identity method: " ++ show arg
- return $ fromJust arg
-
-main :: IO ()
-main = do putStrLn "Server ready..."
- (runBasicServer InheritedHandler process 9090)
- `Control.Exception.catch`
- (\(TransportExn s _) -> print s)
diff --git a/test/hs/Makefile.am b/test/hs/Makefile.am
new file mode 100644
index 0000000..d6d8ff4
--- /dev/null
+++ b/test/hs/Makefile.am
@@ -0,0 +1,30 @@
+#
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements. See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership. The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied. See the License for the
+# specific language governing permissions and limitations
+# under the License.
+#
+
+THRIFT = $(top_srcdir)/compiler/cpp/thrift
+
+stubs: ../ConstantsDemo.thrift ../DebugProtoTest.thrift ../ThriftTest.thrift
+ $(THRIFT) --gen hs ../ConstantsDemo.thrift
+ $(THRIFT) --gen hs ../DebugProtoTest.thrift
+ $(THRIFT) --gen hs ../ThriftTest.thrift
+
+check: stubs
+ sh run-test.sh ConstantsDemo
+ sh run-test.sh DebugProtoTest
+ sh run-test.sh ThriftTest
diff --git a/test/hs/ThriftTestUtils.hs b/test/hs/ThriftTestUtils.hs
new file mode 100644
index 0000000..93fa122
--- /dev/null
+++ b/test/hs/ThriftTestUtils.hs
@@ -0,0 +1,65 @@
+--
+-- Licensed to the Apache Software Foundation (ASF) under one
+-- or more contributor license agreements. See the NOTICE file
+-- distributed with this work for additional information
+-- regarding copyright ownership. The ASF licenses this file
+-- to you under the Apache License, Version 2.0 (the
+-- "License"); you may not use this file except in compliance
+-- with the License. You may obtain a copy of the License at
+--
+-- http://www.apache.org/licenses/LICENSE-2.0
+--
+-- Unless required by applicable law or agreed to in writing,
+-- software distributed under the License is distributed on an
+-- "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+-- KIND, either express or implied. See the License for the
+-- specific language governing permissions and limitations
+-- under the License.
+--
+
+module ThriftTestUtils (ClientFunc, ServerFunc, clientLog, serverLog, testLog, runTest) where
+
+
+import qualified Control.Concurrent
+import qualified Network
+import qualified System.IO
+
+
+serverPort :: Network.PortNumber
+serverPort = 9090
+
+serverAddress :: (String, Network.PortID)
+serverAddress = ("localhost", Network.PortNumber serverPort)
+
+
+testLog :: String -> IO ()
+testLog str = do
+ System.IO.hPutStr System.IO.stdout $ str ++ "\n"
+ System.IO.hFlush System.IO.stdout
+
+
+clientLog :: String -> IO ()
+clientLog str = testLog $ "CLIENT: " ++ str
+
+serverLog :: String -> IO ()
+serverLog str = testLog $ "SERVER: " ++ str
+
+
+type ServerFunc = Network.PortNumber -> IO ()
+type ClientFunc = (String, Network.PortID) -> IO ()
+
+runTest :: ServerFunc -> ClientFunc -> IO ()
+runTest server client = do
+ _ <- Control.Concurrent.forkIO (server serverPort)
+
+ -- Fairly horrible; this does not 100% guarantees that the other thread
+ -- has actually opened the socket we need... but not much else we can do
+ -- without this, the client races the server to the socket, and wins every
+ -- time
+ Control.Concurrent.yield
+ Control.Concurrent.threadDelay $ 500 * 1000 -- unit is in _micro_seconds
+ Control.Concurrent.yield
+
+ _ <- client serverAddress
+
+ testLog "SUCCESS"
diff --git a/test/hs/ThriftTest_Main.hs b/test/hs/ThriftTest_Main.hs
new file mode 100644
index 0000000..4160c17
--- /dev/null
+++ b/test/hs/ThriftTest_Main.hs
@@ -0,0 +1,242 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+--
+-- Licensed to the Apache Software Foundation (ASF) under one
+-- or more contributor license agreements. See the NOTICE file
+-- distributed with this work for additional information
+-- regarding copyright ownership. The ASF licenses this file
+-- to you under the Apache License, Version 2.0 (the
+-- "License"); you may not use this file except in compliance
+-- with the License. You may obtain a copy of the License at
+--
+-- http://www.apache.org/licenses/LICENSE-2.0
+--
+-- Unless required by applicable law or agreed to in writing,
+-- software distributed under the License is distributed on an
+-- "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+-- KIND, either express or implied. See the License for the
+-- specific language governing permissions and limitations
+-- under the License.
+--
+
+module Main where
+
+
+import qualified Control.Exception
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+import qualified Network
+
+import Thrift
+import Thrift.Protocol.Binary
+import Thrift.Server
+import Thrift.Transport.Handle
+
+import qualified ThriftTestUtils
+
+import qualified ThriftTest
+import qualified ThriftTest_Client as Client
+import qualified ThriftTest_Iface as Iface
+import qualified ThriftTest_Types as Types
+
+
+data TestHandler = TestHandler
+instance Iface.ThriftTest_Iface TestHandler where
+ testVoid _ = return ()
+
+ testString _ (Just s) = do
+ ThriftTestUtils.serverLog s
+ return s
+
+ testString _ Nothing = do
+ error $ "Unsupported testString form"
+
+ testByte _ (Just x) = do
+ ThriftTestUtils.serverLog $ show x
+ return x
+
+ testByte _ Nothing = do
+ error $ "Unsupported testByte form"
+
+ testI32 _ (Just x) = do
+ ThriftTestUtils.serverLog $ show x
+ return x
+
+ testI32 _ Nothing = do
+ error $ "Unsupported testI32 form"
+
+ testI64 _ (Just x) = do
+ ThriftTestUtils.serverLog $ show x
+ return x
+
+ testI64 _ Nothing = do
+ error $ "Unsupported testI64 form"
+
+ testDouble _ (Just x) = do
+ ThriftTestUtils.serverLog $ show x
+ return x
+
+ testDouble _ Nothing = do
+ error $ "Unsupported testDouble form"
+
+ testStruct _ (Just x) = do
+ ThriftTestUtils.serverLog $ show x
+ return x
+
+ testStruct _ Nothing = do
+ error $ "Unsupported testStruct form"
+
+ testNest _ (Just x) = do
+ ThriftTestUtils.serverLog $ show x
+ return x
+
+ testNest _ Nothing = do
+ error $ "Unsupported testNest form"
+
+ testMap _ (Just x) = do
+ ThriftTestUtils.serverLog $ show x
+ return x
+
+ testMap _ Nothing = do
+ error $ "Unsupported testMap form"
+
+ testSet _ (Just x) = do
+ ThriftTestUtils.serverLog $ show x
+ return x
+
+ testSet _ Nothing = do
+ error $ "Unsupported testSet form"
+
+ testList _ (Just x) = do
+ ThriftTestUtils.serverLog $ show x
+ return x
+
+ testList _ Nothing = do
+ error $ "Unsupported testList form"
+
+ testEnum _ (Just x) = do
+ ThriftTestUtils.serverLog $ show x
+ return x
+
+ testEnum _ Nothing = do
+ error $ "Unsupported testEnum form"
+
+ testTypedef _ (Just x) = do
+ ThriftTestUtils.serverLog $ show x
+ return x
+
+ testTypedef _ Nothing = do
+ error $ "Unsupported testTypedef form"
+
+ testMapMap _ (Just _) = do
+ return (Map.fromList [(1, Map.fromList [(2, 2)])])
+
+ testMapMap _ Nothing = do
+ error $ "Unsupported testMapMap form"
+
+ testInsanity _ (Just x) = do
+ return (Map.fromList [(1, Map.fromList [(Types.ONE, x)])])
+
+ testInsanity _ Nothing = do
+ error $ "Unsupported testInsanity form"
+
+ testMulti _ _ _ _ _ _ _ = do
+ return (Types.Xtruct Nothing Nothing Nothing Nothing)
+
+ testException _ _ = do
+ Control.Exception.throw (Types.Xception (Just 1) (Just "bya"))
+
+ testMultiException _ _ _ = do
+ Control.Exception.throw (Types.Xception (Just 1) (Just "xyz"))
+
+ testOneway _ (Just i) = do
+ ThriftTestUtils.serverLog $ show i
+
+ testOneway _ Nothing = do
+ error $ "Unsupported testOneway form"
+
+
+client :: (String, Network.PortID) -> IO ()
+client addr = do
+ to <- hOpen addr
+ let ps = (BinaryProtocol to, BinaryProtocol to)
+
+ v1 <- Client.testString ps "bya"
+ ThriftTestUtils.clientLog v1
+
+ v2 <- Client.testByte ps 8
+ ThriftTestUtils.clientLog $ show v2
+
+ v3 <- Client.testByte ps (-8)
+ ThriftTestUtils.clientLog $ show v3
+
+ v4 <- Client.testI32 ps 32
+ ThriftTestUtils.clientLog $ show v4
+
+ v5 <- Client.testI32 ps (-32)
+ ThriftTestUtils.clientLog $ show v5
+
+ v6 <- Client.testI64 ps 64
+ ThriftTestUtils.clientLog $ show v6
+
+ v7 <- Client.testI64 ps (-64)
+ ThriftTestUtils.clientLog $ show v7
+
+ v8 <- Client.testDouble ps 3.14
+ ThriftTestUtils.clientLog $ show v8
+
+ v9 <- Client.testDouble ps (-3.14)
+ ThriftTestUtils.clientLog $ show v9
+
+ v10 <- Client.testMap ps (Map.fromList [(1,1),(2,2),(3,3)])
+ ThriftTestUtils.clientLog $ show v10
+
+ v11 <- Client.testList ps [1,2,3,4,5]
+ ThriftTestUtils.clientLog $ show v11
+
+ v12 <- Client.testSet ps (Set.fromList [1,2,3,4,5])
+ ThriftTestUtils.clientLog $ show v12
+
+ v13 <- Client.testStruct ps (Types.Xtruct (Just "hi") (Just 4) (Just 5) Nothing)
+ ThriftTestUtils.clientLog $ show v13
+
+ (testException ps "bad") `Control.Exception.catch` testExceptionHandler
+
+ (testMultiException ps "ok") `Control.Exception.catch` testMultiExceptionHandler1
+ (testMultiException ps "bad") `Control.Exception.catch` testMultiExceptionHandler2 `Control.Exception.catch` testMultiExceptionHandler3
+
+ -- ( (Client.testMultiException ps "e" "e2">> ThriftTestUtils.clientLog "bad") `Control.Exception.catch`
+
+ tClose to
+ where testException ps msg = do
+ Client.testException ps "e"
+ ThriftTestUtils.clientLog msg
+ return ()
+
+ testExceptionHandler (e :: Types.Xception) = do
+ ThriftTestUtils.clientLog $ show e
+
+ testMultiException ps msg = do
+ _ <- Client.testMultiException ps "e" "e2"
+ ThriftTestUtils.clientLog msg
+ return ()
+
+ testMultiExceptionHandler1 (e :: Types.Xception) = do
+ ThriftTestUtils.clientLog $ show e
+
+ testMultiExceptionHandler2 (e :: Types.Xception2) = do
+ ThriftTestUtils.clientLog $ show e
+
+ testMultiExceptionHandler3 (_ :: Control.Exception.SomeException) = do
+ ThriftTestUtils.clientLog "ok"
+
+
+server :: Network.PortNumber -> IO ()
+server port = do
+ ThriftTestUtils.serverLog "Ready..."
+ (runBasicServer TestHandler ThriftTest.process port)
+ `Control.Exception.catch`
+ (\(TransportExn s _) -> error $ "FAILURE: " ++ s)
+
+
+main :: IO ()
+main = ThriftTestUtils.runTest server client
diff --git a/test/hs/ThriftTest_TestClient.hs b/test/hs/ThriftTest_TestClient.hs
deleted file mode 100644
index 4aca275..0000000
--- a/test/hs/ThriftTest_TestClient.hs
+++ /dev/null
@@ -1,61 +0,0 @@
-{-# LANGUAGE ScopedTypeVariables #-}
---
--- Licensed to the Apache Software Foundation (ASF) under one
--- or more contributor license agreements. See the NOTICE file
--- distributed with this work for additional information
--- regarding copyright ownership. The ASF licenses this file
--- to you under the Apache License, Version 2.0 (the
--- "License"); you may not use this file except in compliance
--- with the License. You may obtain a copy of the License at
---
--- http://www.apache.org/licenses/LICENSE-2.0
---
--- Unless required by applicable law or agreed to in writing,
--- software distributed under the License is distributed on an
--- "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
--- KIND, either express or implied. See the License for the
--- specific language governing permissions and limitations
--- under the License.
---
-
-module ThriftTest_TestClient where
-
-
-import Control.Exception as CE
-import qualified Data.Map as Map
-import qualified Data.Set as Set
-import Network
-
-import Thrift
-import Thrift.Transport.Handle
-import Thrift.Protocol.Binary
-
-import ThriftTest_Client
-import ThriftTest_Types
-
-
-serverAddress :: (String, PortID)
-serverAddress = ("127.0.0.1", PortNumber 9090)
-
-main :: IO ()
-main = do to <- hOpen serverAddress
- let p = BinaryProtocol to
- let ps = (p,p)
- print =<< testString ps "bya"
- print =<< testByte ps 8
- print =<< testByte ps (-8)
- print =<< testI32 ps 32
- print =<< testI32 ps (-32)
- print =<< testI64 ps 64
- print =<< testI64 ps (-64)
- print =<< testDouble ps 3.14
- print =<< testDouble ps (-3.14)
- print =<< testMap ps (Map.fromList [(1,1),(2,2),(3,3)])
- print =<< testList ps [1,2,3,4,5]
- print =<< testSet ps (Set.fromList [1,2,3,4,5])
- print =<< testStruct ps (Xtruct (Just "hi") (Just 4) (Just 5) Nothing)
- CE.catch (testException ps "e" >> print "bad") (\e -> print (e :: Xception))
- CE.catch (testMultiException ps "e" "e2" >> print "ok") (\e -> print (e :: Xception))
- CE.catch (CE.catch (testMultiException ps "e" "e2">> print "bad") (\e -> print (e :: Xception2))) (\(_ :: SomeException) -> print "ok")
- tClose to
-
diff --git a/test/hs/ThriftTest_TestServer.hs b/test/hs/ThriftTest_TestServer.hs
deleted file mode 100644
index fbfcd53..0000000
--- a/test/hs/ThriftTest_TestServer.hs
+++ /dev/null
@@ -1,152 +0,0 @@
---
--- Licensed to the Apache Software Foundation (ASF) under one
--- or more contributor license agreements. See the NOTICE file
--- distributed with this work for additional information
--- regarding copyright ownership. The ASF licenses this file
--- to you under the Apache License, Version 2.0 (the
--- "License"); you may not use this file except in compliance
--- with the License. You may obtain _ copy of the License at
---
--- http://www.apache.org/licenses/LICENSE-2.0
---
--- Unless required by applicable law or agreed to in writing,
--- software distributed under the License is distributed on an
--- "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
--- KIND, either express or implied. See the License for the
--- specific language governing permissions and limitations
--- under the License.
---
-
-module ThriftTest_TestServer where
-
-import ThriftTest
-import ThriftTest_Iface
-import Data.Map as Map
-import Control.Exception
-import ThriftTest_Types
-
-import Thrift
-import Thrift.Server
-
-
-data TestHandler = TestHandler
-instance ThriftTest_Iface TestHandler where
- testVoid _ = return ()
-
- testString _ (Just s) = do
- print s
- return s
-
- testString _ Nothing = do
- error $ "Unsupported testString form"
-
- testByte _ (Just x) = do
- print x
- return x
-
- testByte _ Nothing = do
- error $ "Unsupported testByte form"
-
- testI32 _ (Just x) = do
- print x
- return x
-
- testI32 _ Nothing = do
- error $ "Unsupported testI32 form"
-
- testI64 _ (Just x) = do
- print x
- return x
-
- testI64 _ Nothing = do
- error $ "Unsupported testI64 form"
-
- testDouble _ (Just x) = do
- print x
- return x
-
- testDouble _ Nothing = do
- error $ "Unsupported testDouble form"
-
- testStruct _ (Just x) = do
- print x
- return x
-
- testStruct _ Nothing = do
- error $ "Unsupported testStruct form"
-
- testNest _ (Just x) = do
- print x
- return x
-
- testNest _ Nothing = do
- error $ "Unsupported testNest form"
-
- testMap _ (Just x) = do
- print x
- return x
-
- testMap _ Nothing = do
- error $ "Unsupported testMap form"
-
- testSet _ (Just x) = do
- print x
- return x
-
- testSet _ Nothing = do
- error $ "Unsupported testSet form"
-
- testList _ (Just x) = do
- print x
- return x
-
- testList _ Nothing = do
- error $ "Unsupported testList form"
-
- testEnum _ (Just x) = do
- print x
- return x
-
- testEnum _ Nothing = do
- error $ "Unsupported testEnum form"
-
- testTypedef _ (Just x) = do
- print x
- return x
-
- testTypedef _ Nothing = do
- error $ "Unsupported testTypedef form"
-
- testMapMap _ (Just _) = do
- return (Map.fromList [(1, Map.fromList [(2, 2)])])
-
- testMapMap _ Nothing = do
- error $ "Unsupported testMapMap form"
-
- testInsanity _ (Just x) = do
- return (Map.fromList [(1, Map.fromList [(ONE, x)])])
-
- testInsanity _ Nothing = do
- error $ "Unsupported testInsanity form"
-
- testMulti _ _ _ _ _ _ _ = do
- return (Xtruct Nothing Nothing Nothing Nothing)
-
- testException _ _ = do
- throw (Xception (Just 1) (Just "bya"))
-
- testMultiException _ _ _ = do
- throw (Xception (Just 1) (Just "xyz"))
-
- testOneway _ (Just i) = do
- print i
-
- testOneway _ Nothing = do
- error $ "Unsupported testOneway form"
-
-
-main :: IO ()
-main = do putStrLn "Server ready..."
- (runBasicServer TestHandler process 9090)
- `Control.Exception.catch`
- (\(TransportExn s _) -> print s)
diff --git a/test/hs/runserver.sh b/test/hs/run-test.sh
similarity index 67%
rename from test/hs/runserver.sh
rename to test/hs/run-test.sh
index 9189d30..78df0a8 100644
--- a/test/hs/runserver.sh
+++ b/test/hs/run-test.sh
@@ -19,17 +19,18 @@
# under the License.
#
-# Check some basic
+if [ "x" == "x$1" ]; then
+ printf "run-test.sh needs an argument, the name of the test to run. Try 'ThriftTest' or 'ProtoDebugTest'\n"
+ exit 2
+fi
+
+# Check some basics
if [ -z $BASE ]; then
BASE=../..
fi
-if [ -z $OUTDIR ]; then
- OUTDIR=server-bindings
-fi
-
if [ -z $THRIFT_BIN ]; then
- THRIFT_BIN=$(which thrift)
+ THRIFT_BIN=$BASE/compiler/cpp/thrift
fi
if [ ! -x "$THRIFT_BIN" ]; then
@@ -47,22 +48,24 @@
exit 2
fi
-# Figure out what file to run has a server
-if [ -z $SERVER_FILE ]; then
- SERVER_FILE=$BASE/test/hs/$1_TestServer.hs
+if [ ! -e "$THRIFT_FILE" ]; then
+ printf "Could not find thrift file to run; pass it as environment variable THRIFT_FILE\n"
+ exit 1
fi
-if [ ! -e $SERVER_FILE ]; then
- printf "Missing server code file $SERVER_FILE \n"
+# Figure out what file to run has a server
+if [ -z $TEST_SOURCE_FILE ]; then
+ TEST_SOURCE_FILE=$BASE/test/hs/$1_Main.hs
+fi
+
+if [ ! -e $TEST_SOURCE_FILE ]; then
+ printf "Missing server code file $TEST_SOURCE_FILE \n"
exit 3
fi
# Actually run the server bits
-printf "Creating directory $OUTDIR to hold generated bindings... \n"
-[ -d $OUTDIR ] || mkdir $OUTDIR
-
printf "Generating bindings... \n"
-$THRIFT_BIN -o $OUTDIR --gen hs $THRIFT_FILE
+$THRIFT_BIN --gen hs $THRIFT_FILE
-printf "Starting server... \n"
-runhaskell -Wall -Werror -i$BASE/lib/hs/src -i$OUTDIR/gen-hs $SERVER_FILE
+printf "Running test... \n"
+runhaskell -Wall -Werror -i$BASE/lib/hs/src -igen-hs $TEST_SOURCE_FILE
diff --git a/test/hs/runclient.sh b/test/hs/runclient.sh
deleted file mode 100644
index aab9f17..0000000
--- a/test/hs/runclient.sh
+++ /dev/null
@@ -1,68 +0,0 @@
-#!/bin/sh
-
-#
-# Licensed to the Apache Software Foundation (ASF) under one
-# or more contributor license agreements. See the NOTICE file
-# distributed with this work for additional information
-# regarding copyright ownership. The ASF licenses this file
-# to you under the Apache License, Version 2.0 (the
-# "License"); you may not use this file except in compliance
-# with the License. You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing,
-# software distributed under the License is distributed on an
-# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
-# KIND, either express or implied. See the License for the
-# specific language governing permissions and limitations
-# under the License.
-#
-
-# Check some basic
-if [ -z $BASE ]; then
- BASE=../..
-fi
-
-if [ -z $OUTDIR ]; then
- OUTDIR=client-bindings
-fi
-
-if [ -z $THRIFT_BIN ]; then
- THRIFT_BIN=$(which thrift)
-fi
-
-if [ ! -x "$THRIFT_BIN" ]; then
- printf "Could not find thrift binary; pass it as environment variable THRIFT_BIN\n"
- exit 1
-fi
-
-# Figure out what file to generate bindings from
-if [ -z $THRIFT_FILE ]; then
- THRIFT_FILE=$BASE/test/$1.thrift
-fi
-
-if [ ! -e $THRIFT_FILE ]; then
- printf "Missing thrift file $THRIFT_FILE \n"
- exit 2
-fi
-
-# Figure out what file to run has a client
-if [ -z $CLIENT_FILE ]; then
- CLIENT_FILE=$BASE/test/hs/$1_TestClient.hs
-fi
-
-if [ ! -e $CLIENT_FILE ]; then
- printf "Missing client code file $CLIENT_FILE \n"
- exit 3
-fi
-
-# Actually run the client bits
-printf "Creating directory $OUTDIR to hold generated bindings... \n"
-[ -d $OUTDIR ] || mkdir $OUTDIR
-
-printf "Generating bindings... \n"
-$THRIFT_BIN -o $OUTDIR --gen hs $THRIFT_FILE
-
-printf "Starting client... \n"
-runhaskell -Wall -Werror -i$BASE/lib/hs/src -i$OUTDIR/gen-hs $CLIENT_FILE