-
Notifications
You must be signed in to change notification settings - Fork 697
/
Solver.hs
2113 lines (1952 loc) · 97.4 KB
/
Solver.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
{-# LANGUAGE OverloadedStrings #-}
-- | This is a set of unit tests for the dependency solver,
-- which uses the solver DSL ("UnitTests.Distribution.Solver.Modular.DSL")
-- to more conveniently create package databases to run the solver tests on.
module UnitTests.Distribution.Solver.Modular.Solver (tests)
where
-- base
import Data.List (isInfixOf)
import qualified Distribution.Version as V
-- test-framework
import Test.Tasty as TF
-- Cabal
import Language.Haskell.Extension ( Extension(..)
, KnownExtension(..), Language(..))
-- cabal-install
import Distribution.Solver.Types.Flag
import Distribution.Solver.Types.OptionalStanza
import Distribution.Solver.Types.PackageConstraint
import qualified Distribution.Solver.Types.PackagePath as P
import UnitTests.Distribution.Solver.Modular.DSL
import UnitTests.Distribution.Solver.Modular.DSL.TestCaseUtils
tests :: [TF.TestTree]
tests = [
testGroup "Simple dependencies" [
runTest $ mkTest db1 "alreadyInstalled" ["A"] (solverSuccess [])
, runTest $ mkTest db1 "installLatest" ["B"] (solverSuccess [("B", 2)])
, runTest $ mkTest db1 "simpleDep1" ["C"] (solverSuccess [("B", 1), ("C", 1)])
, runTest $ mkTest db1 "simpleDep2" ["D"] (solverSuccess [("B", 2), ("D", 1)])
, runTest $ mkTest db1 "failTwoVersions" ["C", "D"] anySolverFailure
, runTest $ indep $ mkTest db1 "indepTwoVersions" ["C", "D"] (solverSuccess [("B", 1), ("B", 2), ("C", 1), ("D", 1)])
, runTest $ indep $ mkTest db1 "aliasWhenPossible1" ["C", "E"] (solverSuccess [("B", 1), ("C", 1), ("E", 1)])
, runTest $ indep $ mkTest db1 "aliasWhenPossible2" ["D", "E"] (solverSuccess [("B", 2), ("D", 1), ("E", 1)])
, runTest $ indep $ mkTest db2 "aliasWhenPossible3" ["C", "D"] (solverSuccess [("A", 1), ("A", 2), ("B", 1), ("B", 2), ("C", 1), ("D", 1)])
, runTest $ mkTest db1 "buildDepAgainstOld" ["F"] (solverSuccess [("B", 1), ("E", 1), ("F", 1)])
, runTest $ mkTest db1 "buildDepAgainstNew" ["G"] (solverSuccess [("B", 2), ("E", 1), ("G", 1)])
, runTest $ indep $ mkTest db1 "multipleInstances" ["F", "G"] anySolverFailure
, runTest $ mkTest db21 "unknownPackage1" ["A"] (solverSuccess [("A", 1), ("B", 1)])
, runTest $ mkTest db22 "unknownPackage2" ["A"] (solverFailure (isInfixOf "unknown package: C"))
, runTest $ mkTest db23 "unknownPackage3" ["A"] (solverFailure (isInfixOf "unknown package: B"))
, runTest $ mkTest [] "unknown target" ["A"] (solverFailure (isInfixOf "unknown package: A"))
]
, testGroup "Flagged dependencies" [
runTest $ mkTest db3 "forceFlagOn" ["C"] (solverSuccess [("A", 1), ("B", 1), ("C", 1)])
, runTest $ mkTest db3 "forceFlagOff" ["D"] (solverSuccess [("A", 2), ("B", 1), ("D", 1)])
, runTest $ indep $ mkTest db3 "linkFlags1" ["C", "D"] anySolverFailure
, runTest $ indep $ mkTest db4 "linkFlags2" ["C", "D"] anySolverFailure
, runTest $ indep $ mkTest db18 "linkFlags3" ["A", "B"] (solverSuccess [("A", 1), ("B", 1), ("C", 1), ("D", 1), ("D", 2), ("F", 1)])
]
, testGroup "Lifting dependencies out of conditionals" [
runTest $ commonDependencyLogMessage "common dependency log message"
, runTest $ twoLevelDeepCommonDependencyLogMessage "two level deep common dependency log message"
, runTest $ testBackjumpingWithCommonDependency "backjumping with common dependency"
]
, testGroup "Manual flags" [
runTest $ mkTest dbManualFlags "Use default value for manual flag" ["pkg"] $
solverSuccess [("pkg", 1), ("true-dep", 1)]
, let checkFullLog =
any $ isInfixOf "rejecting: pkg:-flag (manual flag can only be changed explicitly)"
in runTest $ setVerbose $
constraints [ExVersionConstraint (ScopeAnyQualifier "true-dep") V.noVersion] $
mkTest dbManualFlags "Don't toggle manual flag to avoid conflict" ["pkg"] $
-- TODO: We should check the summarized log instead of the full log
-- for the manual flags error message, but it currently only
-- appears in the full log.
SolverResult checkFullLog (Left $ const True)
, let cs = [ExFlagConstraint (ScopeAnyQualifier "pkg") "flag" False]
in runTest $ constraints cs $
mkTest dbManualFlags "Toggle manual flag with flag constraint" ["pkg"] $
solverSuccess [("false-dep", 1), ("pkg", 1)]
]
, testGroup "Qualified manual flag constraints" [
let name = "Top-level flag constraint does not constrain setup dep's flag"
cs = [ExFlagConstraint (ScopeQualified P.QualToplevel "B") "flag" False]
in runTest $ constraints cs $ mkTest dbSetupDepWithManualFlag name ["A"] $
solverSuccess [ ("A", 1), ("B", 1), ("B", 2)
, ("b-1-false-dep", 1), ("b-2-true-dep", 1) ]
, let name = "Solver can toggle setup dep's flag to match top-level constraint"
cs = [ ExFlagConstraint (ScopeQualified P.QualToplevel "B") "flag" False
, ExVersionConstraint (ScopeAnyQualifier "b-2-true-dep") V.noVersion ]
in runTest $ constraints cs $ mkTest dbSetupDepWithManualFlag name ["A"] $
solverSuccess [ ("A", 1), ("B", 1), ("B", 2)
, ("b-1-false-dep", 1), ("b-2-false-dep", 1) ]
, let name = "User can constrain flags separately with qualified constraints"
cs = [ ExFlagConstraint (ScopeQualified P.QualToplevel "B") "flag" True
, ExFlagConstraint (ScopeQualified (P.QualSetup "A") "B") "flag" False ]
in runTest $ constraints cs $ mkTest dbSetupDepWithManualFlag name ["A"] $
solverSuccess [ ("A", 1), ("B", 1), ("B", 2)
, ("b-1-true-dep", 1), ("b-2-false-dep", 1) ]
-- Regression test for #4299
, let name = "Solver can link deps when only one has constrained manual flag"
cs = [ExFlagConstraint (ScopeQualified P.QualToplevel "B") "flag" False]
in runTest $ constraints cs $ mkTest dbLinkedSetupDepWithManualFlag name ["A"] $
solverSuccess [ ("A", 1), ("B", 1), ("b-1-false-dep", 1) ]
, let name = "Solver cannot link deps that have conflicting manual flag constraints"
cs = [ ExFlagConstraint (ScopeQualified P.QualToplevel "B") "flag" True
, ExFlagConstraint (ScopeQualified (P.QualSetup "A") "B") "flag" False ]
failureReason = "(constraint from unknown source requires opposite flag selection)"
checkFullLog lns =
all (\msg -> any (msg `isInfixOf`) lns)
[ "rejecting: B:-flag " ++ failureReason
, "rejecting: A:setup.B:+flag " ++ failureReason ]
in runTest $ constraints cs $ setVerbose $
mkTest dbLinkedSetupDepWithManualFlag name ["A"] $
SolverResult checkFullLog (Left $ const True)
]
, testGroup "Stanzas" [
runTest $ enableAllTests $ mkTest db5 "simpleTest1" ["C"] (solverSuccess [("A", 2), ("C", 1)])
, runTest $ enableAllTests $ mkTest db5 "simpleTest2" ["D"] anySolverFailure
, runTest $ enableAllTests $ mkTest db5 "simpleTest3" ["E"] (solverSuccess [("A", 1), ("E", 1)])
, runTest $ enableAllTests $ mkTest db5 "simpleTest4" ["F"] anySolverFailure -- TODO
, runTest $ enableAllTests $ mkTest db5 "simpleTest5" ["G"] (solverSuccess [("A", 2), ("G", 1)])
, runTest $ enableAllTests $ mkTest db5 "simpleTest6" ["E", "G"] anySolverFailure
, runTest $ indep $ enableAllTests $ mkTest db5 "simpleTest7" ["E", "G"] (solverSuccess [("A", 1), ("A", 2), ("E", 1), ("G", 1)])
, runTest $ enableAllTests $ mkTest db6 "depsWithTests1" ["C"] (solverSuccess [("A", 1), ("B", 1), ("C", 1)])
, runTest $ indep $ enableAllTests $ mkTest db6 "depsWithTests2" ["C", "D"] (solverSuccess [("A", 1), ("B", 1), ("C", 1), ("D", 1)])
, runTest $ testTestSuiteWithFlag "test suite with flag"
]
, testGroup "Setup dependencies" [
runTest $ mkTest db7 "setupDeps1" ["B"] (solverSuccess [("A", 2), ("B", 1)])
, runTest $ mkTest db7 "setupDeps2" ["C"] (solverSuccess [("A", 2), ("C", 1)])
, runTest $ mkTest db7 "setupDeps3" ["D"] (solverSuccess [("A", 1), ("D", 1)])
, runTest $ mkTest db7 "setupDeps4" ["E"] (solverSuccess [("A", 1), ("A", 2), ("E", 1)])
, runTest $ mkTest db7 "setupDeps5" ["F"] (solverSuccess [("A", 1), ("A", 2), ("F", 1)])
, runTest $ mkTest db8 "setupDeps6" ["C", "D"] (solverSuccess [("A", 1), ("B", 1), ("B", 2), ("C", 1), ("D", 1)])
, runTest $ mkTest db9 "setupDeps7" ["F", "G"] (solverSuccess [("A", 1), ("B", 1), ("B",2 ), ("C", 1), ("D", 1), ("E", 1), ("E", 2), ("F", 1), ("G", 1)])
, runTest $ mkTest db10 "setupDeps8" ["C"] (solverSuccess [("C", 1)])
, runTest $ indep $ mkTest dbSetupDeps "setupDeps9" ["A", "B"] (solverSuccess [("A", 1), ("B", 1), ("C", 1), ("D", 1), ("D", 2)])
]
, testGroup "Base shim" [
runTest $ mkTest db11 "baseShim1" ["A"] (solverSuccess [("A", 1)])
, runTest $ mkTest db12 "baseShim2" ["A"] (solverSuccess [("A", 1)])
, runTest $ mkTest db12 "baseShim3" ["B"] (solverSuccess [("B", 1)])
, runTest $ mkTest db12 "baseShim4" ["C"] (solverSuccess [("A", 1), ("B", 1), ("C", 1)])
, runTest $ mkTest db12 "baseShim5" ["D"] anySolverFailure
, runTest $ mkTest db12 "baseShim6" ["E"] (solverSuccess [("E", 1), ("syb", 2)])
]
, testGroup "Base" [
runTest $ mkTest dbBase "Refuse to install base without --allow-boot-library-installs" ["base"] $
solverFailure (isInfixOf "only already installed instances can be used")
, runTest $ allowBootLibInstalls $ mkTest dbBase "Install base with --allow-boot-library-installs" ["base"] $
solverSuccess [("base", 1), ("ghc-prim", 1), ("integer-gmp", 1), ("integer-simple", 1)]
]
, testGroup "reject-unconstrained" [
runTest $ onlyConstrained $ mkTest db12 "missing syb" ["E"] $
solverFailure (isInfixOf "not a user-provided goal")
, runTest $ onlyConstrained $ mkTest db12 "all goals" ["E", "syb"] $
solverSuccess [("E", 1), ("syb", 2)]
, runTest $ onlyConstrained $ mkTest db17 "backtracking" ["A", "B"] $
solverSuccess [("A", 2), ("B", 1)]
, runTest $ onlyConstrained $ mkTest db17 "failure message" ["A"] $
solverFailure $ isInfixOf $
"Could not resolve dependencies:\n"
++ "[__0] trying: A-3.0.0 (user goal)\n"
++ "[__1] next goal: C (dependency of A)\n"
++ "[__1] fail (not a user-provided goal nor mentioned as a constraint, "
++ "but reject-unconstrained-dependencies was set)\n"
++ "[__1] fail (backjumping, conflict set: A, C)\n"
++ "After searching the rest of the dependency tree exhaustively, "
++ "these were the goals I've had most trouble fulfilling: A, C, B"
]
, testGroup "Cycles" [
runTest $ mkTest db14 "simpleCycle1" ["A"] anySolverFailure
, runTest $ mkTest db14 "simpleCycle2" ["A", "B"] anySolverFailure
, runTest $ mkTest db14 "cycleWithFlagChoice1" ["C"] (solverSuccess [("C", 1), ("E", 1)])
, runTest $ mkTest db15 "cycleThroughSetupDep1" ["A"] anySolverFailure
, runTest $ mkTest db15 "cycleThroughSetupDep2" ["B"] anySolverFailure
, runTest $ mkTest db15 "cycleThroughSetupDep3" ["C"] (solverSuccess [("C", 2), ("D", 1)])
, runTest $ mkTest db15 "cycleThroughSetupDep4" ["D"] (solverSuccess [("D", 1)])
, runTest $ mkTest db15 "cycleThroughSetupDep5" ["E"] (solverSuccess [("C", 2), ("D", 1), ("E", 1)])
, runTest $ issue4161 "detect cycle between package and its setup script"
, runTest $ testCyclicDependencyErrorMessages "cyclic dependency error messages"
]
, testGroup "Extensions" [
runTest $ mkTestExts [EnableExtension CPP] dbExts1 "unsupported" ["A"] anySolverFailure
, runTest $ mkTestExts [EnableExtension CPP] dbExts1 "unsupportedIndirect" ["B"] anySolverFailure
, runTest $ mkTestExts [EnableExtension RankNTypes] dbExts1 "supported" ["A"] (solverSuccess [("A",1)])
, runTest $ mkTestExts (map EnableExtension [CPP,RankNTypes]) dbExts1 "supportedIndirect" ["C"] (solverSuccess [("A",1),("B",1), ("C",1)])
, runTest $ mkTestExts [EnableExtension CPP] dbExts1 "disabledExtension" ["D"] anySolverFailure
, runTest $ mkTestExts (map EnableExtension [CPP,RankNTypes]) dbExts1 "disabledExtension" ["D"] anySolverFailure
, runTest $ mkTestExts (UnknownExtension "custom" : map EnableExtension [CPP,RankNTypes]) dbExts1 "supportedUnknown" ["E"] (solverSuccess [("A",1),("B",1),("C",1),("E",1)])
]
, testGroup "Languages" [
runTest $ mkTestLangs [Haskell98] dbLangs1 "unsupported" ["A"] anySolverFailure
, runTest $ mkTestLangs [Haskell98,Haskell2010] dbLangs1 "supported" ["A"] (solverSuccess [("A",1)])
, runTest $ mkTestLangs [Haskell98] dbLangs1 "unsupportedIndirect" ["B"] anySolverFailure
, runTest $ mkTestLangs [Haskell98, Haskell2010, UnknownLanguage "Haskell3000"] dbLangs1 "supportedUnknown" ["C"] (solverSuccess [("A",1),("B",1),("C",1)])
]
, testGroup "Qualified Package Constraints" [
runTest $ mkTest dbConstraints "install latest versions without constraints" ["A", "B", "C"] $
solverSuccess [("A", 7), ("B", 8), ("C", 9), ("D", 7), ("D", 8), ("D", 9)]
, let cs = [ ExVersionConstraint (ScopeAnyQualifier "D") $ mkVersionRange 1 4 ]
in runTest $ constraints cs $
mkTest dbConstraints "force older versions with unqualified constraint" ["A", "B", "C"] $
solverSuccess [("A", 1), ("B", 2), ("C", 3), ("D", 1), ("D", 2), ("D", 3)]
, let cs = [ ExVersionConstraint (ScopeQualified P.QualToplevel "D") $ mkVersionRange 1 4
, ExVersionConstraint (ScopeQualified (P.QualSetup "B") "D") $ mkVersionRange 4 7
]
in runTest $ constraints cs $
mkTest dbConstraints "force multiple versions with qualified constraints" ["A", "B", "C"] $
solverSuccess [("A", 1), ("B", 5), ("C", 9), ("D", 1), ("D", 5), ("D", 9)]
, let cs = [ ExVersionConstraint (ScopeAnySetupQualifier "D") $ mkVersionRange 1 4 ]
in runTest $ constraints cs $
mkTest dbConstraints "constrain package across setup scripts" ["A", "B", "C"] $
solverSuccess [("A", 7), ("B", 2), ("C", 3), ("D", 2), ("D", 3), ("D", 7)]
]
, testGroup "Package Preferences" [
runTest $ preferences [ ExPkgPref "A" $ mkvrThis 1] $ mkTest db13 "selectPreferredVersionSimple" ["A"] (solverSuccess [("A", 1)])
, runTest $ preferences [ ExPkgPref "A" $ mkvrOrEarlier 2] $ mkTest db13 "selectPreferredVersionSimple2" ["A"] (solverSuccess [("A", 2)])
, runTest $ preferences [ ExPkgPref "A" $ mkvrOrEarlier 2
, ExPkgPref "A" $ mkvrOrEarlier 1] $ mkTest db13 "selectPreferredVersionMultiple" ["A"] (solverSuccess [("A", 1)])
, runTest $ preferences [ ExPkgPref "A" $ mkvrOrEarlier 1
, ExPkgPref "A" $ mkvrOrEarlier 2] $ mkTest db13 "selectPreferredVersionMultiple2" ["A"] (solverSuccess [("A", 1)])
, runTest $ preferences [ ExPkgPref "A" $ mkvrThis 1
, ExPkgPref "A" $ mkvrThis 2] $ mkTest db13 "selectPreferredVersionMultiple3" ["A"] (solverSuccess [("A", 2)])
, runTest $ preferences [ ExPkgPref "A" $ mkvrThis 1
, ExPkgPref "A" $ mkvrOrEarlier 2] $ mkTest db13 "selectPreferredVersionMultiple4" ["A"] (solverSuccess [("A", 1)])
]
, testGroup "Stanza Preferences" [
runTest $
mkTest dbStanzaPreferences1 "disable tests by default" ["pkg"] $
solverSuccess [("pkg", 1)]
, runTest $ preferences [ExStanzaPref "pkg" [TestStanzas]] $
mkTest dbStanzaPreferences1 "enable tests with testing preference" ["pkg"] $
solverSuccess [("pkg", 1), ("test-dep", 1)]
, runTest $ preferences [ExStanzaPref "pkg" [TestStanzas]] $
mkTest dbStanzaPreferences2 "disable testing when it's not possible" ["pkg"] $
solverSuccess [("pkg", 1)]
, testStanzaPreference "test stanza preference"
]
, testGroup "Buildable Field" [
testBuildable "avoid building component with unknown dependency" (ExAny "unknown")
, testBuildable "avoid building component with unknown extension" (ExExt (UnknownExtension "unknown"))
, testBuildable "avoid building component with unknown language" (ExLang (UnknownLanguage "unknown"))
, runTest $ mkTest dbBuildable1 "choose flags that set buildable to false" ["pkg"] (solverSuccess [("flag1-false", 1), ("flag2-true", 1), ("pkg", 1)])
, runTest $ mkTest dbBuildable2 "choose version that sets buildable to false" ["A"] (solverSuccess [("A", 1), ("B", 2)])
]
, testGroup "Pkg-config dependencies" [
runTest $ mkTestPCDepends [] dbPC1 "noPkgs" ["A"] anySolverFailure
, runTest $ mkTestPCDepends [("pkgA", "0")] dbPC1 "tooOld" ["A"] anySolverFailure
, runTest $ mkTestPCDepends [("pkgA", "1.0.0"), ("pkgB", "1.0.0")] dbPC1 "pruneNotFound" ["C"] (solverSuccess [("A", 1), ("B", 1), ("C", 1)])
, runTest $ mkTestPCDepends [("pkgA", "1.0.0"), ("pkgB", "2.0.0")] dbPC1 "chooseNewest" ["C"] (solverSuccess [("A", 1), ("B", 2), ("C", 1)])
]
, testGroup "Independent goals" [
runTest $ indep $ mkTest db16 "indepGoals1" ["A", "B"] (solverSuccess [("A", 1), ("B", 1), ("C", 1), ("D", 1), ("D", 2), ("E", 1)])
, runTest $ testIndepGoals2 "indepGoals2"
, runTest $ testIndepGoals3 "indepGoals3"
, runTest $ testIndepGoals4 "indepGoals4"
, runTest $ testIndepGoals5 "indepGoals5 - fixed goal order" FixedGoalOrder
, runTest $ testIndepGoals5 "indepGoals5 - default goal order" DefaultGoalOrder
, runTest $ testIndepGoals6 "indepGoals6 - fixed goal order" FixedGoalOrder
, runTest $ testIndepGoals6 "indepGoals6 - default goal order" DefaultGoalOrder
]
-- Tests designed for the backjumping blog post
, testGroup "Backjumping" [
runTest $ mkTest dbBJ1a "bj1a" ["A"] (solverSuccess [("A", 1), ("B", 1)])
, runTest $ mkTest dbBJ1b "bj1b" ["A"] (solverSuccess [("A", 1), ("B", 1)])
, runTest $ mkTest dbBJ1c "bj1c" ["A"] (solverSuccess [("A", 1), ("B", 1)])
, runTest $ mkTest dbBJ2 "bj2" ["A"] (solverSuccess [("A", 1), ("B", 1), ("C", 1)])
, runTest $ mkTest dbBJ3 "bj3" ["A"] (solverSuccess [("A", 1), ("Ba", 1), ("C", 1)])
, runTest $ mkTest dbBJ4 "bj4" ["A"] (solverSuccess [("A", 1), ("B", 1), ("C", 1)])
, runTest $ mkTest dbBJ5 "bj5" ["A"] (solverSuccess [("A", 1), ("B", 1), ("D", 1)])
, runTest $ mkTest dbBJ6 "bj6" ["A"] (solverSuccess [("A", 1), ("B", 1)])
, runTest $ mkTest dbBJ7 "bj7" ["A"] (solverSuccess [("A", 1), ("B", 1), ("C", 1)])
, runTest $ indep $ mkTest dbBJ8 "bj8" ["A", "B"] (solverSuccess [("A", 1), ("B", 1), ("C", 1)])
]
, testGroup "main library dependencies" [
let db = [Right $ exAvNoLibrary "A" 1 `withExe` exExe "exe" []]
in runTest $ mkTest db "install build target without a library" ["A"] $
solverSuccess [("A", 1)]
, let db = [ Right $ exAv "A" 1 [ExAny "B"]
, Right $ exAvNoLibrary "B" 1 `withExe` exExe "exe" [] ]
in runTest $ mkTest db "reject build-depends dependency with no library" ["A"] $
solverFailure (isInfixOf "rejecting: B-1.0.0 (does not contain library, which is required by A)")
, let exe = exExe "exe" []
db = [ Right $ exAv "A" 1 [ExAny "B"]
, Right $ exAvNoLibrary "B" 2 `withExe` exe
, Right $ exAv "B" 1 [] `withExe` exe ]
in runTest $ mkTest db "choose version of build-depends dependency that has a library" ["A"] $
solverSuccess [("A", 1), ("B", 1)]
]
, testGroup "sub-library dependencies" [
let db = [ Right $ exAv "A" 1 [ExSubLibAny "B" "sub-lib"]
, Right $ exAv "B" 1 [] ]
in runTest $
mkTest db "reject package that is missing required sub-library" ["A"] $
solverFailure $ isInfixOf $
"rejecting: B-1.0.0 (does not contain library 'sub-lib', which is required by A)"
, let db = [ Right $ exAv "A" 1 [ExSubLibAny "B" "sub-lib"]
, Right $ exAvNoLibrary "B" 1 `withSubLibrary` exSubLib "sub-lib" [] ]
in runTest $
mkTest db "reject package with private but required sub-library" ["A"] $
solverFailure $ isInfixOf $
"rejecting: B-1.0.0 (library 'sub-lib' is private, but it is required by A)"
, let db = [ Right $ exAv "A" 1 [ExSubLibAny "B" "sub-lib"]
, Right $ exAvNoLibrary "B" 1
`withSubLibrary` exSubLib "sub-lib" [ExFlagged "make-lib-private" (dependencies []) publicDependencies] ]
in runTest $ constraints [ExFlagConstraint (ScopeAnyQualifier "B") "make-lib-private" True] $
mkTest db "reject package with sub-library made private by flag constraint" ["A"] $
solverFailure $ isInfixOf $
"rejecting: B-1.0.0 (library 'sub-lib' is private, but it is required by A)"
, let db = [ Right $ exAv "A" 1 [ExSubLibAny "B" "sub-lib"]
, Right $ exAvNoLibrary "B" 1
`withSubLibrary` exSubLib "sub-lib" [ExFlagged "make-lib-private" (dependencies []) publicDependencies] ]
in runTest $
mkTest db "treat sub-library as visible even though flag choice could make it private" ["A"] $
solverSuccess [("A", 1), ("B", 1)]
, let db = [ Right $ exAv "A" 1 [ExAny "B"]
, Right $ exAv "B" 1 [] `withSubLibrary` exSubLib "sub-lib" []
, Right $ exAv "C" 1 [ExSubLibAny "B" "sub-lib"] ]
goals :: [ExampleVar]
goals = [
P QualNone "A"
, P QualNone "B"
, P QualNone "C"
]
in runTest $ goalOrder goals $
mkTest db "reject package that requires a private sub-library" ["A", "C"] $
solverFailure $ isInfixOf $
"rejecting: C-1.0.0 (requires library 'sub-lib' from B, but the component is private)"
, let db = [ Right $ exAv "A" 1 [ExSubLibAny "B" "sub-lib-v1"]
, Right $ exAv "B" 2 [] `withSubLibrary` ExSubLib "sub-lib-v2" publicDependencies
, Right $ exAv "B" 1 [] `withSubLibrary` ExSubLib "sub-lib-v1" publicDependencies ]
in runTest $ mkTest db "choose version of package containing correct sub-library" ["A"] $
solverSuccess [("A", 1), ("B", 1)]
, let db = [ Right $ exAv "A" 1 [ExSubLibAny "B" "sub-lib"]
, Right $ exAv "B" 2 [] `withSubLibrary` ExSubLib "sub-lib" (dependencies [])
, Right $ exAv "B" 1 [] `withSubLibrary` ExSubLib "sub-lib" publicDependencies ]
in runTest $ mkTest db "choose version of package with public sub-library" ["A"] $
solverSuccess [("A", 1), ("B", 1)]
]
-- build-tool-depends dependencies
, testGroup "build-tool-depends" [
runTest $ mkTest dbBuildTools "simple exe dependency" ["A"] (solverSuccess [("A", 1), ("bt-pkg", 2)])
, runTest $ disableSolveExecutables $
mkTest dbBuildTools "don't install build tool packages in legacy mode" ["A"] (solverSuccess [("A", 1)])
, runTest $ mkTest dbBuildTools "flagged exe dependency" ["B"] (solverSuccess [("B", 1), ("bt-pkg", 2)])
, runTest $ enableAllTests $
mkTest dbBuildTools "test suite exe dependency" ["C"] (solverSuccess [("C", 1), ("bt-pkg", 2)])
, runTest $ mkTest dbBuildTools "unknown exe" ["D"] $
solverFailure (isInfixOf "does not contain executable 'unknown-exe', which is required by D")
, runTest $ disableSolveExecutables $
mkTest dbBuildTools "don't check for build tool executables in legacy mode" ["D"] $ solverSuccess [("D", 1)]
, runTest $ mkTest dbBuildTools "unknown build tools package error mentions package, not exe" ["E"] $
solverFailure (isInfixOf "unknown package: E:unknown-pkg:exe.unknown-pkg (dependency of E)")
, runTest $ mkTest dbBuildTools "unknown flagged exe" ["F"] $
solverFailure (isInfixOf "does not contain executable 'unknown-exe', which is required by F +flagF")
, runTest $ enableAllTests $ mkTest dbBuildTools "unknown test suite exe" ["G"] $
solverFailure (isInfixOf "does not contain executable 'unknown-exe', which is required by G *test")
, runTest $ mkTest dbBuildTools "wrong exe for build tool package version" ["H"] $
solverFailure $ isInfixOf $
-- The solver reports the version conflict when a version conflict
-- and an executable conflict apply to the same package version.
"[__1] rejecting: H:bt-pkg:exe.bt-pkg-4.0.0 (conflict: H => H:bt-pkg:exe.bt-pkg (exe exe1)==3.0.0)\n"
++ "[__1] rejecting: H:bt-pkg:exe.bt-pkg-3.0.0 (does not contain executable 'exe1', which is required by H)\n"
++ "[__1] rejecting: H:bt-pkg:exe.bt-pkg-2.0.0 (conflict: H => H:bt-pkg:exe.bt-pkg (exe exe1)==3.0.0)"
, runTest $ chooseExeAfterBuildToolsPackage True "choose exe after choosing its package - success"
, runTest $ chooseExeAfterBuildToolsPackage False "choose exe after choosing its package - failure"
, runTest $ rejectInstalledBuildToolPackage "reject installed package for build-tool dependency"
, runTest $ requireConsistentBuildToolVersions "build tool versions must be consistent within one package"
]
-- build-tools dependencies
, testGroup "legacy build-tools" [
runTest $ mkTest dbLegacyBuildTools1 "bt1" ["A"] (solverSuccess [("A", 1), ("alex", 1)])
, runTest $ disableSolveExecutables $
mkTest dbLegacyBuildTools1 "bt1 - don't install build tool packages in legacy mode" ["A"] (solverSuccess [("A", 1)])
, runTest $ mkTest dbLegacyBuildTools2 "bt2" ["A"] $
solverFailure (isInfixOf "does not contain executable 'alex', which is required by A")
, runTest $ disableSolveExecutables $
mkTest dbLegacyBuildTools2 "bt2 - don't check for build tool executables in legacy mode" ["A"] (solverSuccess [("A", 1)])
, runTest $ mkTest dbLegacyBuildTools3 "bt3" ["A"] (solverSuccess [("A", 1)])
, runTest $ mkTest dbLegacyBuildTools4 "bt4" ["C"] (solverSuccess [("A", 1), ("B", 1), ("C", 1), ("alex", 1), ("alex", 2)])
, runTest $ mkTest dbLegacyBuildTools5 "bt5" ["B"] (solverSuccess [("A", 1), ("A", 2), ("B", 1), ("alex", 1)])
, runTest $ mkTest dbLegacyBuildTools6 "bt6" ["A"] (solverSuccess [("A", 1), ("alex", 1), ("happy", 1)])
]
-- internal dependencies
, testGroup "internal dependencies" [
runTest $ mkTest dbIssue3775 "issue #3775" ["B"] (solverSuccess [("A", 2), ("B", 2), ("warp", 1)])
]
-- tests for partial fix for issue #5325
, testGroup "Components that are unbuildable in the current environment" $
let flagConstraint = ExFlagConstraint . ScopeAnyQualifier
in [
let db = [ Right $ exAv "A" 1 [ExFlagged "build-lib" (dependencies []) unbuildableDependencies] ]
in runTest $ constraints [flagConstraint "A" "build-lib" False] $
mkTest db "install unbuildable library" ["A"] $
solverSuccess [("A", 1)]
, let db = [ Right $ exAvNoLibrary "A" 1
`withExe` exExe "exe" [ExFlagged "build-exe" (dependencies []) unbuildableDependencies] ]
in runTest $ constraints [flagConstraint "A" "build-exe" False] $
mkTest db "install unbuildable exe" ["A"] $
solverSuccess [("A", 1)]
, let db = [ Right $ exAv "A" 1 [ExAny "B"]
, Right $ exAv "B" 1 [ExFlagged "build-lib" (dependencies []) unbuildableDependencies] ]
in runTest $ constraints [flagConstraint "B" "build-lib" False] $
mkTest db "reject library dependency with unbuildable library" ["A"] $
solverFailure $ isInfixOf $
"rejecting: B-1.0.0 (library is not buildable in the "
++ "current environment, but it is required by A)"
, let db = [ Right $ exAv "A" 1 [ExBuildToolAny "B" "bt"]
, Right $ exAv "B" 1 [ExFlagged "build-lib" (dependencies []) unbuildableDependencies]
`withExe` exExe "bt" [] ]
in runTest $ constraints [flagConstraint "B" "build-lib" False] $
mkTest db "allow build-tool dependency with unbuildable library" ["A"] $
solverSuccess [("A", 1), ("B", 1)]
, let db = [ Right $ exAv "A" 1 [ExBuildToolAny "B" "bt"]
, Right $ exAv "B" 1 []
`withExe` exExe "bt" [ExFlagged "build-exe" (dependencies []) unbuildableDependencies] ]
in runTest $ constraints [flagConstraint "B" "build-exe" False] $
mkTest db "reject build-tool dependency with unbuildable exe" ["A"] $
solverFailure $ isInfixOf $
"rejecting: A:B:exe.B-1.0.0 (executable 'bt' is not "
++ "buildable in the current environment, but it is required by A)"
, runTest $
chooseUnbuildableExeAfterBuildToolsPackage
"choose unbuildable exe after choosing its package"
]
, testGroup "--fine-grained-conflicts" [
-- Skipping a version because of a problematic dependency:
--
-- When the solver explores A-4, it finds that it cannot satisfy B's
-- dependencies. This allows the solver to skip the subsequent
-- versions of A that also depend on B.
runTest $
let db = [
Right $ exAv "A" 4 [ExAny "B"]
, Right $ exAv "A" 3 [ExAny "B"]
, Right $ exAv "A" 2 [ExAny "B"]
, Right $ exAv "A" 1 []
, Right $ exAv "B" 2 [ExAny "unknown1"]
, Right $ exAv "B" 1 [ExAny "unknown2"]
]
msg = [
"[__0] trying: A-4.0.0 (user goal)"
, "[__1] trying: B-2.0.0 (dependency of A)"
, "[__2] unknown package: unknown1 (dependency of B)"
, "[__2] fail (backjumping, conflict set: B, unknown1)"
, "[__1] trying: B-1.0.0"
, "[__2] unknown package: unknown2 (dependency of B)"
, "[__2] fail (backjumping, conflict set: B, unknown2)"
, "[__1] fail (backjumping, conflict set: A, B, unknown1, unknown2)"
, "[__0] skipping: A-3.0.0, A-2.0.0 (has the same characteristics that "
++ "caused the previous version to fail: depends on 'B')"
, "[__0] trying: A-1.0.0"
, "[__1] done"
]
in setVerbose $
mkTest db "skip version due to problematic dependency" ["A"] $
SolverResult (isInfixOf msg) $ Right [("A", 1)]
, -- Skipping a version because of a restrictive constraint on a
-- dependency:
--
-- The solver rejects A-4 because its constraint on B excludes B-1.
-- Then the solver is able to skip A-3 and A-2 because they also
-- exclude B-1, even though they don't have the exact same constraints
-- on B.
runTest $
let db = [
Right $ exAv "A" 4 [ExFix "B" 14]
, Right $ exAv "A" 3 [ExFix "B" 13]
, Right $ exAv "A" 2 [ExFix "B" 12]
, Right $ exAv "A" 1 [ExFix "B" 11]
, Right $ exAv "B" 11 []
]
msg = [
"[__0] trying: A-4.0.0 (user goal)"
, "[__1] next goal: B (dependency of A)"
, "[__1] rejecting: B-11.0.0 (conflict: A => B==14.0.0)"
, "[__1] fail (backjumping, conflict set: A, B)"
, "[__0] skipping: A-3.0.0, A-2.0.0 (has the same characteristics that "
++ "caused the previous version to fail: depends on 'B' but excludes "
++ "version 11.0.0)"
, "[__0] trying: A-1.0.0"
, "[__1] next goal: B (dependency of A)"
, "[__1] trying: B-11.0.0"
, "[__2] done"
]
in setVerbose $
mkTest db "skip version due to restrictive constraint on its dependency" ["A"] $
SolverResult (isInfixOf msg) $ Right [("A", 1), ("B", 11)]
, -- This test tests the case where the solver chooses a version for one
-- package, B, before choosing a version for one of its reverse
-- dependencies, C. While the solver is exploring the subtree rooted
-- at B-3, it finds that C-2's dependency on B conflicts with B-3.
-- Then the solver is able to skip C-1, because it also excludes B-3.
--
-- --fine-grained-conflicts could have a benefit in this case even
-- though the solver would have found the conflict between B-3 and C-1
-- immediately after trying C-1 anyway. It prevents C-1 from
-- introducing any other conflicts which could increase the size of
-- the conflict set.
runTest $
let db = [
Right $ exAv "A" 1 [ExAny "B", ExAny "C"]
, Right $ exAv "B" 3 []
, Right $ exAv "B" 2 []
, Right $ exAv "B" 1 []
, Right $ exAv "C" 2 [ExFix "B" 2]
, Right $ exAv "C" 1 [ExFix "B" 1]
]
goals = [P QualNone pkg | pkg <- ["A", "B", "C"]]
expectedMsg = [
"[__0] trying: A-1.0.0 (user goal)"
, "[__1] trying: B-3.0.0 (dependency of A)"
, "[__2] next goal: C (dependency of A)"
, "[__2] rejecting: C-2.0.0 (conflict: B==3.0.0, C => B==2.0.0)"
, "[__2] skipping: C-1.0.0 (has the same characteristics that caused the "
++ "previous version to fail: excludes 'B' version 3.0.0)"
, "[__2] fail (backjumping, conflict set: A, B, C)"
, "[__1] trying: B-2.0.0"
, "[__2] next goal: C (dependency of A)"
, "[__2] trying: C-2.0.0"
, "[__3] done"
]
in setVerbose $ goalOrder goals $
mkTest db "skip version that excludes dependency that was already chosen" ["A"] $
SolverResult (isInfixOf expectedMsg) $ Right [("A", 1), ("B", 2), ("C", 2)]
, -- This test tests how the solver merges conflicts when it has
-- multiple reasons to add a variable to the conflict set. In this
-- case, package A conflicts with B and C. The solver should take the
-- union of the conflicts and then only skip a version if it does not
-- resolve any of the conflicts.
--
-- The solver rejects A-3 because it can't find consistent versions for
-- its two dependencies, B and C. Then it skips A-2 because A-2 also
-- depends on B and C. This test ensures that the solver considers
-- A-1 even though A-1 only resolves one of the conflicts (A-1 removes
-- the dependency on C).
runTest $
let db = [
Right $ exAv "A" 3 [ExAny "B", ExAny "C"]
, Right $ exAv "A" 2 [ExAny "B", ExAny "C"]
, Right $ exAv "A" 1 [ExAny "B"]
, Right $ exAv "B" 1 [ExFix "D" 1]
, Right $ exAv "C" 1 [ExFix "D" 2]
, Right $ exAv "D" 1 []
, Right $ exAv "D" 2 []
]
goals = [P QualNone pkg | pkg <- ["A", "B", "C", "D"]]
msg = [
"[__0] trying: A-3.0.0 (user goal)"
, "[__1] trying: B-1.0.0 (dependency of A)"
, "[__2] trying: C-1.0.0 (dependency of A)"
, "[__3] next goal: D (dependency of B)"
, "[__3] rejecting: D-2.0.0 (conflict: B => D==1.0.0)"
, "[__3] rejecting: D-1.0.0 (conflict: C => D==2.0.0)"
, "[__3] fail (backjumping, conflict set: B, C, D)"
, "[__2] fail (backjumping, conflict set: A, B, C, D)"
, "[__1] fail (backjumping, conflict set: A, B, C, D)"
, "[__0] skipping: A-2.0.0 (has the same characteristics that caused the "
++ "previous version to fail: depends on 'B'; depends on 'C')"
, "[__0] trying: A-1.0.0"
, "[__1] trying: B-1.0.0 (dependency of A)"
, "[__2] next goal: D (dependency of B)"
, "[__2] rejecting: D-2.0.0 (conflict: B => D==1.0.0)"
, "[__2] trying: D-1.0.0"
, "[__3] done"
]
in setVerbose $ goalOrder goals $
mkTest db "only skip a version if it resolves none of the previous conflicts" ["A"] $
SolverResult (isInfixOf msg) $ Right [("A", 1), ("B", 1), ("D", 1)]
, -- This test ensures that the solver log doesn't show all conflicts
-- that the solver encountered in a subtree. The solver should only
-- show the conflicts that are contained in the current conflict set.
--
-- The goal order forces the solver to try A-4, encounter a conflict
-- with B-2, try B-1, and then try C. A-4 conflicts with the only
-- version of C, so the solver backjumps with a conflict set of
-- {A, C}. When the solver skips the next version of A, the log should
-- mention the conflict with C but not B.
runTest $
let db = [
Right $ exAv "A" 4 [ExFix "B" 1, ExFix "C" 1]
, Right $ exAv "A" 3 [ExFix "B" 1, ExFix "C" 1]
, Right $ exAv "A" 2 [ExFix "C" 1]
, Right $ exAv "A" 1 [ExFix "C" 2]
, Right $ exAv "B" 2 []
, Right $ exAv "B" 1 []
, Right $ exAv "C" 2 []
]
goals = [P QualNone pkg | pkg <- ["A", "B", "C"]]
msg = [
"[__0] trying: A-4.0.0 (user goal)"
, "[__1] next goal: B (dependency of A)"
, "[__1] rejecting: B-2.0.0 (conflict: A => B==1.0.0)"
, "[__1] trying: B-1.0.0"
, "[__2] next goal: C (dependency of A)"
, "[__2] rejecting: C-2.0.0 (conflict: A => C==1.0.0)"
, "[__2] fail (backjumping, conflict set: A, C)"
, "[__0] skipping: A-3.0.0, A-2.0.0 (has the same characteristics that caused the "
++ "previous version to fail: depends on 'C' but excludes version 2.0.0)"
, "[__0] trying: A-1.0.0"
, "[__1] next goal: C (dependency of A)"
, "[__1] trying: C-2.0.0"
, "[__2] done"
]
in setVerbose $ goalOrder goals $
mkTest db "don't show conflicts that aren't part of the conflict set" ["A"] $
SolverResult (isInfixOf msg) $ Right [("A", 1), ("C", 2)]
, -- Tests that the conflict set is properly updated when a version is
-- skipped due to being excluded by one of its reverse dependencies'
-- constraints.
runTest $
let db = [
Right $ exAv "A" 2 [ExFix "B" 3]
, Right $ exAv "A" 1 [ExFix "B" 1]
, Right $ exAv "B" 2 []
, Right $ exAv "B" 1 []
]
msg = [
"[__0] trying: A-2.0.0 (user goal)"
, "[__1] next goal: B (dependency of A)"
-- During this step, the solver adds A and B to the
-- conflict set, with the details of each package's
-- conflict:
--
-- A: A's constraint rejected B-2.
-- B: B was rejected by A's B==3 constraint
, "[__1] rejecting: B-2.0.0 (conflict: A => B==3.0.0)"
-- When the solver skips B-1, it cannot simply reuse the
-- previous conflict set. It also needs to update A's
-- entry to say that A also rejected B-1. Otherwise, the
-- solver wouldn't know that A-1 could resolve one of
-- the conflicts encountered while exploring A-2. The
-- solver would skip A-1, even though it leads to the
-- solution.
, "[__1] skipping: B-1.0.0 (has the same characteristics that caused "
++ "the previous version to fail: excluded by constraint '==3.0.0' from 'A')"
, "[__1] fail (backjumping, conflict set: A, B)"
, "[__0] trying: A-1.0.0"
, "[__1] next goal: B (dependency of A)"
, "[__1] rejecting: B-2.0.0 (conflict: A => B==1.0.0)"
, "[__1] trying: B-1.0.0"
, "[__2] done"
]
in setVerbose $
mkTest db "update conflict set after skipping version - 1" ["A"] $
SolverResult (isInfixOf msg) $ Right [("A", 1), ("B", 1)]
, -- Tests that the conflict set is properly updated when a version is
-- skipped due to excluding a version of one of its dependencies.
-- This test is similar the previous one, with the goal order reversed.
runTest $
let db = [
Right $ exAv "A" 2 []
, Right $ exAv "A" 1 []
, Right $ exAv "B" 2 [ExFix "A" 3]
, Right $ exAv "B" 1 [ExFix "A" 1]
]
goals = [P QualNone pkg | pkg <- ["A", "B"]]
msg = [
"[__0] trying: A-2.0.0 (user goal)"
, "[__1] next goal: B (user goal)"
, "[__1] rejecting: B-2.0.0 (conflict: A==2.0.0, B => A==3.0.0)"
, "[__1] skipping: B-1.0.0 (has the same characteristics that caused "
++ "the previous version to fail: excludes 'A' version 2.0.0)"
, "[__1] fail (backjumping, conflict set: A, B)"
, "[__0] trying: A-1.0.0"
, "[__1] next goal: B (user goal)"
, "[__1] rejecting: B-2.0.0 (conflict: A==1.0.0, B => A==3.0.0)"
, "[__1] trying: B-1.0.0"
, "[__2] done"
]
in setVerbose $ goalOrder goals $
mkTest db "update conflict set after skipping version - 2" ["A", "B"] $
SolverResult (isInfixOf msg) $ Right [("A", 1), ("B", 1)]
]
-- Tests for the contents of the solver's log
, testGroup "Solver log" [
-- See issue #3203. The solver should only choose a version for A once.
runTest $
let db = [Right $ exAv "A" 1 []]
p :: [String] -> Bool
p lg = elem "targets: A" lg
&& length (filter ("trying: A" `isInfixOf`) lg) == 1
in setVerbose $ mkTest db "deduplicate targets" ["A", "A"] $
SolverResult p $ Right [("A", 1)]
, runTest $
let db = [Right $ exAv "A" 1 [ExAny "B"]]
msg = "After searching the rest of the dependency tree exhaustively, "
++ "these were the goals I've had most trouble fulfilling: A, B"
in mkTest db "exhaustive search failure message" ["A"] $
solverFailure (isInfixOf msg)
, testSummarizedLog "show conflicts from final conflict set after exhaustive search" Nothing $
"Could not resolve dependencies:\n"
++ "[__0] trying: A-1.0.0 (user goal)\n"
++ "[__1] unknown package: F (dependency of A)\n"
++ "[__1] fail (backjumping, conflict set: A, F)\n"
++ "After searching the rest of the dependency tree exhaustively, "
++ "these were the goals I've had most trouble fulfilling: A, F"
, testSummarizedLog "show first conflicts after inexhaustive search" (Just 3) $
"Could not resolve dependencies:\n"
++ "[__0] trying: A-1.0.0 (user goal)\n"
++ "[__1] trying: B-3.0.0 (dependency of A)\n"
++ "[__2] unknown package: C (dependency of B)\n"
++ "[__2] fail (backjumping, conflict set: B, C)\n"
++ "Backjump limit reached (currently 3, change with --max-backjumps "
++ "or try to run with --reorder-goals).\n"
, testSummarizedLog "don't show summarized log when backjump limit is too low" (Just 1) $
"Backjump limit reached (currently 1, change with --max-backjumps "
++ "or try to run with --reorder-goals).\n"
++ "Failed to generate a summarized dependency solver log due to low backjump limit."
, testMinimizeConflictSet
"minimize conflict set with --minimize-conflict-set"
, testNoMinimizeConflictSet
"show original conflict set with --no-minimize-conflict-set"
, runTest $
let db = [ Right $ exAv "my-package" 1 [ExFix "other-package" 3]
, Left $ exInst "other-package" 2 "other-package-2.0.0" []]
msg = "rejecting: other-package-2.0.0/installed-2.0.0"
in mkTest db "show full installed package version (issue #5892)" ["my-package"] $
solverFailure (isInfixOf msg)
, runTest $
let db = [ Right $ exAv "my-package" 1 [ExFix "other-package" 3]
, Left $ exInst "other-package" 2 "other-package-AbCdEfGhIj0123456789" [] ]
msg = "rejecting: other-package-2.0.0/installed-AbCdEfGhIj0123456789"
in mkTest db "show full installed package ABI hash (issue #5892)" ["my-package"] $
solverFailure (isInfixOf msg)
]
]
where
indep = independentGoals
mkvrThis = V.thisVersion . makeV
mkvrOrEarlier = V.orEarlierVersion . makeV
makeV v = V.mkVersion [v,0,0]
data GoalOrder = FixedGoalOrder | DefaultGoalOrder
{-------------------------------------------------------------------------------
Specific example database for the tests
-------------------------------------------------------------------------------}
db1 :: ExampleDb
db1 =
let a = exInst "A" 1 "A-1" []
in [ Left a
, Right $ exAv "B" 1 [ExAny "A"]
, Right $ exAv "B" 2 [ExAny "A"]
, Right $ exAv "C" 1 [ExFix "B" 1]
, Right $ exAv "D" 1 [ExFix "B" 2]
, Right $ exAv "E" 1 [ExAny "B"]
, Right $ exAv "F" 1 [ExFix "B" 1, ExAny "E"]
, Right $ exAv "G" 1 [ExFix "B" 2, ExAny "E"]
, Right $ exAv "Z" 1 []
]
-- In this example, we _can_ install C and D as independent goals, but we have
-- to pick two different versions for B (arbitrarily)
db2 :: ExampleDb
db2 = [
Right $ exAv "A" 1 []
, Right $ exAv "A" 2 []
, Right $ exAv "B" 1 [ExAny "A"]
, Right $ exAv "B" 2 [ExAny "A"]
, Right $ exAv "C" 1 [ExAny "B", ExFix "A" 1]
, Right $ exAv "D" 1 [ExAny "B", ExFix "A" 2]
]
db3 :: ExampleDb
db3 = [
Right $ exAv "A" 1 []
, Right $ exAv "A" 2 []
, Right $ exAv "B" 1 [exFlagged "flagB" [ExFix "A" 1] [ExFix "A" 2]]
, Right $ exAv "C" 1 [ExFix "A" 1, ExAny "B"]
, Right $ exAv "D" 1 [ExFix "A" 2, ExAny "B"]
]
-- | Like db3, but the flag picks a different package rather than a
-- different package version
--
-- In db3 we cannot install C and D as independent goals because:
--
-- * The multiple instance restriction says C and D _must_ share B
-- * Since C relies on A-1, C needs B to be compiled with flagB on
-- * Since D relies on A-2, D needs B to be compiled with flagB off
-- * Hence C and D have incompatible requirements on B's flags.
--
-- However, _even_ if we don't check explicitly that we pick the same flag
-- assignment for 0.B and 1.B, we will still detect the problem because
-- 0.B depends on 0.A-1, 1.B depends on 1.A-2, hence we cannot link 0.A to
-- 1.A and therefore we cannot link 0.B to 1.B.
--
-- In db4 the situation however is trickier. We again cannot install
-- packages C and D as independent goals because:
--
-- * As above, the multiple instance restriction says that C and D _must_ share B
-- * Since C relies on Ax-2, it requires B to be compiled with flagB off
-- * Since D relies on Ay-2, it requires B to be compiled with flagB on
-- * Hence C and D have incompatible requirements on B's flags.
--
-- But now this requirement is more indirect. If we only check dependencies
-- we don't see the problem:
--
-- * We link 0.B to 1.B
-- * 0.B relies on Ay-1
-- * 1.B relies on Ax-1
--
-- We will insist that 0.Ay will be linked to 1.Ay, and 0.Ax to 1.Ax, but since
-- we only ever assign to one of these, these constraints are never broken.
db4 :: ExampleDb
db4 = [
Right $ exAv "Ax" 1 []
, Right $ exAv "Ax" 2 []
, Right $ exAv "Ay" 1 []
, Right $ exAv "Ay" 2 []
, Right $ exAv "B" 1 [exFlagged "flagB" [ExFix "Ax" 1] [ExFix "Ay" 1]]
, Right $ exAv "C" 1 [ExFix "Ax" 2, ExAny "B"]
, Right $ exAv "D" 1 [ExFix "Ay" 2, ExAny "B"]
]
-- | Simple database containing one package with a manual flag.
dbManualFlags :: ExampleDb
dbManualFlags = [
Right $ declareFlags [ExFlag "flag" True Manual] $
exAv "pkg" 1 [exFlagged "flag" [ExAny "true-dep"] [ExAny "false-dep"]]
, Right $ exAv "true-dep" 1 []
, Right $ exAv "false-dep" 1 []
]
-- | Database containing a setup dependency with a manual flag. A's library and
-- setup script depend on two different versions of B. B's manual flag can be
-- set to different values in the two places where it is used.
dbSetupDepWithManualFlag :: ExampleDb
dbSetupDepWithManualFlag =
let bFlags = [ExFlag "flag" True Manual]
in [
Right $ exAv "A" 1 [ExFix "B" 1] `withSetupDeps` [ExFix "B" 2]
, Right $ declareFlags bFlags $
exAv "B" 1 [exFlagged "flag" [ExAny "b-1-true-dep"]
[ExAny "b-1-false-dep"]]
, Right $ declareFlags bFlags $
exAv "B" 2 [exFlagged "flag" [ExAny "b-2-true-dep"]
[ExAny "b-2-false-dep"]]
, Right $ exAv "b-1-true-dep" 1 []
, Right $ exAv "b-1-false-dep" 1 []
, Right $ exAv "b-2-true-dep" 1 []
, Right $ exAv "b-2-false-dep" 1 []
]
-- | A database similar to 'dbSetupDepWithManualFlag', except that the library
-- and setup script both depend on B-1. B must be linked because of the Single
-- Instance Restriction, and its flag can only have one value.
dbLinkedSetupDepWithManualFlag :: ExampleDb
dbLinkedSetupDepWithManualFlag = [
Right $ exAv "A" 1 [ExFix "B" 1] `withSetupDeps` [ExFix "B" 1]
, Right $ declareFlags [ExFlag "flag" True Manual] $
exAv "B" 1 [exFlagged "flag" [ExAny "b-1-true-dep"]
[ExAny "b-1-false-dep"]]
, Right $ exAv "b-1-true-dep" 1 []
, Right $ exAv "b-1-false-dep" 1 []
]
-- | Some tests involving testsuites
--
-- Note that in this test framework test suites are always enabled; if you
-- want to test without test suites just set up a test database without
-- test suites.
--
-- * C depends on A (through its test suite)
-- * D depends on B-2 (through its test suite), but B-2 is unavailable
-- * E depends on A-1 directly and on A through its test suite. We prefer
-- to use A-1 for the test suite in this case.
-- * F depends on A-1 directly and on A-2 through its test suite. In this
-- case we currently fail to install F, although strictly speaking
-- test suites should be considered independent goals.
-- * G is like E, but for version A-2. This means that if we cannot install
-- E and G together, unless we regard them as independent goals.
db5 :: ExampleDb
db5 = [
Right $ exAv "A" 1 []
, Right $ exAv "A" 2 []
, Right $ exAv "B" 1 []
, Right $ exAv "C" 1 [] `withTest` exTest "testC" [ExAny "A"]
, Right $ exAv "D" 1 [] `withTest` exTest "testD" [ExFix "B" 2]
, Right $ exAv "E" 1 [ExFix "A" 1] `withTest` exTest "testE" [ExAny "A"]
, Right $ exAv "F" 1 [ExFix "A" 1] `withTest` exTest "testF" [ExFix "A" 2]
, Right $ exAv "G" 1 [ExFix "A" 2] `withTest` exTest "testG" [ExAny "A"]
]
-- Now the _dependencies_ have test suites
--
-- * Installing C is a simple example. C wants version 1 of A, but depends on
-- B, and B's testsuite depends on an any version of A. In this case we prefer
-- to link (if we don't regard test suites as independent goals then of course
-- linking here doesn't even come into it).
-- * Installing [C, D] means that we prefer to link B -- depending on how we
-- set things up, this means that we should also link their test suites.
db6 :: ExampleDb
db6 = [
Right $ exAv "A" 1 []
, Right $ exAv "A" 2 []
, Right $ exAv "B" 1 [] `withTest` exTest "testA" [ExAny "A"]
, Right $ exAv "C" 1 [ExFix "A" 1, ExAny "B"]
, Right $ exAv "D" 1 [ExAny "B"]
]
-- | This test checks that the solver can backjump to disable a flag, even if
-- the problematic dependency is also under a test suite. (issue #4390)
--
-- The goal order forces the solver to choose the flag before enabling testing.
-- Previously, the solver couldn't handle this case, because it only tried to
-- disable testing, and when that failed, it backjumped past the flag choice.
-- The solver should also try to set the flag to false, because that avoids the
-- dependency on B.
testTestSuiteWithFlag :: String -> SolverTest
testTestSuiteWithFlag name =
goalOrder goals $ enableAllTests $ mkTest db name ["A", "B"] $
solverSuccess [("A", 1), ("B", 1)]
where
db :: ExampleDb
db = [
Right $ exAv "A" 1 []
`withTest`
exTest "test" [exFlagged "flag" [ExFix "B" 2] []]
, Right $ exAv "B" 1 []
]
goals :: [ExampleVar]
goals = [
P QualNone "B"
, P QualNone "A"
, F QualNone "A" "flag"
, S QualNone "A" TestStanzas
]
-- Packages with setup dependencies
--
-- Install..
-- * B: Simple example, just make sure setup deps are taken into account at all
-- * C: Both the package and the setup script depend on any version of A.
-- In this case we prefer to link
-- * D: Variation on C.1 where the package requires a specific (not latest)
-- version but the setup dependency is not fixed. Again, we prefer to
-- link (picking the older version)
-- * E: Variation on C.2 with the setup dependency the more inflexible.
-- Currently, in this case we do not see the opportunity to link because
-- we consider setup dependencies after normal dependencies; we will
-- pick A.2 for E, then realize we cannot link E.setup.A to A.2, and pick
-- A.1 instead. This isn't so easy to fix (if we want to fix it at all);
-- in particular, considering setup dependencies _before_ other deps is