.gitlab-ci.yml

@@ -19,7 +19,7 @@ stages:
   - lint       # Source linting
   - build      # A quick smoke-test to weed out broken commits
   - full-build # Build all the things
-  - cleanup    # See Note [Cleanup on Windows]
+  - cleanup    # See Note [Cleanup after the shell executor]
   - packaging  # Source distribution, etc.
   - hackage    # head.hackage testing
   - deploy     # push documentation
@@ -673,35 +673,18 @@ nightly-i386-windows:
 #
 # As noted in [1], gitlab-runner's shell executor doesn't clean up its working
 # directory after builds. Unfortunately, we are forced to use the shell executor
-# on Windows. To avoid running out of disk space we add a stage at the end of
-# the build to remove the \GitLabRunner\builds directory. Since we only run a
-# single build at a time on Windows this should be safe.
+# on Darwin. To avoid running out of disk space we add a stage at the end of
+# the build to remove the /.../GitLabRunner/builds directory. Since we only run a
+# single build at a time on Darwin this should be safe.
+#
+# We used to have a similar cleanup job on Windows as well however it ended up
+# being quite fragile as we have multiple Windows builders yet there is no
+# guarantee that the cleanup job is run on the same machine as the build itself
+# was run. Consequently we were forced to instead handle cleanup with a separate
+# cleanup cron job on Windows.
 #
 # [1] https://gitlab.com/gitlab-org/gitlab-runner/issues/3856
 
-# See Note [Cleanup after shell executor]
-cleanup-windows:
-  <<: *only-default
-  stage: cleanup
-  tags:
-    - x86_64-windows
-  when: always
-  dependencies: []
-  before_script:
-    - echo "Time to clean up"
-  script:
-    - echo "Let's go"
-  after_script:
-    - set "BUILD_DIR=%CI_PROJECT_DIR%"
-    - set "BUILD_DIR=%BUILD_DIR:/=\%"
-    - echo "Cleaning %BUILD_DIR%"
-    - cd \GitLabRunner
-    # This is way more complicated than it should be:
-    # See https://stackoverflow.com/questions/1965787
-    - del %BUILD_DIR%\* /F /Q
-    - for /d %%p in (%BUILD_DIR%\*) do rd /Q /S "%%p"
-    - exit /b 0
-
 # See Note [Cleanup after shell executor]
 cleanup-darwin:
   <<: *only-default

testsuite/.gitignore

@@ -694,6 +694,7 @@ mk/ghcconfig*_test___spaces_ghc*.exe.mk
 /tests/ffi/should_run/Capi_Ctype_002
 /tests/ffi/should_run/Capi_Ctype_A_001.hs
 /tests/ffi/should_run/Capi_Ctype_A_002.hs
+/tests/ffi/should_run/T493
 /tests/ffi/should_run/T1288
 /tests/ffi/should_run/T1679
 /tests/ffi/should_run/T2276

testsuite/tests/ffi/should_run/T493.hs

+import Foreign
+import Foreign.C
+
+-- These newtypes...
+newtype MyFunPtr a = MyFunPtr { getFunPtr :: FunPtr a }
+newtype MyPtr a = MyPtr (Ptr a)
+newtype MyIO a = MyIO { runIO :: IO a }
+-- should be supported by...
+
+-- foreign import dynamics
+foreign import ccall "dynamic"
+    mkFun1 :: MyFunPtr (CInt -> CInt) -> (CInt -> CInt)
+foreign import ccall "dynamic"
+    mkFun2 :: MyPtr (Int32 -> Int32) -> (CInt -> CInt)
+
+-- and foreign import wrappers.
+foreign import ccall "wrapper"
+    mkWrap1 :: (CInt -> CInt) -> MyIO (MyFunPtr (CInt -> CInt))
+foreign import ccall "wrapper"
+    mkWrap2 :: (CInt -> CInt) -> MyIO (MyPtr (Int32 -> Int32))
+
+-- We'll need a dynamic function point to export
+foreign import ccall "getDbl" getDbl :: IO (MyFunPtr (CInt -> CInt))
+-- and a Haskell function to export
+half :: CInt -> CInt
+half = (`div` 2)
+-- and a C function to pass it to.
+foreign import ccall "apply" apply1 :: MyFunPtr (CInt -> CInt) -> Int -> Int
+foreign import ccall "apply" apply2 :: MyPtr (Int32 -> Int32) -> Int -> Int
+
+main :: IO ()
+main = do
+
+  dbl <- getDbl
+  let dbl1 = mkFun1 dbl
+      dbl2 = mkFun2 $ MyPtr $ castFunPtrToPtr $ getFunPtr dbl
+  print (dbl1 21, dbl2 21)
+
+  half1 <- runIO $ mkWrap1 half
+  half2 <- runIO $ mkWrap2 half
+  print (apply1 half1 84, apply2 half2 84)

testsuite/tests/ffi/should_run/T493.stdout

+(42,42)
+(42,42)

testsuite/tests/ffi/should_run/T493_c.c

+typedef int (*intfun_p)(int);
+
+int dbl(int x)
+{
+        return x*2;
+}
+
+intfun_p getDbl(void)
+{
+        return dbl;
+}
+
+int apply(intfun_p f, int x)
+{
+        return f(x);
+}

testsuite/tests/ffi/should_run/all.T

@@ -198,3 +198,5 @@ test('PrimFFIWord8', [omit_ways(['ghci'])], compile_and_run, ['PrimFFIWord8_c.c'
 test('PrimFFIInt16', [omit_ways(['ghci'])], compile_and_run, ['PrimFFIInt16_c.c'])
 
 test('PrimFFIWord16', [omit_ways(['ghci'])], compile_and_run, ['PrimFFIWord16_c.c'])
+
+test('T493', [], compile_and_run, ['T493_c.c'])

testsuite/tests/parser/should_compile/T504.hs

+{-# OPTIONS_GHC -Wno-inline-rule-shadowing #-}
+module Bug where
+
+-- regression test for #504:
+-- the pragma start and end sequences can both start in column 1
+-- without parse error
+
+{-# RULES
+  "foo" foo 1 = 1
+#-}
+foo 1 = 1

testsuite/tests/parser/should_compile/all.T

@@ -143,3 +143,4 @@ test('T15675', normal, compile, [''])
 test('T15781', normal, compile, [''])
 test('T16339', normal, compile, [''])
 test('T16619', [], multimod_compile, ['T16619', '-v0'])
+test('T504', normal, compile, [''])