Skip to content
Commits on Source (13)
Hide whitespace changes
Inline Side-by-side
.gitlab-ci.yml
View file @ 10468272
......@@ -143,6 +143,7 @@ lint-release-changelogs:
- ./boot
- ./configure $CONFIGURE_ARGS
- hadrian/build.cabal.sh -j`mk/detect-cpu-count.sh` --docs=no-sphinx binary-dist
- hadrian/build.cabal.sh -j`mk/detect-cpu-count.sh` --docs=no-sphinx test
- mv _build/bindist/ghc*.tar.xz ghc.tar.xz
cache:
key: hadrian
......
compiler/deSugar/Check.hs
View file @ 10468272
......@@ -157,7 +157,9 @@ data PmPat :: PatTy -> * where
PmNLit :: { pm_lit_id :: Id
, pm_lit_not :: [PmLit] } -> PmPat 'VA
PmGrd :: { pm_grd_pv :: PatVec
, pm_grd_expr :: PmExpr } -> PmPat 'PAT
, pm_grd_expr :: PmExpr } -> PmPat 'PAT
-- | A fake guard pattern (True <- _) used to represent cases we cannot handle.
PmFake :: PmPat 'PAT
instance Outputable (PmPat a) where
ppr = pprPmPatDebug
......@@ -928,24 +930,11 @@ truePattern :: Pattern
truePattern = nullaryConPattern (RealDataCon trueDataCon)
{-# INLINE truePattern #-}
-- | A fake guard pattern (True <- _) used to represent cases we cannot handle
fake_pat :: Pattern
fake_pat = PmGrd { pm_grd_pv = [truePattern]
, pm_grd_expr = PmExprOther (EWildPat noExt) }
{-# INLINE fake_pat #-}
-- | Check whether a guard pattern is generated by the checker (unhandled)
isFakeGuard :: [Pattern] -> PmExpr -> Bool
isFakeGuard [PmCon { pm_con_con = RealDataCon c }] (PmExprOther (EWildPat _))
| c == trueDataCon = True
| otherwise = False
isFakeGuard _pats _e = False
-- | Generate a `canFail` pattern vector of a specific type
mkCanFailPmPat :: Type -> DsM PatVec
mkCanFailPmPat ty = do
var <- mkPmVar ty
return [var, fake_pat]
return [var, PmFake]
vanillaConPattern :: ConLike -> [Type] -> PatVec -> Pattern
-- ADT constructor pattern => no existentials, no local constraints
......@@ -1295,7 +1284,7 @@ translateGuards fam_insts guards = do
then pure all_guards
else do
kept <- filterM shouldKeep all_guards
pure (fake_pat : kept)
pure (PmFake : kept)
-- | Check whether a pattern can fail to match
cantFailPattern :: Pattern -> DsM Bool
......@@ -1377,7 +1366,7 @@ cases:
expressivity in our warnings.
Hence, in this case, we replace the guard @([a,b] <- f x)@ with a *dummy*
@fake_pat@: @True <- _@. That is, we record that there is a possibility
@PmFake@: @True <- _@. That is, we record that there is a possibility
of failure but we minimize it to a True/False. This generates a single
warning and much smaller uncovered sets.
......@@ -1421,7 +1410,7 @@ in the pattern bind case). Hence, we safely drop them.
Additionally, top-level guard translation (performed by @translateGuards@)
replaces guards that cannot be reasoned about (like the ones we described in
1-4) with a single @fake_pat@ to record the possibility of failure to match.
1-4) with a single @PmFake@ to record the possibility of failure to match.
Note [Translate CoPats]
~~~~~~~~~~~~~~~~~~~~~~~
......@@ -1457,6 +1446,7 @@ pmPatType (PmNLit { pm_lit_id = x }) = idType x
pmPatType (PmGrd { pm_grd_pv = pv })
= ASSERT(patVecArity pv == 1) (pmPatType p)
where Just p = find ((==1) . patternArity) pv
pmPatType PmFake = pmPatType truePattern
-- | Information about a conlike that is relevant to coverage checking.
-- It is called an \"inhabitation candidate\" since it is a value which may
......@@ -1679,7 +1669,7 @@ mkGuard pv e = do
let expr = hsExprToPmExpr e
tracePmD "mkGuard" (vcat [ppr pv, ppr e, ppr res, ppr expr])
if | res -> pure (PmGrd pv expr)
| PmExprOther {} <- expr -> pure fake_pat
| PmExprOther {} <- expr -> pure PmFake
| otherwise -> pure (PmGrd pv expr)
-- | Create a term equality of the form: `(False ~ (x ~ lit))`
......@@ -1753,6 +1743,7 @@ coercePmPat (PmCon { pm_con_con = con, pm_con_arg_tys = arg_tys
, pm_con_tvs = tvs, pm_con_dicts = dicts
, pm_con_args = coercePatVec args }]
coercePmPat (PmGrd {}) = [] -- drop the guards
coercePmPat PmFake = [] -- drop the guards
-- | Check whether a 'ConLike' has the /single match/ property, i.e. whether
-- it is the only possible match in the given context. See also
......@@ -1765,7 +1756,7 @@ singleMatchConstructor cl tys =
Note [Single match constructors]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
When translating pattern guards for consumption by the checker, we desugar
every pattern guard that might fail ('cantFailPattern') to 'fake_pat'
every pattern guard that might fail ('cantFailPattern') to 'PmFake'
(True <- _). Which patterns can't fail? Exactly those that only match on
'singleMatchConstructor's.
......@@ -2023,13 +2014,15 @@ pmcheck [] guards vva@(ValVec [] _)
| otherwise = pmcheckGuardsI guards vva
-- Guard
pmcheck (p@(PmGrd pv e) : ps) guards vva@(ValVec vas delta)
-- short-circuit if the guard pattern is useless.
-- we just have two possible outcomes: fail here or match and recurse
-- none of the two contains any useful information about the failure
-- though. So just have these two cases but do not do all the boilerplate
| isFakeGuard pv e = forces . mkCons vva <$> pmcheckI ps guards vva
| otherwise = do
pmcheck (PmFake : ps) guards vva =
-- short-circuit if the guard pattern is useless.
-- we just have two possible outcomes: fail here or match and recurse
-- none of the two contains any useful information about the failure
-- though. So just have these two cases but do not do all the boilerplate
forces . mkCons vva <$> pmcheckI ps guards vva
pmcheck (p : ps) guards (ValVec vas delta)
| PmGrd { pm_grd_pv = pv, pm_grd_expr = e } <- p
= do
y <- liftD $ mkPmId (pmPatType p)
let tm_state = extendSubst y e (delta_tm_cs delta)
delta' = delta { delta_tm_cs = tm_state }
......@@ -2182,6 +2175,7 @@ pmcheckHd (p@(PmCon {})) ps guards (PmNLit { pm_lit_id = x }) vva
= pmcheckHdI p ps guards (PmVar x) vva
-- Impossible: handled by pmcheck
pmcheckHd PmFake _ _ _ _ = panic "pmcheckHd: Fake"
pmcheckHd (PmGrd {}) _ _ _ _ = panic "pmcheckHd: Guard"
{-
......@@ -2742,6 +2736,7 @@ pprPmPatDebug (PmLit li) = text "PmLit" <+> ppr li
pprPmPatDebug (PmNLit i nl) = text "PmNLit" <+> ppr i <+> ppr nl
pprPmPatDebug (PmGrd pv ge) = text "PmGrd" <+> hsep (map pprPmPatDebug pv)
<+> ppr ge
pprPmPatDebug PmFake = text "PmFake"
pprPatVec :: PatVec -> SDoc
pprPatVec ps = hang (text "Pattern:") 2
......
compiler/main/ErrUtils.hs
View file @ 10468272
......@@ -81,6 +81,7 @@ import Data.IORef
import Data.Maybe ( fromMaybe )
import Data.Ord
import Data.Time
import Debug.Trace
import Control.Monad
import Control.Monad.IO.Class
import System.IO
......@@ -608,9 +609,10 @@ fatalErrorMsg'' :: FatalMessager -> String -> IO ()
fatalErrorMsg'' fm msg = fm msg
compilationProgressMsg :: DynFlags -> String -> IO ()
compilationProgressMsg dflags msg
= ifVerbose dflags 1 $
logOutput dflags (defaultUserStyle dflags) (text msg)
compilationProgressMsg dflags msg = do
traceEventIO $ "GHC progress: " ++ msg
ifVerbose dflags 1 $
logOutput dflags (defaultUserStyle dflags) (text msg)
showPass :: DynFlags -> String -> IO ()
showPass dflags what
......@@ -651,10 +653,12 @@ withTiming getDFlags what force_result action
if verbosity dflags >= 2 || dopt Opt_D_dump_timings dflags
then do liftIO $ logInfo dflags (defaultUserStyle dflags)
$ text "***" <+> what <> colon
liftIO $ traceEventIO $ showSDocOneLine dflags $ text "GHC:started:" <+> what
alloc0 <- liftIO getAllocationCounter
start <- liftIO getCPUTime
!r <- action
() <- pure $ force_result r
liftIO $ traceEventIO $ showSDocOneLine dflags $ text "GHC:finished:" <+> what
end <- liftIO getCPUTime
alloc1 <- liftIO getAllocationCounter
-- recall that allocation counter counts down
......
compiler/prelude/primops.txt.pp
View file @ 10468272
......@@ -1133,7 +1133,18 @@ primop ThawArrayOp "thawArray#" GenPrimOp
primop CasArrayOp "casArray#" GenPrimOp
MutableArray# s a -> Int# -> a -> a -> State# s -> (# State# s, Int#, a #)
{Unsafe, machine-level atomic compare and swap on an element within an Array.}
{Given an array, an offset, the expected old value, and
the new value, perform an atomic compare and swap (i.e. write the new
value if the current value and the old value are the same pointer).
Returns 0 if the swap succeeds and 1 if it fails. Additionally, returns
the element at the offset after the operation completes. This means that
on a success the new value is returned, and on a failure the actual old
value (not the expected one) is returned. Implies a full memory barrier.
The use of a pointer equality on a lifted value makes this function harder
to use correctly than {\tt casIntArray\#}. All of the difficulties
of using {\tt reallyUnsafePtrEquality\#} correctly apply to
{\tt casArray\#} as well.
}
with
out_of_line = True
has_side_effects = True
......@@ -1298,7 +1309,8 @@ primop ThawSmallArrayOp "thawSmallArray#" GenPrimOp
primop CasSmallArrayOp "casSmallArray#" GenPrimOp
SmallMutableArray# s a -> Int# -> a -> a -> State# s -> (# State# s, Int#, a #)
{Unsafe, machine-level atomic compare and swap on an element within an array.}
{Unsafe, machine-level atomic compare and swap on an element within an array.
See the documentation of {\tt casArray\#}.}
with
out_of_line = True
has_side_effects = True
......@@ -1562,13 +1574,13 @@ primop ReadByteArrayOp_WideChar "readWideCharArray#" GenPrimOp
primop ReadByteArrayOp_Int "readIntArray#" GenPrimOp
MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #)
{Read integer; offset in words.}
{Read integer; offset in machine words.}
with has_side_effects = True
can_fail = True
primop ReadByteArrayOp_Word "readWordArray#" GenPrimOp
MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #)
{Read word; offset in words.}
{Read word; offset in machine words.}
with has_side_effects = True
can_fail = True
......@@ -1942,21 +1954,21 @@ primop SetByteArrayOp "setByteArray#" GenPrimOp
primop AtomicReadByteArrayOp_Int "atomicReadIntArray#" GenPrimOp
MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #)
{Given an array and an offset in Int units, read an element. The
{Given an array and an offset in machine words, read an element. The
index is assumed to be in bounds. Implies a full memory barrier.}
with has_side_effects = True
can_fail = True
primop AtomicWriteByteArrayOp_Int "atomicWriteIntArray#" GenPrimOp
MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
{Given an array and an offset in Int units, write an element. The
{Given an array and an offset in machine words, write an element. The
index is assumed to be in bounds. Implies a full memory barrier.}
with has_side_effects = True
can_fail = True
primop CasByteArrayOp_Int "casIntArray#" GenPrimOp
MutableByteArray# s -> Int# -> Int# -> Int# -> State# s -> (# State# s, Int# #)
{Given an array, an offset in Int units, the expected old value, and
{Given an array, an offset in machine words, the expected old value, and
the new value, perform an atomic compare and swap i.e. write the new
value if the current value matches the provided old value. Returns
the value of the element before the operation. Implies a full memory
......@@ -1966,7 +1978,7 @@ primop CasByteArrayOp_Int "casIntArray#" GenPrimOp
primop FetchAddByteArrayOp_Int "fetchAddIntArray#" GenPrimOp
MutableByteArray# s -> Int# -> Int# -> State# s -> (# State# s, Int# #)
{Given an array, and offset in Int units, and a value to add,
{Given an array, and offset in machine words, and a value to add,
atomically add the value to the element. Returns the value of the
element before the operation. Implies a full memory barrier.}
with has_side_effects = True
......@@ -1974,7 +1986,7 @@ primop FetchAddByteArrayOp_Int "fetchAddIntArray#" GenPrimOp
primop FetchSubByteArrayOp_Int "fetchSubIntArray#" GenPrimOp
MutableByteArray# s -> Int# -> Int# -> State# s -> (# State# s, Int# #)
{Given an array, and offset in Int units, and a value to subtract,
{Given an array, and offset in machine words, and a value to subtract,
atomically substract the value to the element. Returns the value of
the element before the operation. Implies a full memory barrier.}
with has_side_effects = True
......@@ -1982,7 +1994,7 @@ primop FetchSubByteArrayOp_Int "fetchSubIntArray#" GenPrimOp
primop FetchAndByteArrayOp_Int "fetchAndIntArray#" GenPrimOp
MutableByteArray# s -> Int# -> Int# -> State# s -> (# State# s, Int# #)
{Given an array, and offset in Int units, and a value to AND,
{Given an array, and offset in machine words, and a value to AND,
atomically AND the value to the element. Returns the value of the
element before the operation. Implies a full memory barrier.}
with has_side_effects = True
......@@ -1990,7 +2002,7 @@ primop FetchAndByteArrayOp_Int "fetchAndIntArray#" GenPrimOp
primop FetchNandByteArrayOp_Int "fetchNandIntArray#" GenPrimOp
MutableByteArray# s -> Int# -> Int# -> State# s -> (# State# s, Int# #)
{Given an array, and offset in Int units, and a value to NAND,
{Given an array, and offset in machine words, and a value to NAND,
atomically NAND the value to the element. Returns the value of the
element before the operation. Implies a full memory barrier.}
with has_side_effects = True
......@@ -1998,7 +2010,7 @@ primop FetchNandByteArrayOp_Int "fetchNandIntArray#" GenPrimOp
primop FetchOrByteArrayOp_Int "fetchOrIntArray#" GenPrimOp
MutableByteArray# s -> Int# -> Int# -> State# s -> (# State# s, Int# #)
{Given an array, and offset in Int units, and a value to OR,
{Given an array, and offset in machine words, and a value to OR,
atomically OR the value to the element. Returns the value of the
element before the operation. Implies a full memory barrier.}
with has_side_effects = True
......@@ -2006,7 +2018,7 @@ primop FetchOrByteArrayOp_Int "fetchOrIntArray#" GenPrimOp
primop FetchXorByteArrayOp_Int "fetchXorIntArray#" GenPrimOp
MutableByteArray# s -> Int# -> Int# -> State# s -> (# State# s, Int# #)
{Given an array, and offset in Int units, and a value to XOR,
{Given an array, and offset in machine words, and a value to XOR,
atomically XOR the value to the element. Returns the value of the
element before the operation. Implies a full memory barrier.}
with has_side_effects = True
......
docs/users_guide/8.10.1-notes.rst
View file @ 10468272
......@@ -97,3 +97,43 @@ Build system
Included libraries
------------------
The package database provided with this distribution also contains a number of
packages other than GHC itself. See the changelogs provided with these packages
for further change information.
.. ghc-package-list::
libraries/array/array.cabal: Dependency of ``ghc`` library
libraries/base/base.cabal: Core library
libraries/binary/binary.cabal: Dependency of ``ghc`` library
libraries/bytestring/bytestring.cabal: Dependency of ``ghc`` library
libraries/Cabal/Cabal/Cabal.cabal: Dependency of ``ghc-pkg`` utility
libraries/containers/containers.cabal: Dependency of ``ghc`` library
libraries/deepseq/deepseq.cabal: Dependency of ``ghc`` library
libraries/directory/directory.cabal: Dependency of ``ghc`` library
libraries/filepath/filepath.cabal: Dependency of ``ghc`` library
compiler/ghc.cabal: The compiler itself
libraries/ghci/ghci.cabal: The REPL interface
libraries/ghc-boot/ghc-boot.cabal: Internal compiler library
libraries/ghc-boot-th/ghc-boot-th.cabal: Internal compiler library
libraries/ghc-compact/ghc-compact.cabal: Core library
libraries/ghc-heap/ghc-heap.cabal: GHC heap-walking library
libraries/ghc-prim/ghc-prim.cabal: Core library
libraries/haskeline/haskeline.cabal: Dependency of ``ghci`` executable
libraries/hpc/hpc.cabal: Dependency of ``hpc`` executable
libraries/integer-gmp/integer-gmp.cabal: Core library
libraries/libiserv/libiserv.cabal: Internal compiler library
libraries/mtl/mtl.cabal: Dependency of ``Cabal`` library
libraries/parsec/parsec.cabal: Dependency of ``Cabal`` library
libraries/pretty/pretty.cabal: Dependency of ``ghc`` library
libraries/process/process.cabal: Dependency of ``ghc`` library
libraries/stm/stm.cabal: Dependency of ``haskeline`` library
libraries/template-haskell/template-haskell.cabal: Core library
libraries/terminfo/terminfo.cabal: Dependency of ``haskeline`` library
libraries/text/text.cabal: Dependency of ``Cabal`` library
libraries/time/time.cabal: Dependency of ``ghc`` library
libraries/transformers/transformers.cabal: Dependency of ``ghc`` library
libraries/unix/unix.cabal: Dependency of ``ghc`` library
libraries/Win32/Win32.cabal: Dependency of ``ghc`` library
libraries/xhtml/xhtml.cabal: Dependency of ``haddock`` executable
docs/users_guide/8.8.1-notes.rst
View file @ 10468272
......@@ -212,6 +212,7 @@ for further change information.
libraries/libiserv/libiserv.cabal: Internal compiler library
libraries/mtl/mtl.cabal: Dependency of ``Cabal`` library
libraries/parsec/parsec.cabal: Dependency of ``Cabal`` library
libraries/pretty/pretty.cabal: Dependency of ``ghc`` library
libraries/process/process.cabal: Dependency of ``ghc`` library
libraries/stm/stm.cabal: Dependency of ``haskeline`` library
libraries/template-haskell/template-haskell.cabal: Core library
......
ghc/GHCi/UI.hs
View file @ 10468272
......@@ -2146,7 +2146,9 @@ parseSpanArg s = do
let fs = mkFastString fp
span' = mkRealSrcSpan (mkRealSrcLoc fs sl sc)
(mkRealSrcLoc fs el ec)
-- End column of RealSrcSpan is the column
-- after the end of the span.
(mkRealSrcLoc fs el (ec + 1))
return (span',trailer)
where
......@@ -2192,7 +2194,9 @@ showRealSrcSpan spn = concat [ fp, ":(", show sl, ",", show sc
sl = srcSpanStartLine spn
sc = srcSpanStartCol spn
el = srcSpanEndLine spn
ec = srcSpanEndCol spn
-- The end column is the column after the end of the span see the
-- RealSrcSpan module
ec = let ec' = srcSpanEndCol spn in if ec' == 0 then 0 else ec' - 1
-----------------------------------------------------------------------------
-- | @:kind@ command
......
ghc/GHCi/UI/Info.hs
View file @ 10468272
......@@ -75,6 +75,9 @@ data SpanInfo = SpanInfo
-- locality, definition location, etc.
}
instance Outputable SpanInfo where
ppr (SpanInfo s t i) = ppr s <+> ppr t <+> ppr i
-- | Test whether second span is contained in (or equal to) first span.
-- This is basically 'containsSpan' for 'SpanInfo'
containsSpanInfo :: SpanInfo -> SpanInfo -> Bool
......
hadrian/src/Settings/Builders/RunTest.hs
View file @ 10468272
......@@ -147,6 +147,7 @@ getTestArgs = do
bindir <- expr $ getBinaryDirectory (testCompiler args)
compiler <- expr $ getCompilerPath (testCompiler args)
globalVerbosity <- shakeVerbosity <$> expr getShakeOptions
haveDocs <- areDocsPresent
let configFileArg= ["--config-file=" ++ (testConfigFile args)]
testOnlyArg = map ("--only=" ++) (testOnly args ++ testEnvTargets)
onlyPerfArg = if testOnlyPerf args
......@@ -169,7 +170,9 @@ getTestArgs = do
wayArgs = map ("--way=" ++) (testWays args)
compilerArg = ["--config", "compiler=" ++ show (compiler)]
ghcPkgArg = ["--config", "ghc_pkg=" ++ show (bindir -/- "ghc-pkg")]
haddockArg = ["--config", "haddock=" ++ show (bindir -/- "haddock")]
haddockArg = if haveDocs
then [ "--config", "haddock=" ++ show (bindir -/- "haddock") ]
else [ "--config", "haddock=" ]
hp2psArg = ["--config", "hp2ps=" ++ show (bindir -/- "hp2ps")]
hpcArg = ["--config", "hpc=" ++ show (bindir -/- "hpc")]
inTreeArg = [ "-e", "config.in_tree_compiler=" ++
......@@ -181,6 +184,17 @@ getTestArgs = do
++ configArgs ++ wayArgs ++ compilerArg ++ ghcPkgArg
++ haddockArg ++ hp2psArg ++ hpcArg ++ inTreeArg
where areDocsPresent = expr $ do
root <- buildRoot
and <$> traverse doesFileExist (docFiles root)
docFiles root =
[ root -/- "docs" -/- "html" -/- "libraries" -/- p -/- (p ++ ".haddock")
-- list of packages from
-- utils/haddock/haddock-test/src/Test/Haddock/Config.hs
| p <- [ "array", "base", "ghc-prim", "process", "template-haskell" ]
]
-- | Set speed for test
setTestSpeed :: TestSpeed -> String
setTestSpeed TestSlow = "0"
......
testsuite/tests/ghci/scripts/T16569.hs 0 → 100644
View file @ 10468272
module T16569 where
main :: IO ()
main = putStrLn (case (undefined :: Int) of _ -> undefined)
testsuite/tests/ghci/scripts/T16569.script 0 → 100644
View file @ 10468272
:set +c
:l T16569.hs
::type-at T16569.hs 4 8 4 59
testsuite/tests/ghci/scripts/T16569.stdout 0 → 100644
View file @ 10468272
Collecting type info for 1 module(s) ...
:: IO ()
testsuite/tests/ghci/scripts/all.T
View file @ 10468272
......@@ -295,3 +295,4 @@ test('T16089', normal, ghci_script, ['T16089.script'])
test('T14828', normal, ghci_script, ['T14828.script'])
test('T16376', normal, ghci_script, ['T16376.script'])
test('T16527', normal, ghci_script, ['T16527.script'])
test('T16569', normal, ghci_script, ['T16569.script'])
testsuite/tests/ghci/should_run/T15369.stdout
View file @ 10468272
Collecting type info for 1 module(s) ...
T15369.hs:(3,1)-(3,2): GHC.Types.Int
T15369.hs:(3,5)-(3,6): GHC.Types.Int
T15369.hs:(3,1)-(3,2): GHC.Types.Int
T15369.hs:(3,5)-(3,6): GHC.Types.Int
T15369.hs:(3,1)-(3,1): GHC.Types.Int
T15369.hs:(3,5)-(3,5): GHC.Types.Int
T15369.hs:(3,1)-(3,1): GHC.Types.Int
T15369.hs:(3,5)-(3,5): GHC.Types.Int
Collecting type info for 1 module(s) ...
T15369.hs:(3,1)-(3,2): GHC.Types.Double
T15369.hs:(3,5)-(3,6): GHC.Types.Double
T15369.hs:(3,1)-(3,1): GHC.Types.Double
T15369.hs:(3,5)-(3,5): GHC.Types.Double
testsuite/tests/rts/Makefile
View file @ 10468272
......@@ -16,11 +16,6 @@ outofmem2::
$(MAKE) -s --no-print-directory outofmem2-prep
@ulimit -m 1000000 2>/dev/null; ./outofmem2 +RTS -M5m -RTS || echo "exit($$?)"
T2615-prep:
$(RM) libfoo_T2615.so
'$(TEST_HC)' $(TEST_HC_OPTS) -fPIC -c libfoo_T2615.c -o libfoo_T2615.o
'$(TEST_HC)' $(filter-out -rtsopts, $(TEST_HC_OPTS)) -shared -no-auto-link-packages libfoo_T2615.o -o libfoo_T2615.so
.PHONY: T4059
T4059:
$(RM) T4059_c.o T4059.o T4059.hi
......@@ -62,38 +57,6 @@ T9405:
# | asm // manually laid out sections
# $(0) = obj-src
define run_T5435_v
$(RM) T5435_load_v_$(1) T5435_v_$(1)$(exeext)
'$(TEST_HC)' $(TEST_HC_OPTS) -optc-D$(HostOS)_HOST_OS -optc-DLOAD_CONSTR=$(2) -v0 -c T5435_$(1).c -o T5435_load_v_$(1).o
'$(TEST_HC)' $(TEST_HC_OPTS) -v0 T5435.hs -osuf main_v_$(1)_o -o T5435_v_$(1)$(exeext)
./T5435_v_$(1) v ./T5435_load_v_$(1).o
endef
define run_T5435_dyn
$(RM) T5435_load_dyn_$(1) T5435_dyn_$(1)$(exeext)
'$(TEST_HC)' $(filter-out -rtsopts, $(TEST_HC_OPTS)) -optc-D$(HostOS)_HOST_OS -v0 -fPIC -shared -c T5435_$(1).c -osuf dyn_$(1)_o -o T5435_load_dyn_$(1)$(dllext)
'$(TEST_HC)' $(TEST_HC_OPTS) -v0 T5435.hs -osuf main_dyn_$(1)_o -o T5435_dyn_$(1)$(exeext)
./T5435_dyn_$(1) dyn ./T5435_load_dyn_$(1)$(dllext)
endef
.PHONY: T5435_v_gcc
T5435_v_gcc :
$(call run_T5435_v,gcc,0)
.PHONY: T5435_v_asm_a T5435_v_asm_b
T5435_v_asm_a :
$(call run_T5435_v,asm,0)
T5435_v_asm_b :
$(call run_T5435_v,asm,1)
.PHONY: T5435_dyn_gcc
T5435_dyn_gcc :
$(call run_T5435_dyn,gcc)
.PHONY: T5435_dyn_asm
T5435_dyn_asm :
$(call run_T5435_dyn,asm)
T6006_setup :
'$(TEST_HC)' $(TEST_HC_OPTS) -c T6006.hs
......@@ -121,52 +84,6 @@ T10296a:
'$(TEST_HC)' $(TEST_HC_OPTS) -v0 -threaded T10296a.hs T10296a_c.c -o T10296a
./T10296a +RTS -N2
.PHONY: linker_unload
linker_unload:
$(RM) Test.o Test.hi
"$(TEST_HC)" $(TEST_HC_OPTS) -c Test.hs -v0
# -rtsopts causes a warning
"$(TEST_HC)" LinkerUnload.hs -package ghc $(filter-out -rtsopts, $(TEST_HC_OPTS)) linker_unload.c -o linker_unload -no-hs-main -optc-Werror
./linker_unload "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`"
# -----------------------------------------------------------------------------
# Testing failures in the RTS linker. We should be able to repeatedly
# load bogus object files of various kinds without crashing and
# without any memory leaks.
#
# Check for memory leaks manually by running e.g.
#
# make linker_error1
# valgrind --leak-check=full --show-reachable=yes ./linker_error1 linker_error1_o.o
# linker_error1: not a valid object file
.PHONY: linker_error1
linker_error1:
"$(TEST_HC)" -c linker_error.c -o linker_error1.o
"$(TEST_HC)" linker_error1.o -o linker_error1 -no-hs-main -optc-g -debug -threaded
./linker_error1 linker_error.c
# linker_error2: the object file has an unknown symbol (fails in
# resolveObjs())
.PHONY: linker_error2
linker_error2:
"$(TEST_HC)" -c linker_error.c -o linker_error2.o
"$(TEST_HC)" -c linker_error2.c -o linker_error2_o.o
"$(TEST_HC)" linker_error2.o -o linker_error2 -no-hs-main -optc-g -debug -threaded
./linker_error2 linker_error2_o.o
# linker_error3: the object file duplicates an existing symbol (fails
# in loadObj())
.PHONY: linker_error3
linker_error3:
"$(TEST_HC)" -c linker_error.c -o linker_error3.o
"$(TEST_HC)" -c linker_error3.c -o linker_error3_o.o
"$(TEST_HC)" linker_error3.o -o linker_error3 -no-hs-main -optc-g -debug -threaded
./linker_error3 linker_error3_o.o
.PHONY: T11788
T11788:
"$(TEST_HC)" -c T11788.c -o T11788_obj.o
......
testsuite/tests/rts/all.T
View file @ 10468272
......@@ -119,21 +119,6 @@ test('rtsflags001', [ only_ways(['normal']), exit_code(1), extra_run_opts('+RTS
# Crashed with 7.2 and earlier
test('rtsflags002', [ only_ways(['normal']) ], compile_and_run, ['-with-rtsopts="-B -B -B"'])
# Test to see if linker scripts link properly to real ELF files
test('T2615',
[extra_files(['libfoo_T2615.c', 'libfoo_script_T2615.so']),
when(opsys('mingw32'), skip),
# OS X doesn't seem to support linker scripts
when(opsys('darwin'), skip),
# Solaris' linker does not support GNUish linker scripts
when(opsys('solaris2'), skip),
pre_cmd('$MAKE -s --no-print-directory T2615-prep'),
# Add current directory to dlopen search path
cmd_prefix('LD_LIBRARY_PATH=$LD_LIBRARY_PATH:. '),
extra_clean(['libfoo_T2615.so', 'libfoo_T2615.o'])],
compile_and_run,
['-package ghc'])
# omit dyn and profiling ways, because we don't build dyn_l or p_l
# variants of the RTS by default
test('traceEvent', [ omit_ways(['dyn', 'ghci'] + prof_ways),
......@@ -185,49 +170,6 @@ test('T5250', [extra_files(['spalign.c']),
test('T5423', [], makefile_test, ['T5423'])
# Workaround bug #8458: old dlopen opens sections in the wrong order,
# so we just accept both orders.
def checkDynAsm(actual_file, normaliser):
actual_raw = read_no_crs(actual_file)
actual_str = normaliser(actual_raw)
actual = actual_str.split()
if actual == ['initArray1', 'initArray2', 'success']:
return True
elif opsys('darwin') and actual == ['modInitFunc1', 'modInitFunc2', 'success']:
return True
elif opsys('mingw32') and actual == ['ctors1', 'ctors2', 'success']:
return True
else:
if_verbose(1, 'T5435_dyn_asm failed with %s, see all.T for details' % actual)
return False
# T5435_v_asm got split into two tests because depending
# on the linker, .init_array and .ctors sections are loaded
# in a different order (but all entries within a section
# do get loaded in a deterministic order). So we test each
# separately now.
# These should have extra_clean() arguments, but I need
# to somehow extract out the name of DLLs to do that
test('T5435_v_asm_a', [extra_files(['T5435.hs', 'T5435_asm.c']),
when(arch('powerpc64') or arch('powerpc64le'),
expect_broken(11259))],
makefile_test, ['T5435_v_asm_a'])
# this one just needs to run on linux, as darwin/mingw32 are covered
# by the _a test already.
test('T5435_v_asm_b', [extra_files(['T5435.hs', 'T5435_asm.c']),
when(arch('powerpc64') or arch('powerpc64le'),
expect_broken(11259)),
when(opsys('darwin') or opsys('mingw32'), skip)],
makefile_test, ['T5435_v_asm_b'])
test('T5435_v_gcc', [extra_files(['T5435.hs', 'T5435_gcc.c']),
when(arch('powerpc64') or arch('powerpc64le'),
expect_broken(11259))],
makefile_test, ['T5435_v_gcc'])
test('T5435_dyn_asm', [extra_files(['T5435.hs', 'T5435_asm.c']),
check_stdout(checkDynAsm)],
makefile_test, ['T5435_dyn_asm'])
test('T5435_dyn_gcc', extra_files(['T5435.hs', 'T5435_gcc.c']) , makefile_test, ['T5435_dyn_gcc'])
test('T5993', extra_run_opts('+RTS -k8 -RTS'), compile_and_run, [''])
test('T6006', [ omit_ways(prof_ways + ['ghci']),
......@@ -277,11 +219,6 @@ test('T7919', [when(fast(), skip), omit_ways(prof_ways)], compile_and_run,
test('T8035', normal, compile_and_run, [''])
test('linker_unload',
[extra_files(['LinkerUnload.hs', 'Test.hs']),
when(arch('powerpc64') or arch('powerpc64le'), expect_broken(11259))],
makefile_test, ['linker_unload'])
test('T8209', [ req_smp, only_ways(threaded_ways), ignore_stdout ],
compile_and_run, [''])
......@@ -312,13 +249,6 @@ test('T10017', [ when(opsys('mingw32'), skip)
test('T11108', normal, compile_and_run, [''])
test('rdynamic', [ unless(opsys('linux') or opsys('mingw32'), skip)
# this needs runtime infrastructure to do in ghci:
# '-rdynamic' ghc, load modules only via dlopen(RTLD_BLOBAL) and more.
, omit_ways(['ghci'])
],
compile_and_run, ['-rdynamic -package ghc'])
test('GcStaticPointers', [when(doing_ghci(), extra_hc_opts('-fobject-code'))],
compile_and_run, [''])
test('ListStaticPointers', [when(doing_ghci(), extra_hc_opts('-fobject-code'))],
......@@ -330,15 +260,6 @@ test('overflow1', [ exit_code(251), when(wordsize(32), expect_broken(15255)) ],
test('overflow2', [ exit_code(251) ], compile_and_run, [''])
test('overflow3', [ exit_code(251) ], compile_and_run, [''])
test('linker_error1', [extra_files(['linker_error.c']),
ignore_stderr], makefile_test, ['linker_error1'])
test('linker_error2', [extra_files(['linker_error.c']),
ignore_stderr], makefile_test, ['linker_error2'])
test('linker_error3', [extra_files(['linker_error.c']),
ignore_stderr], makefile_test, ['linker_error3'])
def grep_stderr(pattern):
def wrapper(cmd, pattern=pattern):
swap12 = '3>&1 1>&2 2>&3 3>&-' # Swap file descriptors 1 and 2.
......
testsuite/tests/rts/linker/Makefile
View file @ 10468272
......@@ -11,3 +11,88 @@ section_alignment:
cc -c -o section_alignment.o section_alignment.c
'$(TEST_HC)' $(TEST_HC_OPTS_NO_RTSOPTS) -v0 --make -no-rtsopts-suggestions -no-hs-main -o runner runner.c
./runner section_alignment.o isAligned
T2615-prep:
$(RM) libfoo_T2615.so
'$(TEST_HC)' $(TEST_HC_OPTS) -fPIC -c libfoo_T2615.c -o libfoo_T2615.o
'$(TEST_HC)' $(filter-out -rtsopts, $(TEST_HC_OPTS)) -shared -no-auto-link-packages libfoo_T2615.o -o libfoo_T2615.so
#--------------------------------------------------------------------
define run_T5435_v
$(RM) T5435_load_v_$(1) T5435_v_$(1)$(exeext)
'$(TEST_HC)' $(TEST_HC_OPTS) -optc-D$(HostOS)_HOST_OS -optc-DLOAD_CONSTR=$(2) -v0 -c T5435_$(1).c -o T5435_load_v_$(1).o
'$(TEST_HC)' $(TEST_HC_OPTS) -v0 T5435.hs -osuf main_v_$(1)_o -o T5435_v_$(1)$(exeext)
./T5435_v_$(1) v ./T5435_load_v_$(1).o
endef
define run_T5435_dyn
$(RM) T5435_load_dyn_$(1) T5435_dyn_$(1)$(exeext)
'$(TEST_HC)' $(filter-out -rtsopts, $(TEST_HC_OPTS)) -optc-D$(HostOS)_HOST_OS -v0 -fPIC -shared -c T5435_$(1).c -osuf dyn_$(1)_o -o T5435_load_dyn_$(1)$(dllext)
'$(TEST_HC)' $(TEST_HC_OPTS) -v0 T5435.hs -osuf main_dyn_$(1)_o -o T5435_dyn_$(1)$(exeext)
./T5435_dyn_$(1) dyn ./T5435_load_dyn_$(1)$(dllext)
endef
.PHONY: T5435_v_gcc
T5435_v_gcc :
$(call run_T5435_v,gcc,0)
.PHONY: T5435_v_asm_a T5435_v_asm_b
T5435_v_asm_a :
$(call run_T5435_v,asm,0)
T5435_v_asm_b :
$(call run_T5435_v,asm,1)
.PHONY: T5435_dyn_gcc
T5435_dyn_gcc :
$(call run_T5435_dyn,gcc)
.PHONY: T5435_dyn_asm
T5435_dyn_asm :
$(call run_T5435_dyn,asm)
#--------------------------------------------------------------------
.PHONY: linker_unload
linker_unload:
$(RM) Test.o Test.hi
"$(TEST_HC)" $(TEST_HC_OPTS) -c Test.hs -v0
# -rtsopts causes a warning
"$(TEST_HC)" LinkerUnload.hs -package ghc $(filter-out -rtsopts, $(TEST_HC_OPTS)) linker_unload.c -o linker_unload -no-hs-main -optc-Werror
./linker_unload "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`"
# -----------------------------------------------------------------------------
# Testing failures in the RTS linker. We should be able to repeatedly
# load bogus object files of various kinds without crashing and
# without any memory leaks.
#
# Check for memory leaks manually by running e.g.
#
# make linker_error1
# valgrind --leak-check=full --show-reachable=yes ./linker_error1 linker_error1_o.o
# linker_error1: not a valid object file
.PHONY: linker_error1
linker_error1:
"$(TEST_HC)" -c linker_error.c -o linker_error1.o
"$(TEST_HC)" linker_error1.o -o linker_error1 -no-hs-main -optc-g -debug -threaded
./linker_error1 linker_error.c
# linker_error2: the object file has an unknown symbol (fails in
# resolveObjs())
.PHONY: linker_error2
linker_error2:
"$(TEST_HC)" -c linker_error.c -o linker_error2.o
"$(TEST_HC)" -c linker_error2.c -o linker_error2_o.o
"$(TEST_HC)" linker_error2.o -o linker_error2 -no-hs-main -optc-g -debug -threaded
./linker_error2 linker_error2_o.o
# linker_error3: the object file duplicates an existing symbol (fails
# in loadObj())
.PHONY: linker_error3
linker_error3:
"$(TEST_HC)" -c linker_error.c -o linker_error3.o
"$(TEST_HC)" -c linker_error3.c -o linker_error3_o.o
"$(TEST_HC)" linker_error3.o -o linker_error3 -no-hs-main -optc-g -debug -threaded
./linker_error3 linker_error3_o.o