You are viewing a plain text version of this content. The canonical link for it is here.
Posted to commits@thrift.apache.org by br...@apache.org on 2010/10/06 02:12:33 UTC
svn commit: r1004861 - in /incubator/thrift/trunk: ./ lib/hs/ test/ test/hs/
Author: bryanduxbury
Date: Wed Oct 6 00:12:33 2010
New Revision: 1004861
URL: http://svn.apache.org/viewvc?rev=1004861&view=rev
Log:
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
Added:
incubator/thrift/trunk/test/hs/ConstantsDemo_Main.hs
incubator/thrift/trunk/test/hs/DebugProtoTest_Main.hs
incubator/thrift/trunk/test/hs/Makefile.am
incubator/thrift/trunk/test/hs/ThriftTestUtils.hs
incubator/thrift/trunk/test/hs/ThriftTest_Main.hs
incubator/thrift/trunk/test/hs/run-test.sh
Removed:
incubator/thrift/trunk/test/hs/ConstantsDemo_TestClient.hs
incubator/thrift/trunk/test/hs/ConstantsDemo_TestServer.hs
incubator/thrift/trunk/test/hs/DebugProtoTest_TestClient.hs
incubator/thrift/trunk/test/hs/DebugProtoTest_TestServer.hs
incubator/thrift/trunk/test/hs/ThriftTest_TestClient.hs
incubator/thrift/trunk/test/hs/ThriftTest_TestServer.hs
incubator/thrift/trunk/test/hs/runclient.sh
incubator/thrift/trunk/test/hs/runserver.sh
Modified:
incubator/thrift/trunk/configure.ac
incubator/thrift/trunk/lib/hs/Makefile.am
incubator/thrift/trunk/test/Makefile.am
incubator/thrift/trunk/test/hs/ (props changed)
Modified: incubator/thrift/trunk/configure.ac
URL: http://svn.apache.org/viewvc/incubator/thrift/trunk/configure.ac?rev=1004861&r1=1004860&r2=1004861&view=diff
==============================================================================
--- incubator/thrift/trunk/configure.ac (original)
+++ incubator/thrift/trunk/configure.ac Wed Oct 6 00:12:33 2010
@@ -203,14 +203,18 @@ AM_CONDITIONAL(HAVE_RSPEC, [test "x$RSPE
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
Modified: incubator/thrift/trunk/lib/hs/Makefile.am
URL: http://svn.apache.org/viewvc/incubator/thrift/trunk/lib/hs/Makefile.am?rev=1004861&r1=1004860&r2=1004861&view=diff
==============================================================================
--- incubator/thrift/trunk/lib/hs/Makefile.am (original)
+++ incubator/thrift/trunk/lib/hs/Makefile.am Wed Oct 6 00:12:33 2010
@@ -37,3 +37,6 @@ clean-local:
maintainer-clean-local:
$(RUNHASKELL) Setup.lhs clean
+
+check-local:
+ $(CABAL) check
Modified: incubator/thrift/trunk/test/Makefile.am
URL: http://svn.apache.org/viewvc/incubator/thrift/trunk/test/Makefile.am?rev=1004861&r1=1004860&r2=1004861&view=diff
==============================================================================
--- incubator/thrift/trunk/test/Makefile.am (original)
+++ incubator/thrift/trunk/test/Makefile.am Wed Oct 6 00:12:33 2010
@@ -27,6 +27,9 @@ if WITH_RUBY
SUBDIRS += rb
endif
+if WITH_HASKELL
+SUBDIRS += hs
+endif
EXTRA_DIST = \
cpp \
Propchange: incubator/thrift/trunk/test/hs/
------------------------------------------------------------------------------
--- svn:ignore (added)
+++ svn:ignore Wed Oct 6 00:12:33 2010
@@ -0,0 +1,2 @@
+Makefile
+Makefile.in
Added: incubator/thrift/trunk/test/hs/ConstantsDemo_Main.hs
URL: http://svn.apache.org/viewvc/incubator/thrift/trunk/test/hs/ConstantsDemo_Main.hs?rev=1004861&view=auto
==============================================================================
--- incubator/thrift/trunk/test/hs/ConstantsDemo_Main.hs (added)
+++ incubator/thrift/trunk/test/hs/ConstantsDemo_Main.hs Wed Oct 6 00:12:33 2010
@@ -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
Added: incubator/thrift/trunk/test/hs/DebugProtoTest_Main.hs
URL: http://svn.apache.org/viewvc/incubator/thrift/trunk/test/hs/DebugProtoTest_Main.hs?rev=1004861&view=auto
==============================================================================
--- incubator/thrift/trunk/test/hs/DebugProtoTest_Main.hs (added)
+++ incubator/thrift/trunk/test/hs/DebugProtoTest_Main.hs Wed Oct 6 00:12:33 2010
@@ -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
Added: incubator/thrift/trunk/test/hs/Makefile.am
URL: http://svn.apache.org/viewvc/incubator/thrift/trunk/test/hs/Makefile.am?rev=1004861&view=auto
==============================================================================
--- incubator/thrift/trunk/test/hs/Makefile.am (added)
+++ incubator/thrift/trunk/test/hs/Makefile.am Wed Oct 6 00:12:33 2010
@@ -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
Added: incubator/thrift/trunk/test/hs/ThriftTestUtils.hs
URL: http://svn.apache.org/viewvc/incubator/thrift/trunk/test/hs/ThriftTestUtils.hs?rev=1004861&view=auto
==============================================================================
--- incubator/thrift/trunk/test/hs/ThriftTestUtils.hs (added)
+++ incubator/thrift/trunk/test/hs/ThriftTestUtils.hs Wed Oct 6 00:12:33 2010
@@ -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"
Added: incubator/thrift/trunk/test/hs/ThriftTest_Main.hs
URL: http://svn.apache.org/viewvc/incubator/thrift/trunk/test/hs/ThriftTest_Main.hs?rev=1004861&view=auto
==============================================================================
--- incubator/thrift/trunk/test/hs/ThriftTest_Main.hs (added)
+++ incubator/thrift/trunk/test/hs/ThriftTest_Main.hs Wed Oct 6 00:12:33 2010
@@ -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
Added: incubator/thrift/trunk/test/hs/run-test.sh
URL: http://svn.apache.org/viewvc/incubator/thrift/trunk/test/hs/run-test.sh?rev=1004861&view=auto
==============================================================================
--- incubator/thrift/trunk/test/hs/run-test.sh (added)
+++ incubator/thrift/trunk/test/hs/run-test.sh Wed Oct 6 00:12:33 2010
@@ -0,0 +1,71 @@
+#!/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.
+#
+
+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 $THRIFT_BIN ]; then
+ THRIFT_BIN=$BASE/compiler/cpp/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
+
+if [ ! -e "$THRIFT_FILE" ]; then
+ printf "Could not find thrift file to run; pass it as environment variable THRIFT_FILE\n"
+ exit 1
+fi
+
+# 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 "Generating bindings... \n"
+$THRIFT_BIN --gen hs $THRIFT_FILE
+
+printf "Running test... \n"
+runhaskell -Wall -Werror -i$BASE/lib/hs/src -igen-hs $TEST_SOURCE_FILE