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
This commit is contained in:
Bryan Duxbury 2010-10-06 00:12:33 +00:00
parent ffca7e1720
commit c657447e0e
16 changed files with 603 additions and 565 deletions

View File

@ -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

View File

@ -37,3 +37,6 @@ clean-local:
maintainer-clean-local:
$(RUNHASKELL) Setup.lhs clean
check-local:
$(CABAL) check

View File

@ -27,6 +27,9 @@ if WITH_RUBY
SUBDIRS += rb
endif
if WITH_HASKELL
SUBDIRS += hs
endif
EXTRA_DIST = \
cpp \

View File

@ -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

View File

@ -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

View File

@ -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)

View File

@ -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

View File

@ -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 ()

View File

@ -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)

30
test/hs/Makefile.am Normal file
View File

@ -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

View File

@ -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"

242
test/hs/ThriftTest_Main.hs Normal file
View File

@ -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

View File

@ -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

View File

@ -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)

View File

@ -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

View File

@ -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