[Git][ghc/ghc][wip/test-mingwex-regression] Test that functions from `mingwex` are available

[John Ericson (@Ericson2314)]

John Ericson pushed to branch wip/test-mingwex-regression at Glasgow Haskell Compiler / GHC


Commits:
90d505e2 by John Ericson at 2023-09-20T09:19:43-04:00
Test that functions from `mingwex` are available

Ryan wrote these two minimizations, but they never got added to the test
suite.

See #23309, #23378

Co-Authored-By: Ryan Scott <ryan.gl.scott at gmail.com>

- - - - -


8 changed files:

- + testsuite/tests/th/T23309.c
- + testsuite/tests/th/T23309.hs
- + testsuite/tests/th/T23309.stderr
- + testsuite/tests/th/T23309A.hs
- + testsuite/tests/th/T23378.hs
- + testsuite/tests/th/T23378.stderr
- + testsuite/tests/th/T23378A.hs
- testsuite/tests/th/all.T


Changes:

=====================================
testsuite/tests/th/T23309.c
=====================================
@@ -0,0 +1,8 @@
+#define _GNU_SOURCE 1
+#include <stdio.h>
+
+const char* foo(int e) {
+    static char s[256];
+    sprintf(s, "The value of e is: %u", e);
+    return s;
+}


=====================================
testsuite/tests/th/T23309.hs
=====================================
@@ -0,0 +1,15 @@
+{-# LANGUAGE TemplateHaskell #-}
+module T23309 where
+
+import Foreign.C.String
+import Language.Haskell.TH
+import System.IO
+
+import T23309A
+
+$(do runIO $ do
+       cstr <- c_foo 42
+       str <- peekCString cstr
+       hPutStrLn stderr str
+       hFlush stderr
+     return [])


=====================================
testsuite/tests/th/T23309.stderr
=====================================
@@ -0,0 +1 @@
+The value of e is: 42


=====================================
testsuite/tests/th/T23309A.hs
=====================================
@@ -0,0 +1,19 @@
+{-# LANGUAGE CPP #-}
+module T23309A (c_foo) where
+
+import Foreign.C.String
+import Foreign.C.Types
+
+#if defined(mingw32_HOST_OS)
+# if defined(i386_HOST_ARCH)
+#  define CALLCONV stdcall
+# elif defined(x86_64_HOST_ARCH)
+#  define CALLCONV ccall
+# else
+#  error Unknown mingw32 arch
+# endif
+#else
+# define CALLCONV ccall
+#endif
+
+foreign import CALLCONV unsafe "foo" c_foo :: CInt -> IO CString


=====================================
testsuite/tests/th/T23378.hs
=====================================
@@ -0,0 +1,13 @@
+{-# LANGUAGE TemplateHaskell #-}
+module T23378 where
+
+import Foreign.C.String
+import Language.Haskell.TH
+import System.IO
+
+import T23378A
+
+$(do runIO $ do
+       hPrint stderr isatty
+       hFlush stderr
+     return [])


=====================================
testsuite/tests/th/T23378.stderr
=====================================
@@ -0,0 +1 @@
+False


=====================================
testsuite/tests/th/T23378A.hs
=====================================
@@ -0,0 +1,12 @@
+module T23378A where
+
+import Foreign.C.Types
+import System.IO.Unsafe
+
+isatty :: Bool
+isatty =
+  unsafePerformIO (c_isatty 1) == 1
+{-# NOINLINE isatty #-}
+
+foreign import ccall unsafe "isatty"
+  c_isatty :: CInt -> IO CInt


=====================================
testsuite/tests/th/all.T
=====================================
@@ -589,3 +589,5 @@ test('T23829_hasty', normal, compile_fail, [''])
 test('T23829_hasty_b', normal, compile_fail, [''])
 test('T23927', normal, compile_and_run, [''])
 test('T23954', normal, compile_and_run, [''])
+test('T23309', [extra_files(['T23309A.hs']), req_c], compile, ['T23309.c'])
+test('T23378', [extra_files(['T23378A.hs'])], compile, [''])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/90d505e27f19d4ac0e8b395408cece833c95e1b8

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/90d505e27f19d4ac0e8b395408cece833c95e1b8
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230920/8f3dc9bf/attachment-0001.html>