[Git][ghc/ghc][wip/toolchain-selection] Fix bugs in MergeTool and Ar

[Rodrigo Mesquita (@alt-romes)]

Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC


Commits:
5705030f by Rodrigo Mesquita at 2023-05-30T19:58:11+01:00
Fix bugs in MergeTool and Ar

- - - - -


5 changed files:

- m4/ghc_toolchain.m4
- utils/ghc-toolchain/Main.hs
- utils/ghc-toolchain/src/GHC/Toolchain/Monad.hs
- utils/ghc-toolchain/src/GHC/Toolchain/Tools/Ar.hs
- utils/ghc-toolchain/src/GHC/Toolchain/Tools/MergeObjs.hs


Changes:

=====================================
m4/ghc_toolchain.m4
=====================================
@@ -61,7 +61,7 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN],
         while read -r arg; do
             set -- "[$]@" "$arg"
         done
-        ./acghc-toolchain "[$]@" || exit 1
+        ./acghc-toolchain -v2 "[$]@" || exit 1
         python3 -c 'import sys; print(sys.argv)' "[$]@"
     ) <acargs || exit 1
 


=====================================
utils/ghc-toolchain/Main.hs
=====================================
@@ -310,6 +310,8 @@ mkTarget opts = do
     nm <- findNm (optNm opts)
     mergeObjs <- optional $ findMergeObjs (optMergeObjs opts) cc ccLink nm
 
+    -- TODO: Either mergeObjs or -L capable ar
+
     -- Windows-specific utilities
     (windres, dllwrap) <-
         case archOS_OS archOs of


=====================================
utils/ghc-toolchain/src/GHC/Toolchain/Monad.hs
=====================================
@@ -81,6 +81,7 @@ checking what k = do
     logInfo $ "checking " ++ what ++ "..."
     r <- withLogContext ("checking " ++ what) k
     logInfo $ "found " ++ what ++ ": " ++ show r
+    -- ROMES:TODO: Otherwise print errors
     return r
 
 logDebug :: String -> M ()


=====================================
utils/ghc-toolchain/src/GHC/Toolchain/Tools/Ar.hs
=====================================
@@ -73,9 +73,9 @@ checkArWorks prog = checking "that ar works" $ withTempDir $ \dir -> do
 checkArSupportsDashL :: Program -> M Bool
 checkArSupportsDashL bareAr = checking "that ar supports -L" $ withTempDir $ \dir -> do
     let file ext = dir </> "conftest" <.> ext
-        archive1 = dir </> "conttest-a.a"
-        archive2 = dir </> "conttest-b.a"
-        merged   = dir </> "conttest.a"
+        archive1 = dir </> "conftest-a.a"
+        archive2 = dir </> "conftest-b.a"
+        merged   = dir </> "conftest.a"
     mapM_ (createFile . file) ["file", "a0", "a1", "b0", "b1"]
     -- Build two archives, merge them, and check that the
     -- result contains the original files rather than the two
@@ -85,7 +85,7 @@ checkArSupportsDashL bareAr = checking "that ar supports -L" $ withTempDir $ \di
     oneOf "trying -L"
         [ do callProgram bareAr ["qcL", merged, archive1, archive2]
              contents <- readProgramStdout bareAr ["t", merged]
-             return $ not $ "conftest.a1" `isInfixOf` contents
+             return $ "conftest.a1" `isInfixOf` contents
         , return False
         ]
 
@@ -102,3 +102,4 @@ checkArSupportsAtFile bareAr mkArchive = checking "that ar supports @-files" $ w
     if lines contents == objs
       then return True
       else logDebug "Contents didn't match" >> return False
+


=====================================
utils/ghc-toolchain/src/GHC/Toolchain/Tools/MergeObjs.hs
=====================================
@@ -33,8 +33,8 @@ checkMergingWorks :: Cc -> Nm -> MergeObjs -> M ()
 checkMergingWorks cc nm mergeObjs =
     checking "whether object merging works" $ withTempDir $ \dir -> do
         let fo s = dir </> s <.> "o"
-        compileC cc (fo "a") "void funA(int x) { return x; }"
-        compileC cc (fo "b") "void funB(int x) { return x; }"
+        compileC cc (fo "a") "int funA(int x) { return x; }"
+        compileC cc (fo "b") "int funB(int x) { return x; }"
         callProgram (mergeObjsProgram mergeObjs) [fo "a", fo "b", "-o", fo "out"]
         out <- readProgramStdout (nmProgram nm) [fo "out"]
         let ok = all (`isInfixOf` out) ["funA", "funB"]



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5705030f926b28496a7df4fa33587f6e2de05fda

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5705030f926b28496a7df4fa33587f6e2de05fda
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/20230530/b367ae8b/attachment-0001.html>