Skip to content

Commit b3b1ff3

Browse files
alt-romesalt-romes
committed
Revert "Not so pretty Thing to make tests pass"
This reverts commit 71e521a.
1 parent 71e521a commit b3b1ff3

File tree

4 files changed

+53
-69
lines changed

4 files changed

+53
-69
lines changed

‎cabal-install-solver/src/Distribution/Solver/Modular/Message.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -359,4 +359,4 @@ showConflictingDep (ConflictingDep dr (PkgComponent qpn comp) ci) =
359359
-- >>> let v0 = POption (I (mkVersion [0]) InRepo) Nothing
360360
-- >>> let v1 = POption (I (mkVersion [1]) InRepo) Nothing
361361
-- >>> let i0 = POption (I (mkVersion [0]) (Inst $ mkUnitId "foo-bar-0-inplace")) Nothing
362-
-- >>> let i1 = POption (I (mkVersion [1]) (Inst $ mkUnitId "foo-bar-1-inplace")) Nothing
362+
-- >>> let i1 = POption (I (mkVersion [1]) (Inst $ mkUnitId "foo-bar-1-inplace")) Nothing

‎cabal-install-solver/src/Distribution/Solver/Types/LabeledPackageConstraint.hs

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -9,7 +9,6 @@ import Distribution.Solver.Types.PackageConstraint
99
-- | 'PackageConstraint' labeled with its source.
1010
data LabeledPackageConstraint
1111
= LabeledPackageConstraint PackageConstraint ConstraintSource
12-
deriving Show
1312

1413
unlabelPackageConstraint :: LabeledPackageConstraint -> PackageConstraint
1514
unlabelPackageConstraint (LabeledPackageConstraint pc _) = pc

‎cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs

Lines changed: 9 additions & 66 deletions
Original file line numberDiff line numberDiff line change
@@ -47,11 +47,8 @@ module UnitTests.Distribution.Solver.Modular.DSL
4747
, runProgress
4848
, mkSimpleVersion
4949
, mkVersionRange
50-
, exQualToQPN
51-
, sortedGoalsToSortOrder
5250
) where
5351

54-
import Data.List (elemIndex)
5552
import Distribution.Solver.Compat.Prelude
5653
import Distribution.Utils.Generic
5754
import Prelude ()
@@ -87,7 +84,6 @@ import qualified Distribution.Client.SolverInstallPlan as CI.SolverInstallPlan
8784
import Distribution.Client.Types
8885

8986
import Distribution.Solver.Types.ComponentDeps (ComponentDeps)
90-
import qualified Distribution.Solver.Types.ComponentDeps as C
9187
import qualified Distribution.Solver.Types.ComponentDeps as CD
9288
import Distribution.Solver.Types.ConstraintSource
9389
import Distribution.Solver.Types.Flag
@@ -827,7 +823,7 @@ exResolve
827823
-> OnlyConstrained
828824
-> EnableBackjumping
829825
-> SolveExecutables
830-
-> Maybe [ExampleVar]
826+
-> Maybe (Variable P.QPN -> Variable P.QPN -> Ordering)
831827
-> [ExConstraint]
832828
-> [ExPreference]
833829
-> C.Verbosity
@@ -872,28 +868,13 @@ exResolve
872868
}
873869
enableTests
874870
| asBool enableAllTests =
875-
nub $
876-
-- We need to traverse the explicit goals and introduce the tests for each in the corresponding scope,
877-
-- because some may be qualified and simply introducing them at the top-level would not be correct
878-
map
879-
( \var ->
880-
PackageConstraint
881-
( case case var of
882-
P qual pkgname -> exQualToQPN qual pkgname
883-
F qual pkgname _ -> exQualToQPN qual pkgname
884-
S qual pkgname _ -> exQualToQPN qual pkgname of
885-
P.Q (P.PackagePath ns ql) pkgname -> ScopeQualified ns ql pkgname
886-
)
887-
(PackagePropertyStanzas [TestStanzas])
888-
)
889-
(fromMaybe [] goalOrder)
890-
<> fmap
891-
( \p ->
892-
PackageConstraint
893-
(scopeToplevel (C.mkPackageName p))
894-
(PackagePropertyStanzas [TestStanzas])
895-
)
896-
(exDbPkgs db)
871+
fmap
872+
( \p ->
873+
PackageConstraint
874+
(scopeToplevel (C.mkPackageName p))
875+
(PackagePropertyStanzas [TestStanzas])
876+
)
877+
(exDbPkgs db)
897878
| otherwise = []
898879
targets' = fmap (\p -> NamedPackage (C.mkPackageName p) []) targets
899880
params =
@@ -911,7 +892,7 @@ exResolve
911892
setOnlyConstrained onlyConstrained $
912893
setEnableBackjumping enableBj $
913894
setSolveExecutables solveExes $
914-
setGoalOrder (sortedGoalsToSortOrder <$> goalOrder) $
895+
setGoalOrder goalOrder $
915896
setSolverVerbosity verbosity $
916897
standardInstallPolicy instIdx avaiIdx targets'
917898
toLpc pc = LabeledPackageConstraint pc ConstraintSourceUnknown
@@ -951,41 +932,3 @@ runProgress = go
951932
go (Step s p) = let (ss, result) = go p in (s : ss, result)
952933
go (Fail e) = ([], Left e)
953934
go (Done a) = ([], Right a)
954-
955-
exQualToQPN :: ExampleQualifier -> ExamplePkgName -> P.QPN
956-
exQualToQPN q pn = P.Q pp (C.mkPackageName pn)
957-
where
958-
pp = case q of
959-
QualNone -> P.PackagePath P.DefaultNamespace P.QualToplevel
960-
QualIndep p ->
961-
P.PackagePath
962-
(P.Independent $ C.mkPackageName p)
963-
P.QualToplevel
964-
QualSetup s ->
965-
P.PackagePath
966-
(P.IndependentComponent (C.mkPackageName s) C.ComponentSetup)
967-
(P.QualToplevel)
968-
QualExe p1 p2 ->
969-
P.PackagePath
970-
(P.IndependentBuildTool (C.mkPackageName p1) (C.mkPackageName p2))
971-
P.QualToplevel
972-
973-
sortedGoalsToSortOrder :: [ExampleVar] -> Variable P.QPN -> Variable P.QPN -> Ordering
974-
sortedGoalsToSortOrder = sortGoals where
975-
sortGoals
976-
:: [ExampleVar]
977-
-> Variable P.QPN
978-
-> Variable P.QPN
979-
-> Ordering
980-
sortGoals = orderFromList . map toVariable
981-
982-
-- Sort elements in the list ahead of elements not in the list. Otherwise,
983-
-- follow the order in the list.
984-
orderFromList :: Eq a => [a] -> a -> a -> Ordering
985-
orderFromList xs =
986-
comparing $ \x -> let i = elemIndex x xs in (isNothing i, i)
987-
988-
toVariable :: ExampleVar -> Variable P.QPN
989-
toVariable (P q pn) = PackageVar (exQualToQPN q pn)
990-
toVariable (F q pn fn) = FlagVar (exQualToQPN q pn) (C.mkFlagName fn)
991-
toVariable (S q pn stanza) = StanzaVar (exQualToQPN q pn) stanza

