summaryrefslogtreecommitdiff
path: root/testsuite/tests/ghci/linking/dyn
diff options
context:
space:
mode:
authorTamar Christina <tamar@zhox.com>2018-01-02 16:00:57 -0500
committerBen Gamari <ben@smart-cactus.org>2018-01-02 17:33:04 -0500
commit27b7b4db9af99aeb88dce7ef0e85131199bbf2ff (patch)
treedb4d5bbc750857ce55d7bcc09962002e4ba176d3 /testsuite/tests/ghci/linking/dyn
parent4887c3086149a15a1e16c765682debcfbb9de145 (diff)
downloadhaskell-27b7b4db9af99aeb88dce7ef0e85131199bbf2ff.tar.gz
Windows: fix all failing tests.
This makes the testsuite pass clean on Windows again. It also fixes the `libstdc++-6.dll` error harbormaster was showing. I'm marking some tests as isolated tests to reduce their flakiness (mostly concurrency tests) when the test system is under heavy load. Updates process submodule. Test Plan: ./validate Reviewers: hvr, bgamari, erikd, simonmar Reviewed By: bgamari Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4277
Diffstat (limited to 'testsuite/tests/ghci/linking/dyn')
-rw-r--r--testsuite/tests/ghci/linking/dyn/Makefile2
-rw-r--r--testsuite/tests/ghci/linking/dyn/T13606.hs128
-rw-r--r--testsuite/tests/ghci/linking/dyn/T13606.stdout2
-rw-r--r--testsuite/tests/ghci/linking/dyn/Triangle.fx10
-rw-r--r--testsuite/tests/ghci/linking/dyn/all.T4
5 files changed, 3 insertions, 143 deletions
diff --git a/testsuite/tests/ghci/linking/dyn/Makefile b/testsuite/tests/ghci/linking/dyn/Makefile
index 8a627919eb..d4a65a6603 100644
--- a/testsuite/tests/ghci/linking/dyn/Makefile
+++ b/testsuite/tests/ghci/linking/dyn/Makefile
@@ -101,7 +101,7 @@ T1407:
.PHONY: T13606
T13606:
- echo "main" | '$(TEST_HC)' $(TEST_HC_OPTS_INTERACTIVE) -lD3DCompiler T13606.hs
+ echo ":q" | '$(TEST_HC)' $(TEST_HC_OPTS_INTERACTIVE) -lgcc_s
.PHONY: big-obj
big-obj:
diff --git a/testsuite/tests/ghci/linking/dyn/T13606.hs b/testsuite/tests/ghci/linking/dyn/T13606.hs
deleted file mode 100644
index 3bce51a761..0000000000
--- a/testsuite/tests/ghci/linking/dyn/T13606.hs
+++ /dev/null
@@ -1,128 +0,0 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-module Main (main) where
-
-import Data.Bits (Bits(..))
-import Data.Int (Int32)
-import Data.Word (Word32)
-import Foreign.C.String (CString, peekCString, withCString, withCStringLen)
-import Foreign.Marshal.Alloc (alloca)
-import Foreign.Ptr (Ptr, castPtr, nullPtr)
-import Foreign.Storable (Storable(..))
-import System.IO (IOMode(..), hGetContents, withFile)
-
-#if defined(i386_HOST_ARCH)
-# define WINDOWS_CCONV stdcall
-#elif defined(x86_64_HOST_ARCH)
-# define WINDOWS_CCONV ccall
-#else
-# error Unknown mingw32 arch
-#endif
-
-foreign import WINDOWS_CCONV "D3DCompile" c_d3dCompile
- :: Ptr () -> Word32 -> CString ->
- Ptr D3DShaderMacro -> Ptr ID3DInclude ->
- CString -> CString -> D3DCompileFlag -> D3DCompileEffectFlag ->
- Ptr (Ptr ID3DBlob) -> Ptr (Ptr ID3DBlob) -> IO HRESULT
-
-maybePoke :: (Storable a) => Maybe a -> (Ptr a -> IO b) -> IO b
-maybePoke Nothing proc = proc nullPtr
-maybePoke (Just m) proc = alloca $ \ptr -> do
- poke ptr m
- proc ptr
-
-maybeWithCString :: Maybe String -> (CString -> IO a) -> IO a
-maybeWithCString Nothing proc = proc nullPtr
-maybeWithCString (Just m) proc = withCString m proc
-
-type HRESULT = LONG
-data ID3DBlob = ID3DBlob
-data ID3DInclude = ID3DInclue
-type LONG = Int32
-
-data D3DShaderMacro = D3DShaderMacro
- { _name :: String
- , _definition :: String }
-
-instance Storable D3DShaderMacro where
- sizeOf _ = 8
- alignment _ = 8
- peek ptr = do
- n <- peekByteOff ptr 0
- d <- peekByteOff ptr 4
- n' <- peekCString n
- d' <- peekCString d
- return $ D3DShaderMacro n' d'
- poke ptr (D3DShaderMacro n d) = do
- withCString n $ \n' -> withCString d $ \d' -> do
- pokeByteOff ptr 0 n'
- pokeByteOff ptr 4 d'
-
-type D3DCompileFlag = Word32
-type D3DCompileEffectFlag = Word32
-
-d3dCompileEnableStrictness :: D3DCompileFlag
-d3dCompileEnableStrictness = shift 1 11
-
-d3dCompile
- :: String -> Maybe String ->
- Maybe D3DShaderMacro -> Ptr ID3DInclude ->
- Maybe String -> String ->
- [D3DCompileFlag] -> [D3DCompileEffectFlag] ->
- IO (Either (HRESULT, Ptr ID3DBlob) (Ptr ID3DBlob))
-d3dCompile source sourceName defines pInclude entryPoint target compileFlags effectFlags = do
- withCStringLen source $ \(csource, len) -> withCString target $ \pTarget ->
- maybeWithCString sourceName $ \pSourceName -> maybePoke defines $ \pDefines ->
- maybeWithCString entryPoint $ \pEntryPoint -> alloca $ \ppCode -> alloca $ \ppErrorMsgs -> do
- let sFlag = foldl (.|.) 0 compileFlags
- let eFlag = foldl (.|.) 0 effectFlags
- putStrLn "Before d3dCompile"
- hr <- c_d3dCompile
- (castPtr csource)
- (fromIntegral len)
- pSourceName
- pDefines
- pInclude
- pEntryPoint
- pTarget
- sFlag
- eFlag
- ppCode
- ppErrorMsgs
- putStrLn "After d3dCompile"
- if hr < 0
- then do
- pErrorMsgs <- peek ppErrorMsgs
- return $ Left (hr, pErrorMsgs)
- else do
- pCode <- peek ppCode
- return $ Right pCode
-
-d3dCompileFromFile
- :: String -> Maybe String ->
- Maybe D3DShaderMacro -> Ptr ID3DInclude ->
- Maybe String -> String ->
- [D3DCompileFlag] -> [D3DCompileEffectFlag] ->
- IO (Either (HRESULT, Ptr ID3DBlob) (Ptr ID3DBlob))
-d3dCompileFromFile fileName sourceName defines pInclude entryPoint target compileFlags effectFlags =
- withFile fileName ReadMode $ \handle -> do
- contents <- hGetContents handle
- d3dCompile contents sourceName defines pInclude entryPoint target compileFlags effectFlags
-
-main :: IO ()
-main = do
- _vb <- compileShaderFromFile "Triangle.fx" "VS" "vs_4_0"
- return ()
-
-compileShaderFromFile :: String -> String -> String -> IO (Ptr ID3DBlob)
-compileShaderFromFile fileName entryPoint shaderModel = do
- Right res <- d3dCompileFromFile
- fileName
- Nothing
- Nothing
- nullPtr
- (Just entryPoint)
- shaderModel
- [d3dCompileEnableStrictness]
- []
- return res
diff --git a/testsuite/tests/ghci/linking/dyn/T13606.stdout b/testsuite/tests/ghci/linking/dyn/T13606.stdout
deleted file mode 100644
index baf6b87f26..0000000000
--- a/testsuite/tests/ghci/linking/dyn/T13606.stdout
+++ /dev/null
@@ -1,2 +0,0 @@
-Before d3dCompile
-After d3dCompile
diff --git a/testsuite/tests/ghci/linking/dyn/Triangle.fx b/testsuite/tests/ghci/linking/dyn/Triangle.fx
deleted file mode 100644
index 0cef7a1e0f..0000000000
--- a/testsuite/tests/ghci/linking/dyn/Triangle.fx
+++ /dev/null
@@ -1,10 +0,0 @@
-float4 VS( float4 Pos : POSITION ) : SV_POSITION
-{
- return Pos;
-}
-
-float4 PS( float4 Pos : SV_POSITION ) : SV_Target
-{
- return float4( 1.0f, 1.0f, 0.0f, 1.0f ); // Yellow, with Alpha = 1
-}
-
diff --git a/testsuite/tests/ghci/linking/dyn/all.T b/testsuite/tests/ghci/linking/dyn/all.T
index 752dc78392..f8679bcbfe 100644
--- a/testsuite/tests/ghci/linking/dyn/all.T
+++ b/testsuite/tests/ghci/linking/dyn/all.T
@@ -39,8 +39,8 @@ test('T11072msvc', [extra_files(['A.c', 'T11072.hs', 'libAS.def', 'i686/', 'x86_
unless(doing_ghci, skip), unless(opsys('mingw32'), skip)],
run_command, ['$MAKE -s --no-print-directory compile_libAS_impl_msvc'])
-test('T13606', [extra_files(['Triangle.fx']),
- unless(doing_ghci, skip), unless(opsys('mingw32'), skip)],
+test('T13606', [unless(doing_ghci, skip), unless(opsys('mingw32'), skip),
+ exit_code(0)],
run_command, ['$MAKE -s --no-print-directory T13606'])
test('big-obj', [extra_files(['big-obj-c.c', 'big-obj.hs']),