From 3836a110577b5c9343915fd96c1b2c64217e0082 Mon Sep 17 00:00:00 2001
From: Cheng Shao <terrorjack@type.dance>
Date: Wed, 28 Feb 2024 22:19:47 +0000
Subject: [PATCH] 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.
---
compiler/GHC/Iface/Ext/Utils.hs | 8 +++-
.../tests/hiefile/should_run/T23540.stdout | 43 ++++++++++---------
.../tests/hiefile/should_run/TestUtils.hs | 7 +--
testsuite/tests/hiefile/should_run/all.T | 2 +-
4 files changed, 34 insertions(+), 26 deletions(-)
diff --git a/compiler/GHC/Iface/Ext/Utils.hs b/compiler/GHC/Iface/Ext/Utils.hs
index f2f562f7259..0eace35fe4b 100644
--- a/compiler/GHC/Iface/Ext/Utils.hs
+++ b/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) =
diff --git a/testsuite/tests/hiefile/should_run/T23540.stdout b/testsuite/tests/hiefile/should_run/T23540.stdout
index 778922b532e..e29ab1cc4f6 100644
--- a/testsuite/tests/hiefile/should_run/T23540.stdout
+++ b/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
+ â””
+
diff --git a/testsuite/tests/hiefile/should_run/TestUtils.hs b/testsuite/tests/hiefile/should_run/TestUtils.hs
index 031fc28084a..39cdd55b8e7 100644
--- a/testsuite/tests/hiefile/should_run/TestUtils.hs
+++ b/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
diff --git a/testsuite/tests/hiefile/should_run/all.T b/testsuite/tests/hiefile/should_run/all.T
index 0f1ac4fa51c..90581be7381 100644
--- a/testsuite/tests/hiefile/should_run/all.T
+++ b/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'])
--
GitLab