‎cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL/TestCaseUtils.hs

Lines changed: 43 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -33,19 +33,25 @@ module UnitTests.Distribution.Solver.Modular.DSL.TestCaseUtils
3333
import Distribution.Solver.Compat.Prelude
3434
import Prelude ()
3535

36+
import Data.List (elemIndex)
37+
3638
-- test-framework
3739
import Test.Tasty as TF
3840
import Test.Tasty.HUnit (assertBool, assertEqual, testCase)
3941

4042
-- Cabal
43+
import qualified Distribution.PackageDescription as C
4144
import Distribution.Verbosity
4245
import Language.Haskell.Extension (Extension (..), Language (..))
4346

4447
-- cabal-install
4548

4649
import Distribution.Client.Dependency (foldProgress)
50+
import qualified Distribution.Solver.Types.ComponentDeps as C
51+
import qualified Distribution.Solver.Types.PackagePath as P
4752
import Distribution.Solver.Types.PkgConfigDb (PkgConfigDb (..), pkgConfigDbFromList)
4853
import Distribution.Solver.Types.Settings
54+
import Distribution.Solver.Types.Variable
4955
import UnitTests.Distribution.Solver.Modular.DSL
5056
import UnitTests.Options
5157

@@ -257,7 +263,7 @@ runTest SolverTest{..} = askOption $ \(OptionShowSolverLog showSolverLog) ->
257263
testOnlyConstrained
258264
testEnableBackjumping
259265
testSolveExecutables
260-
testGoalOrder
266+
(sortGoals <$> testGoalOrder)
261267
testConstraints
262268
testSoftConstraints
263269
testVerbosity
@@ -283,3 +289,39 @@ runTest SolverTest{..} = askOption $ \(OptionShowSolverLog showSolverLog) ->
283289
case resultErrorMsgPredicateOrPlan result of
284290
Left f -> f msg
285291
Right _ -> False
292+
293+
sortGoals
294+
:: [ExampleVar]
295+
-> Variable P.QPN
296+
-> Variable P.QPN
297+
-> Ordering
298+
sortGoals = orderFromList . map toVariable
299+
300+
-- Sort elements in the list ahead of elements not in the list. Otherwise,
301+
-- follow the order in the list.
302+
orderFromList :: Eq a => [a] -> a -> a -> Ordering
303+
orderFromList xs =
304+
comparing $ \x -> let i = elemIndex x xs in (isNothing i, i)
305+
306+
toVariable :: ExampleVar -> Variable P.QPN
307+
toVariable (P q pn) = PackageVar (toQPN q pn)
308+
toVariable (F q pn fn) = FlagVar (toQPN q pn) (C.mkFlagName fn)
309+
toVariable (S q pn stanza) = StanzaVar (toQPN q pn) stanza
310+
311+
toQPN :: ExampleQualifier -> ExamplePkgName -> P.QPN
312+
toQPN q pn = P.Q pp (C.mkPackageName pn)
313+
where
314+
pp = case q of
315+
QualNone -> P.PackagePath P.DefaultNamespace P.QualToplevel
316+
QualIndep p ->
317+
P.PackagePath
318+
(P.Independent $ C.mkPackageName p)
319+
P.QualToplevel
320+
QualSetup s ->
321+
P.PackagePath
322+
(P.IndependentComponent (C.mkPackageName s) C.ComponentSetup)
323+
(P.QualToplevel)
324+
QualExe p1 p2 ->
325+
P.PackagePath
326+
(P.IndependentBuildTool (C.mkPackageName p1) (C.mkPackageName p2))
327+
P.QualToplevel

0 commit comments

Comments
 (0)