From c657447e0edd882ffc6144ca81c1f1d3cccae048 Mon Sep 17 00:00:00 2001 From: Bryan Duxbury Date: Wed, 6 Oct 2010 00:12:33 +0000 Subject: [PATCH] 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 --- configure.ac | 10 +- lib/hs/Makefile.am | 3 + test/Makefile.am | 3 + test/hs/ConstantsDemo_Main.hs | 68 ++++++++ test/hs/ConstantsDemo_TestClient.hs | 44 ----- test/hs/ConstantsDemo_TestServer.hs | 47 ----- test/hs/DebugProtoTest_Main.hs | 164 +++++++++++++++++ test/hs/DebugProtoTest_TestClient.hs | 49 ------ test/hs/DebugProtoTest_TestServer.hs | 125 ------------- test/hs/Makefile.am | 30 ++++ test/hs/ThriftTestUtils.hs | 65 +++++++ test/hs/ThriftTest_Main.hs | 242 ++++++++++++++++++++++++++ test/hs/ThriftTest_TestClient.hs | 61 ------- test/hs/ThriftTest_TestServer.hs | 152 ---------------- test/hs/{runserver.sh => run-test.sh} | 37 ++-- test/hs/runclient.sh | 68 -------- 16 files changed, 603 insertions(+), 565 deletions(-) create mode 100644 test/hs/ConstantsDemo_Main.hs delete mode 100644 test/hs/ConstantsDemo_TestClient.hs delete mode 100644 test/hs/ConstantsDemo_TestServer.hs create mode 100644 test/hs/DebugProtoTest_Main.hs delete mode 100644 test/hs/DebugProtoTest_TestClient.hs delete mode 100644 test/hs/DebugProtoTest_TestServer.hs create mode 100644 test/hs/Makefile.am create mode 100644 test/hs/ThriftTestUtils.hs create mode 100644 test/hs/ThriftTest_Main.hs delete mode 100644 test/hs/ThriftTest_TestClient.hs delete mode 100644 test/hs/ThriftTest_TestServer.hs rename test/hs/{runserver.sh => run-test.sh} (67%) delete mode 100644 test/hs/runclient.sh diff --git a/configure.ac b/configure.ac index dc0834463..bf8ef6d7e 100644 --- a/configure.ac +++ b/configure.ac @@ -203,14 +203,18 @@ AM_CONDITIONAL(HAVE_RSPEC, [test "x$RSPEC" != "x"]) 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 @@ AC_CONFIG_FILES([ 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 @@ AC_CONFIG_FILES([ lib/py/Makefile lib/rb/Makefile test/Makefile + test/hs/Makefile test/py/Makefile test/rb/Makefile ]) @@ -417,6 +422,7 @@ fi 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 4c4208d18..95734f06e 100644 --- a/lib/hs/Makefile.am +++ b/lib/hs/Makefile.am @@ -37,3 +37,6 @@ clean-local: maintainer-clean-local: $(RUNHASKELL) Setup.lhs clean + +check-local: + $(CABAL) check diff --git a/test/Makefile.am b/test/Makefile.am index 7256f21a6..86b006794 100644 --- a/test/Makefile.am +++ b/test/Makefile.am @@ -27,6 +27,9 @@ if WITH_RUBY 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 000000000..28de4f7ea --- /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 1cc350dee..000000000 --- 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 10b2177e9..000000000 --- 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 000000000..816eee3d9 --- /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 fc1582b7a..000000000 --- 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 af3e5a9b0..000000000 --- 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 000000000..d6d8ff46b --- /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 000000000..93fa1229f --- /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 000000000..4160c1793 --- /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 4aca27561..000000000 --- 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 fbfcd5349..000000000 --- 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 9189d3004..78df0a843 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 @@ if [ ! -e $THRIFT_FILE ]; then 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 aab9f174c..000000000 --- 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