[Git][ghc/ghc][master] testsuite: fix T23540 fragility on 32-bit platforms
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Fri Mar 1 02:26:18 UTC 2024
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
3836a110 by Cheng Shao at 2024-02-29T21:25:45-05:00
testsuite: fix T23540 fragility on 32-bit platforms
T23540 is fragile on 32-bit platforms. The root cause is usage of
`getEvidenceTreesAtPoint`, which internally relies on `Name`'s `Ord`
instance, which is indeterministic. The solution is adding a
deterministic `Ord` instance for `EvidenceInfo` and sorting the
evidence trees before pretty printing. Fixes #24449.
- - - - -
4 changed files:
- compiler/GHC/Iface/Ext/Utils.hs
- testsuite/tests/hiefile/should_run/T23540.stdout
- testsuite/tests/hiefile/should_run/TestUtils.hs
- testsuite/tests/hiefile/should_run/all.T
Changes:
=====================================
compiler/GHC/Iface/Ext/Utils.hs
=====================================
@@ -107,7 +107,13 @@ data EvidenceInfo a
, evidenceSpan :: RealSrcSpan
, evidenceType :: a
, evidenceDetails :: Maybe (EvVarSource, Scope, Maybe Span)
- } deriving (Eq,Ord,Functor)
+ } deriving (Eq, Functor)
+
+instance Ord a => Ord (EvidenceInfo a) where
+ compare (EvidenceInfo name span typ dets) (EvidenceInfo name' span' typ' dets') =
+ case stableNameCmp name name' of
+ EQ -> compare (span, typ, dets) (span', typ', dets')
+ r -> r
instance (Outputable a) => Outputable (EvidenceInfo a) where
ppr (EvidenceInfo name span typ dets) =
=====================================
testsuite/tests/hiefile/should_run/T23540.stdout
=====================================
@@ -124,35 +124,35 @@ At point (49,14), we found:
At point (61,7), we found:
==========================
┌
-│ $dFunctor at T23540.hs:1:1, of type: Functor Identity'
-│ is an evidence variable bound by a let, depending on: [$fFunctorIdentity']
+│ $dApplicative at T23540.hs:1:1, of type: Applicative Identity'
+│ is an evidence variable bound by a let, depending on: [$fApplicativeIdentity']
│ with scope: ModuleScope
│
│ Defined at <no location info>
└
|
`- ┌
- │ $fFunctorIdentity' at T23540.hs:54:10-26, of type: Functor Identity'
- │ is an evidence variable bound by an instance of class Functor
+ │ $fApplicativeIdentity' at T23540.hs:56:10-30, of type: Applicative Identity'
+ │ is an evidence variable bound by an instance of class Applicative
│ with scope: ModuleScope
│
- │ Defined at T23540.hs:54:10
+ │ Defined at T23540.hs:56:10
└
┌
-│ $dApplicative at T23540.hs:1:1, of type: Applicative Identity'
-│ is an evidence variable bound by a let, depending on: [$fApplicativeIdentity']
+│ $dFunctor at T23540.hs:1:1, of type: Functor Identity'
+│ is an evidence variable bound by a let, depending on: [$fFunctorIdentity']
│ with scope: ModuleScope
│
│ Defined at <no location info>
└
|
`- ┌
- │ $fApplicativeIdentity' at T23540.hs:56:10-30, of type: Applicative Identity'
- │ is an evidence variable bound by an instance of class Applicative
+ │ $fFunctorIdentity' at T23540.hs:54:10-26, of type: Functor Identity'
+ │ is an evidence variable bound by an instance of class Functor
│ with scope: ModuleScope
│
- │ Defined at T23540.hs:56:10
+ │ Defined at T23540.hs:54:10
└
==========================
@@ -202,33 +202,34 @@ At point (69,4), we found:
At point (82,6), we found:
==========================
┌
-│ $dOrd at T23540.hs:1:1, of type: Ord Modulo1
-│ is an evidence variable bound by a let, depending on: [$fOrdModulo1]
+│ $dNum at T23540.hs:1:1, of type: Num Modulo1
+│ is an evidence variable bound by a let, depending on: [$fNumModulo1]
│ with scope: ModuleScope
│
│ Defined at <no location info>
└
|
`- ┌
- │ $fOrdModulo1 at T23540.hs:8:35-37, of type: Ord Modulo1
- │ is an evidence variable bound by an instance of class Ord
+ │ $fNumModulo1 at T23540.hs:10:10-20, of type: Num Modulo1
+ │ is an evidence variable bound by an instance of class Num
│ with scope: ModuleScope
│
- │ Defined at T23540.hs:8:35
+ │ Defined at T23540.hs:10:10
└
┌
-│ $dNum at T23540.hs:1:1, of type: Num Modulo1
-│ is an evidence variable bound by a let, depending on: [$fNumModulo1]
+│ $dOrd at T23540.hs:1:1, of type: Ord Modulo1
+│ is an evidence variable bound by a let, depending on: [$fOrdModulo1]
│ with scope: ModuleScope
│
│ Defined at <no location info>
└
|
`- ┌
- │ $fNumModulo1 at T23540.hs:10:10-20, of type: Num Modulo1
- │ is an evidence variable bound by an instance of class Num
+ │ $fOrdModulo1 at T23540.hs:8:35-37, of type: Ord Modulo1
+ │ is an evidence variable bound by an instance of class Ord
│ with scope: ModuleScope
│
- │ Defined at T23540.hs:10:10
- └
\ No newline at end of file
+ │ Defined at T23540.hs:8:35
+ └
+
=====================================
testsuite/tests/hiefile/should_run/TestUtils.hs
=====================================
@@ -10,6 +10,7 @@ module TestUtils
) where
import System.Environment
+import Data.List (sort)
import Data.Tree
import GHC.Types.Name.Cache
import GHC.Types.SrcLoc
@@ -20,13 +21,13 @@ import qualified GHC.Utils.Outputable as O
import GHC.Iface.Ext.Binary
import GHC.Iface.Ext.Types
import GHC.Iface.Ext.Utils
-
+
import GHC.Driver.Session
import GHC.SysTools
makeNc :: IO NameCache
makeNc = initNameCache 'z' []
-
+
dynFlagsForPrinting :: String -> IO DynFlags
dynFlagsForPrinting libdir = do
systemSettings <- initSysTools libdir
@@ -53,7 +54,7 @@ explainEv df hf refmap point = do
putStrLn $ replicate 26 '='
putStr $ drawForest ptrees
where
- trees = getEvidenceTreesAtPoint hf refmap point
+ trees = sort $ getEvidenceTreesAtPoint hf refmap point
ptrees = fmap (pprint . fmap expandType) <$> trees
=====================================
testsuite/tests/hiefile/should_run/all.T
=====================================
@@ -5,5 +5,5 @@ test('T23492', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUti
test('RecordDotTypes', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info'])
test('SpliceTypes', [req_th, extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info'])
test('HieVdq', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info'])
-test('T23540', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs']), when(arch('i386'), fragile(24449))], compile_and_run, ['-package ghc -fwrite-ide-info'])
+test('T23540', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info'])
test('T23120', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3836a110577b5c9343915fd96c1b2c64217e0082
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3836a110577b5c9343915fd96c1b2c64217e0082
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/20240229/b8293201/attachment-0001.html>
More information about the ghc-commits
mailing list