diff options
author | Tamar Christina <tamar@zhox.com> | 2018-01-02 16:00:57 -0500 |
---|---|---|
committer | Ben Gamari <ben@smart-cactus.org> | 2018-01-02 17:33:04 -0500 |
commit | 27b7b4db9af99aeb88dce7ef0e85131199bbf2ff (patch) | |
tree | db4d5bbc750857ce55d7bcc09962002e4ba176d3 /testsuite/tests/ghci/linking | |
parent | 4887c3086149a15a1e16c765682debcfbb9de145 (diff) | |
download | haskell-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')
-rw-r--r-- | testsuite/tests/ghci/linking/dyn/Makefile | 2 | ||||
-rw-r--r-- | testsuite/tests/ghci/linking/dyn/T13606.hs | 128 | ||||
-rw-r--r-- | testsuite/tests/ghci/linking/dyn/T13606.stdout | 2 | ||||
-rw-r--r-- | testsuite/tests/ghci/linking/dyn/Triangle.fx | 10 | ||||
-rw-r--r-- | testsuite/tests/ghci/linking/dyn/all.T | 4 |
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']), |