test: Proper intermixing of GCC warnings with test output

2 files changed, 25 insertions, 19 deletions

diff --git a/src/Compile.hs b/src/Compile.hs
index f2063ee..bf7817a 100644
--- a/src/Compile.hs
+++ b/src/Compile.hs
@@ -8,7 +8,7 @@
 {-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
-module Compile (compile) where
+module Compile (compile, compileStderr) where
 
 import Control.Applicative (empty)
 import Control.Monad (forM_, when, replicateM)
@@ -71,28 +71,30 @@ debugAllocs :: Bool; debugAllocs = toEnum 0
 -- | Emit extra C code that checks stuff
 emitChecks :: Bool; emitChecks = toEnum 0
 
+-- | Returns compiled function plus compilation output (warnings)
 compile :: SList STy env -> Ex env t
-        -> IO (SList Value env -> IO (Rep t))
+        -> IO (SList Value env -> IO (Rep t), String)
 compile = \env expr -> do
   codeID <- atomicModifyIORef' uniqueIdGenRef (\i -> (i + 1, i))
 
   let (source, offsets) = compileToString codeID env expr
   when debugPrintAST $ hPutStrLn stderr $ "Compiled AST: <<<\n" ++ ppExpr env expr ++ "\n>>>"
   when debugCSource $ hPutStrLn stderr $ "Generated C source: <<<\n\x1B[2m" ++ lineNumbers source ++ "\x1B[0m>>>"
-  lib <- buildKernel source "kernel"
+  (lib, compileOutput) <- buildKernel source "kernel"
 
   let result_type = typeOf expr
       result_size = sizeofSTy result_type
 
-  return $ \val -> do
-    allocaBytes (koResultOffset offsets + result_size) $ \ptr -> do
-      let args = zip (reverse (unSList Some (slistZip env val))) (koArgOffsets offsets)
-      serialiseArguments args ptr $ do
-        callKernelFun lib ptr
-        ok <- peekByteOff @Word8 ptr (koOkResOffset offsets)
-        when (ok /= 1) $
-          ioError (mkIOError userErrorType "fatal error detected during chad kernel execution (memory has been leaked)" Nothing Nothing)
-        deserialise result_type ptr (koResultOffset offsets)
+  let function val = do
+        allocaBytes (koResultOffset offsets + result_size) $ \ptr -> do
+          let args = zip (reverse (unSList Some (slistZip env val))) (koArgOffsets offsets)
+          serialiseArguments args ptr $ do
+            callKernelFun lib ptr
+            ok <- peekByteOff @Word8 ptr (koOkResOffset offsets)
+            when (ok /= 1) $
+              ioError (mkIOError userErrorType "fatal error detected during chad kernel execution (memory has been leaked)" Nothing Nothing)
+            deserialise result_type ptr (koResultOffset offsets)
+  return (function, compileOutput)
   where
     serialiseArguments :: [(Some (Product STy Value), Int)] -> Ptr () -> IO r -> IO r
     serialiseArguments ((Some (Product.Pair t (Value arg)), off) : args) ptr k =
@@ -100,6 +102,15 @@ compile = \env expr -> do
         serialiseArguments args ptr k
     serialiseArguments _ _ k = k
 
+-- | 'compile', but writes any produced C compiler output to stderr.
+compileStderr :: SList STy env -> Ex env t
+              -> IO (SList Value env -> IO (Rep t))
+compileStderr env expr = do
+  (fun, output) <- compile env expr
+  when (not (null output)) $
+    hPutStrLn stderr $ "[chad] Kernel compilation GCC output: <<<\n" ++ output ++ ">>>"
+  return fun
+
 
 data StructDecl = StructDecl
     String  -- ^ name
diff --git a/src/Compile/Exec.hs b/src/Compile/Exec.hs
index cc6d5fa..bbccf1c 100644
--- a/src/Compile/Exec.hs
+++ b/src/Compile/Exec.hs
@@ -30,7 +30,7 @@ debug = False
 -- The IORef wrapper is required for the finalizer to attach properly (see the 'Weak' docs)
 data KernelLib = KernelLib !(IORef (FunPtr (Ptr () -> IO ())))
 
-buildKernel :: String -> String -> IO KernelLib
+buildKernel :: String -> String -> IO (KernelLib, String)
 buildKernel csource funname = do
   template <- (++ "/tmp.chad.") <$> getTempDir
   path <- mkdtemp template
@@ -51,11 +51,6 @@ buildKernel csource funname = do
     ExitSuccess -> return ()
     ExitFailure{} -> hPutStrLn stderr $ "[chad] Kernel compilation failed! Source: <<<\n" ++ lineNumbers csource ++ ">>>"
 
-  when (not (null gccStdout)) $
-    hPutStrLn stderr $ "[chad] Kernel compilation: GCC stdout: <<<\n" ++ gccStdout ++ ">>>"
-  when (not (null gccStderr)) $
-    hPutStrLn stderr $ "[chad] Kernel compilation: GCC stderr: <<<\n" ++ gccStderr ++ ">>>"
-
   case ec of
     ExitSuccess -> return ()
     ExitFailure{} -> do
@@ -72,7 +67,7 @@ buildKernel csource funname = do
   _ <- mkWeakIORef ref (do numLeft <- atomicModifyIORef' numLoadedCounter (\n -> (n-1, n-1))
                            when debug $ hPutStrLn stderr $ "[chad] unloading kernel " ++ path ++ " (" ++ show numLeft ++ " left)"
                            dlclose dl)
-  return (KernelLib ref)
+  return (KernelLib ref, gccStdout ++ (if null gccStdout then "" else "\n") ++ gccStderr)
 
 foreign import ccall "dynamic"
   wrapKernelFun :: FunPtr (Ptr () -> IO ()) -> Ptr () -> IO ()