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

John Ericson (@Ericson2314) gitlab at gitlab.haskell.org
Mon Sep 18 16:00:31 UTC 2023



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


Commits:
7b23511e by John Ericson at 2023-09-18T12:00:17-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>

- - - - -


6 changed files:

- + testsuite/tests/th/T23309.c
- + testsuite/tests/th/T23309.hs
- + testsuite/tests/th/T23309/Dep.hs
- + testsuite/tests/th/T23378.hs
- + testsuite/tests/th/T23378/Dep.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,13 @@
+{-# LANGUAGE TemplateHaskell #-}
+module T23309 where
+
+import Foreign.C.String
+import Language.Haskell.TH
+
+import T23309.Dep
+
+$(do runIO $ do
+       cstr <- c_foo 42
+       str <- peekCString cstr
+       putStrLn str
+     return [])


=====================================
testsuite/tests/th/T23309/Dep.hs
=====================================
@@ -0,0 +1,19 @@
+{-# LANGUAGE CPP #-}
+module T23309.Dep (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,9 @@
+module T23378 where
+
+import Foreign.C.String
+import Language.Haskell.TH
+
+import T23378.Dep
+
+$(do runIO $ print isatty
+     return [])


=====================================
testsuite/tests/th/T23378/Dep.hs
=====================================
@@ -0,0 +1,12 @@
+module T23378.Dep 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', [req_c], compile, ['T23309.c'])
+test('T23378', normal, compile, [''])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7b23511e74eed5f768eec64f5201f67abde251f6

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7b23511e74eed5f768eec64f5201f67abde251f6
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/20230918/f4c9e42a/attachment-0001.html>


More information about the ghc-commits mailing list