[Git][ghc/ghc][wip/base-stability] 9 commits: testsuite: Add test to catch changes in core libraries
Ben Gamari (@bgamari)
gitlab at gitlab.haskell.org
Fri May 19 22:52:16 UTC 2023
Ben Gamari pushed to branch wip/base-stability at Glasgow Haskell Compiler / GHC
Commits:
49697450 by Ben Gamari at 2023-05-19T18:51:52-04:00
testsuite: Add test to catch changes in core libraries
This adds testing infrastructure to ensure that changes in core
libraries (e.g. `base` and `ghc-prim`) are caught in CI.
- - - - -
b481981f by Ben Gamari at 2023-05-19T18:52:05-04:00
base: Introduce Data.Enum
- - - - -
3fca5ac6 by Ben Gamari at 2023-05-19T18:52:05-04:00
base: Add export list to GHC.Num.Integer
- - - - -
74b3ed4b by Ben Gamari at 2023-05-19T18:52:05-04:00
base: Add export list to GHC.Num
- - - - -
c61df649 by Ben Gamari at 2023-05-19T18:52:05-04:00
base: Add export list to GHC.Num.Natural
- - - - -
db5136aa by Ben Gamari at 2023-05-19T18:52:05-04:00
base: Introduce Data.Show
- - - - -
abb22535 by Ben Gamari at 2023-05-19T18:52:05-04:00
base: Add export list to GHC.Float
- - - - -
a4a4efd0 by Ben Gamari at 2023-05-19T18:52:05-04:00
base: Add export list to GHC.Real
- - - - -
437a38c2 by Ben Gamari at 2023-05-19T18:52:05-04:00
base: Eliminate module reexport in GHC.Exception
- - - - -
20 changed files:
- compiler/GHC/Types/TyThing/Ppr.hs
- hadrian/src/Packages.hs
- hadrian/src/Rules/Test.hs
- hadrian/src/Settings/Default.hs
- + libraries/base/Data/Enum.hs
- + libraries/base/Data/Show.hs
- libraries/base/GHC/Exception.hs
- libraries/base/GHC/Float.hs
- libraries/base/GHC/Num.hs
- libraries/base/GHC/Real.hs
- libraries/base/base.cabal
- libraries/ghc-bignum/src/GHC/Num/Integer.hs
- libraries/ghc-bignum/src/GHC/Num/Natural.hs
- testsuite/mk/boilerplate.mk
- + testsuite/tests/interface-stability/Makefile
- + testsuite/tests/interface-stability/README.mkd
- + testsuite/tests/interface-stability/all.T
- + testsuite/tests/interface-stability/base-exports.stdout
- + utils/dump-decls/Main.hs
- + utils/dump-decls/dump-decls.cabal
Changes:
=====================================
compiler/GHC/Types/TyThing/Ppr.hs
=====================================
@@ -146,8 +146,10 @@ pprTyThingHdr = pprTyThing showToHeader
pprTyThingInContext :: ShowSub -> TyThing -> SDoc
pprTyThingInContext show_sub thing
= case parents thing of
+ -- If there are no parents print everything.
[] -> print_it (const True) thing
- thing':rest -> let ss = map getOccName rest in print_it (`elem` ss) thing'
+ -- If `thing` has a parent, print the parent and only its child `thing`
+ thing':rest -> let ss = map getOccName (thing:rest) in print_it (`elem` ss) thing'
where
parents = go
where
=====================================
hadrian/src/Packages.hs
=====================================
@@ -3,7 +3,7 @@ module Packages (
-- * GHC packages
array, base, binary, bytestring, cabal, cabalSyntax, checkPpr,
checkExact, countDeps,
- compareSizes, compiler, containers, deepseq, deriveConstants, directory,
+ compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls,
exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh,
ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline,
hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy,
@@ -35,7 +35,7 @@ import Oracles.Setting
ghcPackages :: [Package]
ghcPackages =
[ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps
- , compareSizes, compiler, containers, deepseq, deriveConstants, directory
+ , compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls
, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh
, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs
, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl
@@ -51,7 +51,7 @@ isGhcPackage = (`elem` ghcPackages)
-- | Package definitions, see 'Package'.
array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps,
- compareSizes, compiler, containers, deepseq, deriveConstants, directory,
+ compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls,
exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh,
ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs,
hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl,
@@ -75,6 +75,7 @@ containers = lib "containers" `setPath` "libraries/containers/con
deepseq = lib "deepseq"
deriveConstants = util "deriveConstants"
directory = lib "directory"
+dumpDecls = util "dump-decls"
exceptions = lib "exceptions"
filepath = lib "filepath"
genapply = util "genapply"
=====================================
hadrian/src/Rules/Test.hs
=====================================
@@ -40,6 +40,12 @@ countDepsSourcePath = "utils/count-deps/Main.hs"
countDepsExtra :: [String]
countDepsExtra = ["-iutils/count-deps"]
+dumpDeclsProgPath, dumpDeclsSourcePath :: FilePath
+dumpDeclsProgPath = "test/bin/dump-decls" <.> exe
+dumpDeclsSourcePath = "utils/dump-decls/Main.hs"
+dumpDeclsExtra :: [String]
+dumpDeclsExtra = []
+
noteLinterProgPath, noteLinterSourcePath :: FilePath
noteLinterProgPath = "test/bin/lint-notes" <.> exe
noteLinterSourcePath = "linters/lint-notes/Main.hs"
@@ -67,6 +73,7 @@ checkPrograms =
[ CheckProgram "test:check-ppr" checkPprProgPath checkPprSourcePath checkPprExtra checkPpr id id
, CheckProgram "test:check-exact" checkExactProgPath checkExactSourcePath checkExactExtra checkExact id id
, CheckProgram "test:count-deps" countDepsProgPath countDepsSourcePath countDepsExtra countDeps id id
+ , CheckProgram "test:dump-decls" dumpDeclsProgPath dumpDeclsSourcePath dumpDeclsExtra dumpDecls id id
, CheckProgram "lint:notes" noteLinterProgPath noteLinterSourcePath noteLinterExtra lintNotes (const stage0Boot) id
, CheckProgram "lint:whitespace" whitespaceLinterProgPath whitespaceLinterSourcePath whitespaceLinterExtra lintWhitespace (const stage0Boot) (filter (/= lintersCommon))
]
@@ -260,6 +267,7 @@ testRules = do
setEnv "CHECK_PPR" (top -/- root -/- checkPprProgPath)
setEnv "CHECK_EXACT" (top -/- root -/- checkExactProgPath)
+ setEnv "DUMP_DECLS" (top -/- root -/- dumpDeclsProgPath)
setEnv "COUNT_DEPS" (top -/- root -/- countDepsProgPath)
setEnv "LINT_NOTES" (top -/- root -/- noteLinterProgPath)
setEnv "LINT_WHITESPACE" (top -/- root -/- whitespaceLinterProgPath)
=====================================
hadrian/src/Settings/Default.hs
=====================================
@@ -167,7 +167,7 @@ stage2Packages = stage1Packages
-- | Packages that are built only for the testsuite.
testsuitePackages :: Action [Package]
-testsuitePackages = return ([ timeout | windowsHost ] ++ [ checkPpr, checkExact, countDeps, ghcConfig ])
+testsuitePackages = return ([ timeout | windowsHost ] ++ [ checkPpr, checkExact, countDeps, ghcConfig, dumpDecls ])
-- | Default build ways for library packages:
-- * We always build 'vanilla' way.
=====================================
libraries/base/Data/Enum.hs
=====================================
@@ -0,0 +1,22 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module : Data.Enum
+-- Copyright : (c) The University of Glasgow, 1992-2002
+-- License : see libraries/base/LICENSE
+--
+-- Maintainer : cvs-ghc at haskell.org
+-- Stability : stable
+-- Portability : non-portable (GHC extensions)
+--
+-- The 'Enum' and 'Bounded' classes.
+--
+-----------------------------------------------------------------------------
+
+module Data.Enum
+ ( Bounded(..)
+ , Enum(..)
+ ) where
+
+import GHC.Enum
=====================================
libraries/base/Data/Show.hs
=====================================
@@ -0,0 +1,28 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module : Data.Show
+-- Copyright : (c) The University of Glasgow, 1992-2002
+-- License : see libraries/base/LICENSE
+--
+-- Maintainer : cvs-ghc at haskell.org
+-- Stability : stable
+-- Portability : non-portable (GHC extensions)
+--
+-- The 'Show' class.
+--
+-----------------------------------------------------------------------------
+
+module Data.Show
+ ( Show(..)
+ -- * 'ShowS'
+ , ShowS
+ , shows
+ , showChar, showString, showMultiLineString
+ , showParen, showCommaSpace, showSpace
+ , showLitChar, showLitString
+ ) where
+
+import GHC.Show
+
=====================================
libraries/base/GHC/Exception.hs
=====================================
@@ -23,16 +23,33 @@
-----------------------------------------------------------------------------
module GHC.Exception
- ( module GHC.Exception.Type
- , throw
- , ErrorCall(..,ErrorCall)
- , errorCallException
- , errorCallWithCallStackException
- -- re-export CallStack and SrcLoc from GHC.Types
- , CallStack, fromCallSiteList, getCallStack, prettyCallStack
- , prettyCallStackLines, showCCSStack
- , SrcLoc(..), prettySrcLoc
- ) where
+ ( -- * 'Exception' class
+ Exception(..)
+
+ -- * 'SomeException'
+ , SomeException(..)
+
+ -- * Throwing
+ , throw
+
+ -- * Concrete exceptions
+ -- ** Arithmetic exceptions
+ , ArithException(..)
+ , divZeroException
+ , overflowException
+ , ratioZeroDenomException
+ , underflowException
+ -- ** 'ErrorCall'
+ , ErrorCall(..,ErrorCall)
+ , errorCallException
+ , errorCallWithCallStackException
+
+ -- * Reexports
+ -- Re-export CallStack and SrcLoc from GHC.Types
+ , CallStack, fromCallSiteList, getCallStack, prettyCallStack
+ , prettyCallStackLines, showCCSStack
+ , SrcLoc(..), prettySrcLoc
+ ) where
import GHC.Base
import GHC.Show
=====================================
libraries/base/GHC/Float.hs
=====================================
@@ -45,14 +45,109 @@
module GHC.Float
- ( module GHC.Float
- , Float(..), Double(..), Float#, Double#
- , double2Int, int2Double, float2Int, int2Float
-
- -- * Monomorphic equality operators
- -- | See GHC.Classes#matching_overloaded_methods_in_rules
- , eqFloat, eqDouble
- ) where
+ ( -- * Classes
+ Floating(..)
+ , RealFloat(..)
+
+ -- * 'Float'
+ , Float(..), Float#
+ -- ** Conversion
+ , float2Int
+ , int2Float
+ , word2Float
+ , integerToFloat#
+ , naturalToFloat#
+ , rationalToFloat
+ , castWord32ToFloat
+ , castFloatToWord32
+ , float2Double
+ -- ** Operations
+ -- | See GHC.Classes#matching_overloaded_methods_in_rules
+ , floorFloat
+ , ceilingFloat
+ , truncateFloat
+ , roundFloat
+ , properFractionFloat
+ -- ** Predicate
+ , isFloatDenormalized
+ , isFloatFinite
+ , isFloatInfinite
+ , isFloatNaN
+ , isFloatNegativeZero
+ -- ** Comparison
+ , eqFloat, gtFloat, geFloat, leFloat, ltFloat
+ -- ** Arithmetic
+ , plusFloat, minusFloat, timesFloat, divideFloat
+ , negateFloat
+ , powerFloat
+ , expFloat, expm1Float
+ , logFloat, log1pFloat, sqrtFloat, fabsFloat
+ , sinFloat, cosFloat, tanFloat
+ , asinFloat, acosFloat, atanFloat
+ , sinhFloat, coshFloat, tanhFloat
+ , asinhFloat, acoshFloat, atanhFloat
+
+ -- * 'Double'
+ , Double(..)
+ , Double#
+ -- ** Conversion
+ , double2Int
+ , int2Double
+ , word2Double
+ , integerToDouble#
+ , naturalToDouble#
+ , rationalToDouble
+ , castWord64ToDouble
+ , castDoubleToWord64
+ , double2Float
+ -- ** Operations
+ -- | See GHC.Classes#matching_overloaded_methods_in_rules
+ , floorDouble
+ , ceilingDouble
+ , truncateDouble
+ , roundDouble
+ , properFractionDouble
+ -- ** Predicate
+ , isDoubleDenormalized
+ , isDoubleFinite
+ , isDoubleInfinite
+ , isDoubleNaN
+ , isDoubleNegativeZero
+ -- ** Comparison
+ , eqDouble, gtDouble, geDouble, leDouble, ltDouble
+ -- ** Arithmetic
+ , plusDouble, minusDouble, timesDouble, divideDouble
+ , negateDouble
+ , powerDouble
+ , expDouble, expm1Double
+ , logDouble, log1pDouble, sqrtDouble, fabsDouble
+ , sinDouble, cosDouble, tanDouble
+ , asinDouble, acosDouble, atanDouble
+ , sinhDouble, coshDouble, tanhDouble
+ , asinhDouble, acoshDouble, atanhDouble
+
+ -- * Formatting
+ , showFloat
+ , FFFormat(..)
+ , formatRealFloat
+ , formatRealFloatAlt
+ , showSignedFloat
+
+ -- * Operations
+ , log1mexpOrd
+ , roundTo
+ , floatToDigits
+ , integerToBinaryFloat'
+ , fromRat
+ , fromRat'
+ , roundingMode#
+
+ -- * Internal
+ , stgFloatToWord32
+ , stgWord32ToFloat
+ , stgDoubleToWord64
+ , stgWord64ToDouble
+ ) where
import Data.Maybe
=====================================
libraries/base/GHC/Num.hs
=====================================
@@ -18,7 +18,9 @@
module GHC.Num
- ( module GHC.Num
+ ( Num(..)
+ , subtract
+ , quotRemInteger
, module GHC.Num.Integer
, module GHC.Num.Natural
-- reexported for backward compatibility
=====================================
libraries/base/GHC/Real.hs
=====================================
@@ -18,7 +18,68 @@
--
-----------------------------------------------------------------------------
-module GHC.Real where
+module GHC.Real
+ ( -- * Classes
+ Real(..)
+ , Integral(..)
+ , Fractional(..)
+ , RealFrac(..)
+
+ -- * Conversion
+ , fromIntegral
+ , realToFrac
+
+ -- * Formatting
+ , showSigned
+
+ -- * Predicates
+ , even
+ , odd
+
+ -- * Arithmetic
+ , (^)
+ , (^^)
+ , gcd
+ , lcm
+
+ -- * 'Ratio'
+ , Ratio(..)
+ , Rational
+ , infinity
+ , notANumber
+
+ -- * 'Enum' helpers
+ , numericEnumFrom
+ , numericEnumFromThen
+ , numericEnumFromTo
+ , numericEnumFromThenTo
+ , integralEnumFrom
+ , integralEnumFromThen
+ , integralEnumFromTo
+ , integralEnumFromThenTo
+
+ -- ** Construction
+ , (%)
+
+ -- ** Projection
+ , numerator
+ , denominator
+
+ -- ** Operations
+ , reduce
+
+ -- * Internal
+ , ratioPrec
+ , ratioPrec1
+ , divZeroError
+ , ratioZeroDenominatorError
+ , overflowError
+ , underflowError
+ , mkRationalBase2
+ , mkRationalBase10
+ , mkRationalWithExponentBase
+ , FractionalExponentBase(..)
+ ) where
#include "MachDeps.h"
=====================================
libraries/base/base.cabal
=====================================
@@ -127,6 +127,7 @@ Library
Data.Dynamic
Data.Either
Data.Eq
+ Data.Enum
Data.Fixed
Data.Foldable
Data.Foldable1
@@ -151,6 +152,7 @@ Library
Data.Proxy
Data.Ratio
Data.Semigroup
+ Data.Show
Data.STRef
Data.STRef.Lazy
Data.STRef.Strict
=====================================
libraries/ghc-bignum/src/GHC/Num/Integer.hs
=====================================
@@ -20,7 +20,131 @@
--
-- The 'Integer' type.
-module GHC.Num.Integer where
+module GHC.Num.Integer
+ ( Integer(..)
+ , integerCheck
+ , integerCheck#
+
+ -- * Useful constants
+ , integerZero
+ , integerOne
+
+ -- * Conversion with...
+ -- ** 'Int'
+ , integerFromInt#
+ , integerFromInt
+ , integerToInt#
+ , integerToInt
+ -- ** 'BigNat'
+ , integerFromBigNat#
+ , integerFromBigNatNeg#
+ , integerFromBigNatSign#
+ , integerToBigNatSign#
+ , integerToBigNatClamp#
+ -- ** 'Word'
+ , integerFromWord#
+ , integerFromWord
+ , integerFromWordNeg#
+ , integerFromWordSign#
+ , integerToWord#
+ , integerToWord
+ -- ** 'Natural'
+ , integerFromNatural
+ , integerToNaturalClamp
+ , integerToNatural
+ , integerToNaturalThrow
+ -- ** 'Int64'/'Word64'
+ , integerFromInt64#
+ , integerFromWord64#
+ , integerToInt64#
+ , integerToWord64#
+ -- ** Floating-point
+ , integerDecodeDouble#
+ , integerEncodeDouble#
+ , integerEncodeDouble
+ , integerEncodeFloat#
+ -- ** 'Addr#'
+ , integerToAddr#
+ , integerToAddr
+ , integerFromAddr#
+ , integerFromAddr
+ -- ** Limbs
+ , integerFromWordList
+ , integerToMutableByteArray#
+ , integerToMutableByteArray
+ , integerFromByteArray#
+ , integerFromByteArray
+
+ -- * Predicates
+ , integerIsNegative#
+ , integerIsNegative
+ , integerIsZero
+ , integerIsOne
+
+ -- * Comparison
+ , integerNe
+ , integerEq
+ , integerLe
+ , integerLt
+ , integerGt
+ , integerGe
+ , integerEq#
+ , integerNe#
+ , integerGt#
+ , integerLe#
+ , integerLt#
+ , integerGe#
+ , integerCompare
+
+ -- * Arithmetic
+ , integerSub
+ , integerAdd
+ , integerMul
+ , integerNegate
+ , integerAbs
+ , integerSignum
+ , integerSignum#
+ , integerQuotRem#
+ , integerQuotRem
+ , integerQuot
+ , integerRem
+ , integerDivMod#
+ , integerDivMod
+ , integerDiv
+ , integerMod
+ , integerGcd
+ , integerLcm
+ , integerSqr
+ , integerLog2#
+ , integerLog2
+ , integerLogBaseWord#
+ , integerLogBaseWord
+ , integerLogBase#
+ , integerLogBase
+ , integerIsPowerOf2#
+ , integerGcde#
+ , integerGcde
+ , integerRecipMod#
+ , integerPowMod#
+
+ -- * Bit operations
+ , integerPopCount#
+ , integerBit#
+ , integerBit
+ , integerTestBit#
+ , integerTestBit
+ , integerShiftR#
+ , integerShiftR
+ , integerShiftL#
+ , integerShiftL
+ , integerOr
+ , integerXor
+ , integerAnd
+ , integerComplement
+
+ -- * Miscellaneous
+ , integerSizeInBase#
+ ) where
#include "MachDeps.h"
#include "WordSize.h"
=====================================
libraries/ghc-bignum/src/GHC/Num/Natural.hs
=====================================
@@ -8,7 +8,109 @@
#include "MachDeps.h"
#include "WordSize.h"
-module GHC.Num.Natural where
+module GHC.Num.Natural
+ ( Natural(..)
+ , naturalCheck#
+ , naturalCheck
+
+ -- * Useful constants
+ , naturalZero
+ , naturalOne
+
+ -- * Predicates
+ , naturalIsZero
+ , naturalIsOne
+ , naturalIsPowerOf2#
+
+ -- * Conversion with...
+ -- ** 'BigNat'
+ , naturalFromBigNat#
+ , naturalToBigNat#
+ -- ** 'Word'
+ , naturalFromWord#
+ , naturalFromWord2#
+ , naturalFromWord
+ , naturalToWord#
+ , naturalToWord
+ , naturalToWordClamp#
+ , naturalToWordClamp
+ , naturalToWordMaybe#
+ -- ** Limbs
+ , naturalFromWordList
+ , naturalToMutableByteArray#
+ , naturalFromByteArray#
+ -- ** Floating point
+ , naturalEncodeDouble#
+ , naturalEncodeFloat#
+ -- ** 'Addr#'
+ , naturalToAddr#
+ , naturalToAddr
+ , naturalFromAddr#
+ , naturalFromAddr
+
+ -- * Comparison
+ , naturalEq#
+ , naturalEq
+ , naturalNe#
+ , naturalNe
+ , naturalGe#
+ , naturalGe
+ , naturalLe#
+ , naturalLe
+ , naturalGt#
+ , naturalGt
+ , naturalLt#
+ , naturalLt
+ , naturalCompare
+
+ -- * Bit operations
+ , naturalPopCount#
+ , naturalPopCount
+ , naturalShiftR#
+ , naturalShiftR
+ , naturalShiftL#
+ , naturalShiftL
+ , naturalAnd
+ , naturalAndNot
+ , naturalOr
+ , naturalXor
+ , naturalTestBit#
+ , naturalTestBit
+ , naturalBit#
+ , naturalBit
+ , naturalSetBit#
+ , naturalSetBit
+ , naturalClearBit#
+ , naturalClearBit
+ , naturalComplementBit#
+ , naturalComplementBit
+
+ -- * Arithmetic
+ , naturalAdd
+ , naturalSub
+ , naturalSubThrow
+ , naturalSubUnsafe
+ , naturalMul
+ , naturalSqr
+ , naturalSignum
+ , naturalNegate
+ , naturalQuotRem#
+ , naturalQuotRem
+ , naturalQuot
+ , naturalRem
+ , naturalGcd
+ , naturalLcm
+ , naturalLog2#
+ , naturalLog2
+ , naturalLogBaseWord#
+ , naturalLogBaseWord
+ , naturalLogBase#
+ , naturalLogBase
+ , naturalPowMod
+
+ -- * Miscellaneous
+ , naturalSizeInBase#
+ ) where
import GHC.Prim
import GHC.Types
=====================================
testsuite/mk/boilerplate.mk
=====================================
@@ -227,6 +227,10 @@ ifeq "$(CHECK_EXACT)" ""
CHECK_EXACT := $(abspath $(TOP)/../inplace/bin/check-exact)
endif
+ifeq "$(DUMP_DECLS)" ""
+DUMP_DECLS := $(abspath $(TOP)/../inplace/bin/dump-decls)
+endif
+
ifeq "$(COUNT_DEPS)" ""
COUNT_DEPS := $(abspath $(TOP)/../inplace/bin/count-deps)
endif
=====================================
testsuite/tests/interface-stability/Makefile
=====================================
@@ -0,0 +1,6 @@
+TOP=../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+exports_% :
+ "$(DUMP_DECLS)" "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" $*
=====================================
testsuite/tests/interface-stability/README.mkd
=====================================
@@ -0,0 +1,11 @@
+# Interface stability testing
+
+The tests in this directory verify that the interfaces of exposed by GHC's
+core libraries do not inadvertently change. They use the `utils/dump-decls`
+utility to dump all exported declarations of all exposed modules for the
+following packages:
+
+ * base
+
+These are compared against the expected exports in the test's corresponding
+`.stdout` file.
=====================================
testsuite/tests/interface-stability/all.T
=====================================
@@ -0,0 +1,7 @@
+def check_package(pkg_name):
+ test(f'{pkg_name}-exports',
+ req_hadrian_deps(['test:dump-decls']),
+ makefile_test,
+ [f'exports_{pkg_name}'])
+
+check_package('base')
=====================================
testsuite/tests/interface-stability/base-exports.stdout
=====================================
The diff for this file was not included because it is too large.
=====================================
utils/dump-decls/Main.hs
=====================================
@@ -0,0 +1,182 @@
+module Main where
+
+import GHC
+import GHC.Core.InstEnv (instEnvElts, instanceHead)
+import GHC.Core.TyCo.FVs (tyConsOfType)
+import GHC.Driver.Ppr (showSDocForUser)
+import GHC.Unit.State (lookupUnitId, lookupPackageName)
+import GHC.Unit.Info (UnitInfo, unitExposedModules, PackageName(..))
+import GHC.Data.FastString (fsLit)
+import GHC.Driver.Env (hsc_units, hscEPS)
+import GHC.Utils.Outputable
+import GHC.Types.Unique.Set (nonDetEltsUniqSet)
+import GHC.Types.TyThing (tyThingParent_maybe)
+import GHC.Types.TyThing.Ppr (pprTyThing)
+import GHC.Types.Name (nameOccName, nameModule_maybe, stableNameCmp)
+import GHC.Types.Name.Occurrence (OccName)
+import GHC.Unit.External (eps_inst_env)
+import GHC.Iface.Syntax (ShowSub(..), ShowHowMuch(..), AltPpr(..))
+import GHC.Iface.Type (ShowForAllFlag(..))
+
+import Data.Function (on)
+import Data.List (sortBy)
+import Control.Monad.IO.Class
+import System.Environment (getArgs)
+import Prelude hiding ((<>))
+
+main :: IO ()
+main = do
+ ghcRoot:pkg_names <- getArgs
+ mapM_ (run ghcRoot) pkg_names
+
+run :: FilePath -> String -> IO ()
+run root pkg_nm = runGhc (Just root) $ do
+ let args = map noLoc
+ [ "-package=" ++ pkg_nm
+ , "-dppr-cols=1000"
+ , "-fprint-explicit-runtime-reps"
+ , "-fprint-explicit-foralls"
+ ]
+ dflags <- do
+ dflags <- getSessionDynFlags
+ logger <- getLogger
+ (dflags', _fileish_args, _dynamicFlagWarnings) <-
+ GHC.parseDynamicFlags logger dflags args
+ return dflags'
+
+ _ <- setProgramDynFlags dflags
+ unit_state <- hsc_units <$> getSession
+ unit_id <- case lookupPackageName unit_state (PackageName $ fsLit pkg_nm) of
+ Just unit_id -> return unit_id
+ Nothing -> fail "failed to find package"
+ unit_info <- case lookupUnitId unit_state unit_id of
+ Just unit_info -> return unit_info
+ Nothing -> fail "unknown package"
+
+ decls_doc <- reportUnitDecls unit_info
+ insts_doc <- reportInstances
+
+ name_ppr_ctx <- GHC.getNamePprCtx
+ let rendered = showSDocForUser dflags unit_state name_ppr_ctx (vcat [decls_doc, insts_doc])
+ liftIO $ putStrLn rendered
+
+ignoredModules :: [ModuleName]
+ignoredModules =
+ map mkModuleName $ concat
+ [ unstableModules
+ , platformDependentModules
+ ]
+ where
+ unstableModules =
+ [ "GHC.Prim"
+ , "GHC.Conc.POSIX"
+ , "GHC.Conc.IO"
+ ]
+ platformDependentModules =
+ [ "System.Posix.Types"
+ , "Foreign.C.Types"
+ ]
+
+ignoredName :: Name -> Bool
+ignoredName nm
+ | Just md <- nameModule_maybe nm
+ , moduleName md `elem` ignoredModules
+ = True
+ | otherwise
+ = False
+
+ignoredTyThing :: TyThing -> Bool
+ignoredTyThing _ = False
+
+ignoredTyCon :: TyCon -> Bool
+ignoredTyCon = ignoredName . getName
+
+ignoredType :: Type -> Bool
+ignoredType = any ignoredTyCon . nonDetEltsUniqSet . tyConsOfType
+
+-- | Ignore instances whose heads mention ignored types.
+ignoredInstance :: ClsInst -> Bool
+ignoredInstance inst
+ | ignoredName $ getName cls
+ = True
+ | any ignoredType tys
+ = True
+ | otherwise
+ = False
+ where
+ (_, cls, tys) = instanceHead inst
+
+reportUnitDecls :: UnitInfo -> Ghc SDoc
+reportUnitDecls unit_info = do
+ let exposed :: [ModuleName]
+ exposed = map fst (unitExposedModules unit_info)
+ vcat <$> mapM reportModuleDecls exposed
+
+reportModuleDecls :: ModuleName -> Ghc SDoc
+reportModuleDecls modl_nm
+ | modl_nm `elem` ignoredModules = do
+ return $ vcat [ mod_header, text "-- ignored", text "" ]
+ | otherwise = do
+ modl <- GHC.lookupQualifiedModule NoPkgQual modl_nm
+ mb_mod_info <- GHC.getModuleInfo modl
+ mod_info <- case mb_mod_info of
+ Nothing -> fail "Failed to find module"
+ Just mod_info -> return mod_info
+
+ Just name_ppr_ctx <- mkNamePprCtxForModule mod_info
+ let names = GHC.modInfoExports mod_info
+ sorted_names = sortBy (compare `on` nameOccName) names
+
+ exported_occs :: [OccName]
+ exported_occs = map nameOccName names
+
+ is_exported :: OccName -> Bool
+ is_exported = (`elem` exported_occs)
+
+ things <- mapM GHC.lookupName sorted_names
+ let contents = vcat $
+ [ text "-- Safety:" <+> ppr (modInfoSafe mod_info) ] ++
+ [ pprTyThing ss thing
+ | Just thing <- things
+ , case tyThingParent_maybe thing of
+ Just parent
+ | is_exported (getOccName parent) -> False
+ _ -> True
+ , not $ ignoredTyThing thing
+ , let ss = ShowSub { ss_how_much = ShowSome is_exported (AltPpr Nothing)
+ , ss_forall = ShowForAllMust
+ }
+ ]
+
+ return $ withUserStyle name_ppr_ctx AllTheWay $
+ hang mod_header 2 contents <>
+ text ""
+ where
+ mod_header = vcat
+ [ text ""
+ , text "module" <+> ppr modl_nm <+> text "where"
+ , text ""
+ ]
+
+reportInstances :: Ghc SDoc
+reportInstances = do
+ hsc_env <- getSession
+ eps <- liftIO $ hscEPS hsc_env
+ let instances = eps_inst_env eps
+ return $ vcat $
+ [ text ""
+ , text ""
+ , text "-- Instances:"
+ ] ++
+ [ ppr inst
+ | inst <- sortBy compareInstances (instEnvElts instances)
+ , not $ ignoredInstance inst
+ ]
+
+compareInstances :: ClsInst -> ClsInst -> Ordering
+compareInstances inst1 inst2 = mconcat
+ [ stableNameCmp (getName cls1) (getName cls2)
+ ]
+ where
+ (_, cls1, _tys1) = instanceHead inst1
+ (_, cls2, _tys2) = instanceHead inst2
=====================================
utils/dump-decls/dump-decls.cabal
=====================================
@@ -0,0 +1,13 @@
+cabal-version: 2.4
+name: dump-decls
+version: 0.1.0.0
+synopsis: Dump the declarations of a package.
+license: BSD-3-Clause
+author: Ben Gamari
+maintainer: ben at smart-cactus.org
+copyright: (c) 2023 Ben Gamari
+
+executable dump-decls
+ main-is: Main.hs
+ build-depends: base, ghc
+ default-language: Haskell2010
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6189abc9c62bc6100f89ebb98ed17ef503357a81...437a38c2edad016c8841327f3884177b00312b38
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6189abc9c62bc6100f89ebb98ed17ef503357a81...437a38c2edad016c8841327f3884177b00312b38
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/20230519/d54dcceb/attachment-0001.html>
More information about the ghc-commits
mailing list