summaryrefslogtreecommitdiff
path: root/testsuite/tests/ghci/linking/dyn
diff options
context:
space:
mode:
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']),
View Lorry Controller Status