From e1cae1230d5b334c045d0c568d5bf7d02a26dbd7 Mon Sep 17 00:00:00 2001
From: "simonpj@microsoft.com" <unknown>
Date: Wed, 4 Jun 2008 14:40:49 +0000
Subject: [PATCH 1/1] 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)
---
 compiler/basicTypes/Module.lhs    |   14 +++++++++++---
 compiler/typecheck/TcRnDriver.lhs |   13 +++++++++++--
 2 files changed, 22 insertions(+), 5 deletions(-)

diff --git a/compiler/basicTypes/Module.lhs b/compiler/basicTypes/Module.lhs
index 8d9cb3b..6916911 100644
--- a/compiler/basicTypes/Module.lhs
+++ b/compiler/basicTypes/Module.lhs
@@ -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)
 
diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs
index 2afe890..88695bc 100644
--- a/compiler/typecheck/TcRnDriver.lhs
+++ b/compiler/typecheck/TcRnDriver.lhs
@@ -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,
-- 
1.7.10.4