From 1471271bf690232b625a763cff91193228fcc3fe Mon Sep 17 00:00:00 2001
From: Mikhail Glushenkov <mikhail.glushenkov@gmail.com>
Date: Fri, 27 Mar 2015 00:06:52 +0100
Subject: [PATCH] Handle more 'strip --version' output formats.
Fixes #2497.
---
Cabal/Cabal.cabal | 2 +
Cabal/Distribution/Simple/Program/Builtin.hs | 20 ++------
Cabal/Distribution/Simple/Program/Internal.hs | 46 +++++++++++++++++++
Cabal/tests/UnitTests.hs | 3 ++
.../Distribution/Simple/Program/Internal.hs | 36 +++++++++++++++
5 files changed, 90 insertions(+), 17 deletions(-)
create mode 100644 Cabal/Distribution/Simple/Program/Internal.hs
create mode 100644 Cabal/tests/UnitTests/Distribution/Simple/Program/Internal.hs
diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal
index 6d73a20db3..9ea3434e59 100644
--- a/Cabal/Cabal.cabal
+++ b/Cabal/Cabal.cabal
@@ -208,6 +208,7 @@ library
Distribution.Simple.Program.GHC
Distribution.Simple.Program.HcPkg
Distribution.Simple.Program.Hpc
+ Distribution.Simple.Program.Internal
Distribution.Simple.Program.Ld
Distribution.Simple.Program.Run
Distribution.Simple.Program.Script
@@ -257,6 +258,7 @@ test-suite unit-tests
other-modules:
UnitTests.Distribution.Compat.CreatePipe
UnitTests.Distribution.Compat.ReadP
+ UnitTests.Distribution.Simple.Program.Internal
UnitTests.Distribution.Utils.NubList
main-is: UnitTests.hs
build-depends:
diff --git a/Cabal/Distribution/Simple/Program/Builtin.hs b/Cabal/Distribution/Simple/Program/Builtin.hs
index a4e56190dd..d844f48b79 100644
--- a/Cabal/Distribution/Simple/Program/Builtin.hs
+++ b/Cabal/Distribution/Simple/Program/Builtin.hs
@@ -47,6 +47,8 @@ module Distribution.Simple.Program.Builtin (
import Distribution.Simple.Program.Find
( findProgramOnSearchPath )
+import Distribution.Simple.Program.Internal
+ ( stripExtractVersion )
import Distribution.Simple.Program.Run
( getProgramInvocationOutput, programInvocation )
import Distribution.Simple.Program.Types
@@ -269,24 +271,8 @@ arProgram = simpleProgram "ar"
stripProgram :: Program
stripProgram = (simpleProgram "strip") {
programFindVersion = \verbosity ->
- findProgramVersion "--version" selectVersion (lessVerbose verbosity)
+ findProgramVersion "--version" stripExtractVersion (lessVerbose verbosity)
}
- where
- selectVersion str =
- -- Invoking "strip --version" gives very inconsistent
- -- results. We look for the first word that starts with a
- -- number, and try parsing out the first two components of
- -- it. Non-GNU 'strip' doesn't appear to have a version flag.
- let numeric "" = False
- numeric (x:_) = isDigit x
- in case dropWhile (not . numeric) (words str) of
- (ver:_) ->
- -- take the first two version components
- let isDot = (== '.')
- (major, rest) = break isDot ver
- minor = takeWhile (not . isDot) (dropWhile isDot rest)
- in major ++ "." ++ minor
- _ -> ""
hsc2hsProgram :: Program
hsc2hsProgram = (simpleProgram "hsc2hs") {
diff --git a/Cabal/Distribution/Simple/Program/Internal.hs b/Cabal/Distribution/Simple/Program/Internal.hs
new file mode 100644
index 0000000000..76e50376c5
--- /dev/null
+++ b/Cabal/Distribution/Simple/Program/Internal.hs
@@ -0,0 +1,46 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module : Distribution.Simple.Program.Internal
+--
+-- Maintainer : cabal-devel@haskell.org
+-- Portability : portable
+--
+-- Internal utilities used by Distribution.Simple.Program.*.
+
+module Distribution.Simple.Program.Internal (
+ stripExtractVersion,
+ ) where
+
+import Data.Char (isDigit)
+import Data.List (isPrefixOf, isSuffixOf)
+
+-- | Extract the version number from the output of 'strip --version'.
+--
+-- Invoking "strip --version" gives very inconsistent results. We ignore
+-- everything in parentheses (see #2497), look for the first word that starts
+-- with a number, and try parsing out the first two components of it. Non-GNU
+-- 'strip' doesn't appear to have a version flag.
+stripExtractVersion :: String -> String
+stripExtractVersion str =
+ let numeric "" = False
+ numeric (x:_) = isDigit x
+
+ -- Filter out everything in parentheses.
+ filterPar' :: Int -> [String] -> [String]
+ filterPar' _ [] = []
+ filterPar' n (x:xs)
+ | n >= 0 && "(" `isPrefixOf` x = filterPar' (n+1) ((tail x):xs)
+ | n > 0 && ")" `isSuffixOf` x = filterPar' (n-1) xs
+ | n > 0 = filterPar' n xs
+ | otherwise = x:filterPar' n xs
+
+ filterPar = filterPar' 0
+
+ in case dropWhile (not . numeric) (filterPar . words $ str) of
+ (ver:_) ->
+ -- take the first two version components
+ let isDot = (== '.')
+ (major, rest) = break isDot ver
+ minor = takeWhile isDigit (dropWhile isDot rest)
+ in major ++ "." ++ minor
+ _ -> ""
diff --git a/Cabal/tests/UnitTests.hs b/Cabal/tests/UnitTests.hs
index fe78268b79..6f22262b00 100644
--- a/Cabal/tests/UnitTests.hs
+++ b/Cabal/tests/UnitTests.hs
@@ -6,6 +6,7 @@ import Test.Tasty
import qualified UnitTests.Distribution.Compat.CreatePipe
import qualified UnitTests.Distribution.Compat.ReadP
+import qualified UnitTests.Distribution.Simple.Program.Internal
import qualified UnitTests.Distribution.Utils.NubList
tests :: TestTree
@@ -14,6 +15,8 @@ tests = testGroup "Unit Tests" $
UnitTests.Distribution.Compat.ReadP.tests
, testGroup "Distribution.Compat.CreatePipe"
UnitTests.Distribution.Compat.CreatePipe.tests
+ , testGroup "Distribution.Simple.Program.Internal"
+ UnitTests.Distribution.Simple.Program.Internal.tests
, testGroup "Distribution.Utils.NubList"
UnitTests.Distribution.Utils.NubList.tests
]
diff --git a/Cabal/tests/UnitTests/Distribution/Simple/Program/Internal.hs b/Cabal/tests/UnitTests/Distribution/Simple/Program/Internal.hs
new file mode 100644
index 0000000000..4766cbb36c
--- /dev/null
+++ b/Cabal/tests/UnitTests/Distribution/Simple/Program/Internal.hs
@@ -0,0 +1,36 @@
+module UnitTests.Distribution.Simple.Program.Internal
+ ( tests
+ ) where
+
+import Distribution.Simple.Program.Internal ( stripExtractVersion )
+
+import Test.Tasty
+import Test.Tasty.HUnit
+
+v :: String
+v = "GNU strip (GNU Binutils; openSUSE 13.2) 2.24.0.20140403-6.1\nCopyright 2013\
+ \ Free Software Foundation, Inc.\nThis program is free software; you may\
+ \ redistribute it under the terms of\nthe GNU General Public License version 3\
+ \ or (at your option) any later version.\nThis program has absolutely no\
+ \ warranty.\n"
+
+v' :: String
+v' = "GNU strip 2.17.50.0.6-26.el5 20061020"
+
+v'' :: String
+v'' = "GNU strip (openSUSE-13.2) 2.23.50.0.6-26.el5 20061020"
+
+v''' :: String
+v''' = "GNU strip (GNU (Binutils for) Ubuntu 12.04 ) 2.22"
+
+tests :: [TestTree]
+tests =
+ [ testCase "Handles parentheses" $
+ (stripExtractVersion v) @=? "2.24"
+ , testCase "Handles dashes and alphabetic characters" $
+ (stripExtractVersion v') @=? "2.17"
+ , testCase "Handles single-word parenthetical expressions" $
+ (stripExtractVersion v'') @=? "2.23"
+ , testCase "Handles nested parentheses" $
+ (stripExtractVersion v''') @=? "2.22"
+ ]
--
GitLab