Commit e1cae123 authored by simonpj@microsoft.com's avatar simonpj@microsoft.com
Browse files

Sort modules and packages in debug print (reduce test wobbles)

This affects only the debug print TcRnDriver.pprTcGblEnv, and eliminates
test-suite wobbling (affected me for tc168, tc231) 
parent 1bf423f5
......@@ -19,6 +19,7 @@ module Module
moduleNameSlashes,
mkModuleName,
mkModuleNameFS,
stableModuleNameCmp,
-- * The PackageId type
PackageId,
......@@ -26,6 +27,7 @@ module Module
packageIdFS,
stringToPackageId,
packageIdString,
stablePackageIdCmp,
-- * Wired-in PackageIds
primPackageId,
......@@ -161,6 +163,10 @@ instance Binary ModuleName where
put_ bh (ModuleName fs) = put_ bh fs
get bh = do fs <- get bh; return (ModuleName fs)
stableModuleNameCmp :: ModuleName -> ModuleName -> Ordering
-- Compare lexically, not by unique
stableModuleNameCmp n1 n2 = moduleNameFS n1 `compare` moduleNameFS n2
pprModuleName :: ModuleName -> SDoc
pprModuleName (ModuleName nm) =
getPprStyle $ \ sty ->
......@@ -184,7 +190,6 @@ mkModuleNameFS s = ModuleName s
moduleNameSlashes :: ModuleName -> String
moduleNameSlashes = dots_to_slashes . moduleNameString
where dots_to_slashes = map (\c -> if c == '.' then pathSeparator else c)
\end{code}
%************************************************************************
......@@ -213,8 +218,8 @@ instance Binary Module where
-- not be stable from run to run of the compiler.
stableModuleCmp :: Module -> Module -> Ordering
stableModuleCmp (Module p1 n1) (Module p2 n2)
= (packageIdFS p1 `compare` packageIdFS p2) `thenCmp`
(moduleNameFS n1 `compare` moduleNameFS n2)
= (p1 `stablePackageIdCmp` p2) `thenCmp`
(n1 `stableModuleNameCmp` n2)
mkModule :: PackageId -> ModuleName -> Module
mkModule = Module
......@@ -254,6 +259,9 @@ instance Uniquable PackageId where
instance Ord PackageId where
nm1 `compare` nm2 = getUnique nm1 `compare` getUnique nm2
stablePackageIdCmp :: PackageId -> PackageId -> Ordering
stablePackageIdCmp p1 p2 = packageIdFS p1 `compare` packageIdFS p2
instance Outputable PackageId where
ppr pid = text (packageIdString pid)
......
......@@ -82,6 +82,7 @@ import Outputable
import DataCon
import Type
import Class
import Data.List ( sortBy )
#ifdef GHCI
import Linker
......@@ -1470,8 +1471,16 @@ pprTcGblEnv (TcGblEnv { tcg_type_env = type_env,
, ppr_fam_insts fam_insts
, vcat (map ppr rules)
, ppr_gen_tycons (typeEnvTyCons type_env)
, ptext (sLit "Dependent modules:") <+> ppr (eltsUFM (imp_dep_mods imports))
, ptext (sLit "Dependent packages:") <+> ppr (imp_dep_pkgs imports)]
, ptext (sLit "Dependent modules:") <+>
ppr (sortBy cmp_mp $ eltsUFM (imp_dep_mods imports))
, ptext (sLit "Dependent packages:") <+>
ppr (sortBy stablePackageIdCmp $ imp_dep_pkgs imports)]
where -- The two uses of sortBy are just to reduce unnecessary
-- wobbling in testsuite output
cmp_mp (mod_name1, is_boot1) (mod_name2, is_boot2)
= (mod_name1 `stableModuleNameCmp` mod_name2)
`thenCmp`
(is_boot1 `compare` is_boot2)
pprModGuts :: ModGuts -> SDoc
pprModGuts (ModGuts { mg_types = type_env,
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment