[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: testsuite: Drop --io-manager flag from testsuite configuration
Marge Bot
gitlab at gitlab.haskell.org
Tue Aug 18 14:38:59 UTC 2020
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
9f66fdf6 by Ben Gamari at 2020-08-14T15:50:34-04:00
testsuite: Drop --io-manager flag from testsuite configuration
This is no longer necessary as there are now dedicated testsuite ways
which run tests with WinIO.
- - - - -
55fd1dc5 by Ben Gamari at 2020-08-14T15:51:10-04:00
llvm-targets: Add i686 targets
Addresses #18422.
- - - - -
39fd5279 by Ben Gamari at 2020-08-18T10:38:46-04:00
Allow unsaturated runRW# applications
Previously we had a very aggressive Core Lint check which caught
unsaturated applications of runRW#. However, there is nothing
wrong with such applications and they may naturally arise in desugared
Core. For instance, the desugared Core of Data.Primitive.Array.runArray#
from the `primitive` package contains:
case ($) (runRW# @_ @_) (\s -> ...) of ...
In this case it's almost certain that ($) will be inlined, turning the
application into a saturated application. However, even if this weren't
the case there isn't a problem: CorePrep (after deleting an unnecessary
case) can simply generate code in its usual way, resulting in a call to
the Haskell definition of runRW#.
Fixes #18291.
- - - - -
7481f277 by Ben Gamari at 2020-08-18T10:38:46-04:00
testsuite: Add test for #18291
- - - - -
a0ff7cd7 by Eli Schwartz at 2020-08-18T10:38:48-04:00
install: do not install sphinx doctrees
These files are 100% not needed at install time, and they contain
unreproducible info. See https://reproducible-builds.org/ for why this
matters.
- - - - -
bc966241 by Ben Gamari at 2020-08-18T10:38:48-04:00
testsuite: Allow baseline commit to be set explicitly
- - - - -
f2d04708 by Ben Gamari at 2020-08-18T10:38:48-04:00
gitlab-ci: Use MR base commit as performance baseline
- - - - -
2330b4b9 by Fendor at 2020-08-18T10:38:50-04:00
Expose UnitInfoMap as it is part of the public API
- - - - -
18 changed files:
- .gitlab-ci.yml
- .gitlab/ci.sh
- compiler/GHC/Core/Lint.hs
- compiler/GHC/Core/Opt/Simplify.hs
- compiler/GHC/CoreToStg/Prep.hs
- compiler/GHC/Unit/State.hs
- ghc.mk
- hadrian/src/Settings/Builders/RunTest.hs
- libraries/ghc-prim/GHC/Magic.hs
- llvm-targets
- testsuite/driver/perf_notes.py
- testsuite/driver/runtests.py
- testsuite/driver/testglobals.py
- testsuite/driver/testlib.py
- testsuite/mk/test.mk
- + testsuite/tests/codeGen/should_compile/T18291.hs
- testsuite/tests/codeGen/should_compile/all.T
- utils/llvm-targets/gen-data-layout.sh
Changes:
=====================================
.gitlab-ci.yml
=====================================
@@ -26,12 +26,28 @@ stages:
- testing # head.hackage correctness and compiler performance testing
- deploy # push documentation
+# Note [The CI Story]
+# ~~~~~~~~~~~~~~~~~~~
+#
+# There are two different types of pipelines:
+#
+# - marge-bot merges to `master`. Here we perform an exhaustive validation
+# across all of the platforms which we support. In addition, we push
+# performance metric notes upstream, providing a persistent record of the
+# performance characteristics of the compiler.
+#
+# - merge requests. Here we perform a slightly less exhaustive battery of
+# testing. Namely we omit some configurations (e.g. the unregisterised job).
+# These use the merge request's base commit for performance metric
+# comparisons.
+#
+
workflow:
- # N.B.Don't run on wip/ branches, instead on run on merge requests.
+ # N.B. Don't run on wip/ branches, instead on run on merge requests.
rules:
- if: $CI_MERGE_REQUEST_ID
- if: $CI_COMMIT_TAG
- - if: '$CI_COMMIT_BRANCH == "master"'
+ - if: '$CI_COMMIT_BRANCH == "wip/marge_bot_batch_merge_job"'
- if: '$CI_COMMIT_BRANCH =~ /ghc-[0.9]+\.[0-9]+/'
- if: '$CI_PIPELINE_SOURCE == "web"'
=====================================
.gitlab/ci.sh
=====================================
@@ -363,6 +363,13 @@ function push_perf_notes() {
"$TOP/.gitlab/test-metrics.sh" push
}
+# Figure out which commit should be used by the testsuite driver as a
+# performance baseline. See Note [The CI Story].
+function determine_metric_baseline() {
+ export PERF_BASELINE_COMMIT="$(git merge-base $CI_MERGE_REQUEST_TARGET_BRANCH_NAME HEAD)"
+ info "Using $PERF_BASELINE_COMMIT for performance metric baseline..."
+}
+
function test_make() {
run "$MAKE" test_bindist TEST_PREP=YES
run "$MAKE" V=0 test \
=====================================
compiler/GHC/Core/Lint.hs
=====================================
@@ -731,8 +731,6 @@ lintJoinLams join_arity enforce rhs
where
go 0 expr = lintCoreExpr expr
go n (Lam var body) = lintLambda var $ go (n-1) body
- -- N.B. join points can be cast. e.g. we consider ((\x -> ...) `cast` ...)
- -- to be a join point at join arity 1.
go n expr | Just bndr <- enforce -- Join point with too few RHS lambdas
= failWithL $ mkBadJoinArityMsg bndr join_arity n rhs
| otherwise -- Future join point, not yet eta-expanded
@@ -781,36 +779,26 @@ hurts us here.
Note [Linting of runRW#]
~~~~~~~~~~~~~~~~~~~~~~~~
-runRW# has some very peculiar behavior (see Note [runRW magic] in
-GHC.CoreToStg.Prep) which CoreLint must accommodate.
+runRW# has some very special behavior (see Note [runRW magic] in
+GHC.CoreToStg.Prep) which CoreLint must accommodate, by allowing
+join points in its argument. For example, this is fine:
-As described in Note [Casts and lambdas] in
-GHC.Core.Opt.Simplify.Utils, the simplifier pushes casts out of
-lambdas. Concretely, the simplifier will transform
+ join j x = ...
+ in runRW# (\s. case v of
+ A -> j 3
+ B -> j 4)
- runRW# @r @ty (\s -> expr `cast` co)
+Usually those calls to the join point 'j' would not be valid tail calls,
+because they occur in a function argument. But in the case of runRW#
+they are fine, because runRW# (\s.e) behaves operationally just like e.
+(runRW# is ultimately inlined in GHC.CoreToStg.Prep.)
-into
-
- runRW# @r @ty ((\s -> expr) `cast` co)
-
-Consequently we need to handle the case that the continuation is a
-cast of a lambda. See Note [Casts and lambdas] in
-GHC.Core.Opt.Simplify.Utils.
-
-In the event that the continuation is headed by a lambda (which
-will bind the State# token) we can safely allow calls to join
-points since CorePrep is going to apply the continuation to
-RealWorld.
-
-In the case that the continuation is not a lambda we lint the
-continuation disallowing join points, to rule out things like,
+In the case that the continuation is /not/ a lambda we simply disable this
+special behaviour. For example, this is /not/ fine:
join j = ...
- in runRW# @r @ty (
- let x = jump j
- in x
- )
+ in runRW# @r @ty (jump j)
+
************************************************************************
@@ -931,10 +919,6 @@ lintCoreExpr e@(App _ _)
; (fun_ty2, ue2) <- lintCoreArg fun_pair1 arg_ty2
-- See Note [Linting of runRW#]
; let lintRunRWCont :: CoreArg -> LintM (LintedType, UsageEnv)
- lintRunRWCont (Cast expr co) = do
- (ty, ue) <- lintRunRWCont expr
- new_ty <- lintCastExpr expr ty co
- return (new_ty, ue)
lintRunRWCont expr@(Lam _ _) = do
lintJoinLams 1 (Just fun) expr
lintRunRWCont other = markAllJoinsBad $ lintCoreExpr other
@@ -943,10 +927,6 @@ lintCoreExpr e@(App _ _)
; app_ty <- lintValApp arg3 fun_ty2 arg3_ty ue2 ue3
; lintCoreArgs app_ty rest }
- | Var fun <- fun
- , fun `hasKey` runRWKey
- = failWithL (text "Invalid runRW# application")
-
| otherwise
= do { pair <- lintCoreFun fun (length args)
; lintCoreArgs pair args }
=====================================
compiler/GHC/Core/Opt/Simplify.hs
=====================================
@@ -1972,8 +1972,10 @@ rebuildCall env info (ApplyToTy { sc_arg_ty = arg_ty, sc_hole_ty = hole_ty, sc_c
= rebuildCall env (addTyArgTo info arg_ty hole_ty) cont
---------- The runRW# rule. Do this after absorbing all arguments ------
+-- See Note [Simplification of runRW#] in GHC.CoreToSTG.Prep.
+--
-- runRW# :: forall (r :: RuntimeRep) (o :: TYPE r). (State# RealWorld -> o) -> o
--- K[ runRW# rr ty body ] --> runRW rr' ty' (\s. K[ body s ])
+-- K[ runRW# rr ty body ] --> runRW rr' ty' (\s. K[ body s ])
rebuildCall env (ArgInfo { ai_fun = fun_id, ai_args = rev_args })
(ApplyToVal { sc_arg = arg, sc_env = arg_se
, sc_cont = cont, sc_hole_ty = fun_ty })
=====================================
compiler/GHC/CoreToStg/Prep.hs
=====================================
@@ -723,18 +723,6 @@ instance Outputable ArgInfo where
ppr (CpeCast co) = text "cast" <+> ppr co
ppr (CpeTick tick) = text "tick" <+> ppr tick
-{-
- Note [runRW arg]
-~~~~~~~~~~~~~~~~~~~
-If we got, say
- runRW# (case bot of {})
-which happened in #11291, we do /not/ want to turn it into
- (case bot of {}) realWorldPrimId#
-because that gives a panic in CoreToStg.myCollectArgs, which expects
-only variables in function position. But if we are sure to make
-runRW# strict (which we do in GHC.Types.Id.Make), this can't happen
--}
-
cpeApp :: CorePrepEnv -> CoreExpr -> UniqSM (Floats, CpeRhs)
-- May return a CpeRhs because of saturating primops
cpeApp top_env expr
@@ -800,10 +788,6 @@ cpeApp top_env expr
_ -> cpe_app env arg (CpeApp (Var realWorldPrimId) : rest) (n-1)
-- TODO: What about casts?
- cpe_app _env (Var f) args n
- | f `hasKey` runRWKey
- = pprPanic "cpe_app(runRW#)" (ppr args $$ ppr n)
-
cpe_app env (Var v) args depth
= do { v1 <- fiddleCCall v
; let e2 = lookupCorePrepEnv env v1
@@ -925,34 +909,96 @@ optimization (right before lowering to STG, in CorePrep), we can ensure that
no further floating will occur. This allows us to safely inline things like
@runST@, which are otherwise needlessly expensive (see #10678 and #5916).
-'runRW' is defined (for historical reasons) in GHC.Magic, with a NOINLINE
-pragma. It is levity-polymorphic.
+'runRW' has a variety of quirks:
+
+ * 'runRW' is known-key with a NOINLINE definition in
+ GHC.Magic. This definition is used in cases where runRW is curried.
+
+ * In addition to its normal Haskell definition in GHC.Magic, we give it
+ a special late inlining here in CorePrep and GHC.CoreToByteCode, avoiding
+ the incorrect sharing due to float-out noted above.
+
+ * It is levity-polymorphic:
runRW# :: forall (r1 :: RuntimeRep). (o :: TYPE r)
=> (State# RealWorld -> (# State# RealWorld, o #))
- -> (# State# RealWorld, o #)
+ -> (# State# RealWorld, o #)
+
+ * It has some special simplification logic to allow unboxing of results when
+ runRW# appears in a strict context. See Note [Simplification of runRW#]
+ below.
+
+ * Since its body is inlined, we allow runRW#'s argument to contain jumps to
+ join points. That is, the following is allowed:
+
+ join j x = ...
+ in runRW# @_ @_ (\s -> ... jump j 42 ...)
+
+ The Core Linter knows about this. See Note [Linting of runRW#] in
+ GHC.Core.Lint for details.
+
+ The occurrence analyser and SetLevels also know about this, as described in
+ Note [Simplification of runRW#].
+
+Other relevant Notes:
-It's correctness needs no special treatment in GHC except this special inlining
-here in CorePrep (and in GHC.CoreToByteCode).
+ * Note [Simplification of runRW#] below, describing a transformation of runRW
+ applications in strict contexts performed by the simplifier.
+ * Note [Linting of runRW#] in GHC.Core.Lint
+ * Note [runRW arg] below, describing a non-obvious case where the
+ late-inlining could go wrong.
-However, there are a variety of optimisation opportunities that the simplifier
-takes advantage of. See Note [Simplification of runRW#].
+
+ Note [runRW arg]
+~~~~~~~~~~~~~~~~~~~
+Consider the Core program (from #11291),
+
+ runRW# (case bot of {})
+
+The late inlining logic in cpe_app would transform this into:
+
+ (case bot of {}) realWorldPrimId#
+
+Which would rise to a panic in CoreToStg.myCollectArgs, which expects only
+variables in function position.
+
+However, as runRW#'s strictness signature captures the fact that it will call
+its argument this can't happen: the simplifier will transform the bottoming
+application into simply (case bot of {}).
+
+Note that this reasoning does *not* apply to non-bottoming continuations like:
+
+ hello :: Bool -> Int
+ hello n =
+ runRW# (
+ case n of
+ True -> \s -> 23
+ _ -> \s -> 10)
+
+Why? The difference is that (case bot of {}) is considered by okCpeArg to be
+trivial, consequently cpeArg (which the catch-all case of cpe_app calls on both
+the function and the arguments) will forgo binding it to a variable. By
+contrast, in the non-bottoming case of `hello` above the function will be
+deemed non-trivial and consequently will be case-bound.
Note [Simplification of runRW#]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider the program,
- case runRW# (\s -> let n = I# 42# in n) of
+ case runRW# (\s -> I# 42#) of
I# n# -> f n#
There is no reason why we should allocate an I# constructor given that we
-immediately destructure it. To avoid this the simplifier will push strict
-contexts into runRW's continuation. That is, it transforms
+immediately destructure it.
+
+To avoid this the simplifier has a special transformation rule, specific to
+runRW#, that pushes a strict context into runRW#'s continuation. See the
+`runRW#` guard in `GHC.Core.Opt.Simplify.rebuildCall`. That is, it transforms
K[ runRW# @r @ty cont ]
~>
- runRW# @r @ty K[cont]
+ runRW# @r @ty (\s -> K[cont s])
This has a few interesting implications. Consider, for instance, this program:
@@ -971,15 +1017,29 @@ Performing the transform described above would result in:
If runRW# were a "normal" function this call to join point j would not be
allowed in its continuation argument. However, since runRW# is inlined (as
described in Note [runRW magic] above), such join point occurences are
-completely fine. Both occurrence analysis and Core Lint have special treatment
-for runRW# applications. See Note [Linting of runRW#] for details on the latter.
+completely fine. Both occurrence analysis (see the runRW guard in occAnalApp)
+and Core Lint (see the App case of lintCoreExpr) have special treatment for
+runRW# applications. See Note [Linting of runRW#] for details on the latter.
Moreover, it's helpful to ensure that runRW's continuation isn't floated out
-(since doing so would then require a call, whereas we would otherwise end up
-with straight-line). Consequently, GHC.Core.Opt.SetLevels.lvlApp has special
-treatment for runRW# applications, ensure the arguments are not floated if
+For instance, if we have
+
+ runRW# (\s -> do_something)
+
+where do_something contains only top-level free variables, we may be tempted to
+float the argument to the top-level. However, we must resist this urge as since
+doing so would then require that runRW# produce an allocation and call, e.g.:
+
+ let lvl = \s -> do_somethign
+ in
+ ....(runRW# lvl)....
+
+whereas without floating the inlining of the definition of runRW would result
+in straight-line code. Consequently, GHC.Core.Opt.SetLevels.lvlApp has special
+treatment for runRW# applications, ensure the arguments are not floated as
MFEs.
+
Other considered designs
------------------------
=====================================
compiler/GHC/Unit/State.hs
=====================================
@@ -18,6 +18,7 @@ module GHC.Unit.State (
listUnitInfo,
-- * Querying the package config
+ UnitInfoMap,
lookupUnit,
lookupUnit',
unsafeLookupUnit,
=====================================
ghc.mk
=====================================
@@ -934,6 +934,11 @@ ifneq "$(INSTALL_HTML_DOC_DIRS)" ""
for i in $(INSTALL_HTML_DOC_DIRS); do \
$(CP) -Rp $$i "$(DESTDIR)$(docdir)/html"; \
done
+ for i in "$(DESTDIR)$(docdir)/html"/*/.doctrees; do \
+ if [ -d "$$i" ]; then \
+ rm -r "$$i"; \
+ fi \
+ done
endif
INSTALLED_PACKAGE_CONF=$(DESTDIR)$(topdir)/package.conf.d
=====================================
hadrian/src/Settings/Builders/RunTest.hs
=====================================
@@ -78,6 +78,7 @@ runTestBuilderArgs = builder RunTest ? do
<*> (maybe False (=="YES") <$> lookupEnv "OS")
(testEnv, testMetricsFile) <- expr . liftIO $
(,) <$> lookupEnv "TEST_ENV" <*> lookupEnv "METRICS_FILE"
+ perfBaseline <- expr . liftIO $ lookupEnv "PERF_BASELINE_COMMIT"
threads <- shakeThreads <$> expr getShakeOptions
os <- getTestSetting TestHostOS
@@ -141,6 +142,9 @@ runTestBuilderArgs = builder RunTest ? do
, arg "--config", arg $ "timeout_prog=" ++ show (top -/- timeoutProg)
, arg "--config", arg $ "stats_files_dir=" ++ statsFilesDir
, arg $ "--threads=" ++ show threads
+ , case perfBaseline of
+ Just commit | not (null commit) -> arg ("--perf-baseline=" ++ show commit)
+ _ -> mempty
, emitWhenSet testEnv $ \env -> arg ("--test-env=" ++ show env)
, emitWhenSet testMetricsFile $ \file -> arg ("--metrics-file=" ++ file)
, getTestArgs -- User-provided arguments from command line.
=====================================
libraries/ghc-prim/GHC/Magic.hs
=====================================
@@ -122,7 +122,7 @@ oneShot f = f
runRW# :: forall (r :: RuntimeRep) (o :: TYPE r).
(State# RealWorld -> o) -> o
--- See Note [runRW magic] in CorePrep
+-- See Note [runRW magic] in GHC.CoreToStg.Prep.
{-# NOINLINE runRW# #-} -- runRW# is inlined manually in CorePrep
#if !defined(__HADDOCK_VERSION__)
runRW# m = m realWorld#
=====================================
llvm-targets
=====================================
@@ -24,6 +24,9 @@
,("i386-unknown-linux-gnu", ("e-m:e-p:32:32-f64:32:64-f80:32-n8:16:32-S128", "pentium4", ""))
,("i386-unknown-linux-musl", ("e-m:e-p:32:32-f64:32:64-f80:32-n8:16:32-S128", "pentium4", ""))
,("i386-unknown-linux", ("e-m:e-p:32:32-f64:32:64-f80:32-n8:16:32-S128", "pentium4", ""))
+,("i686-unknown-linux-gnu", ("e-m:e-p:32:32-f64:32:64-f80:32-n8:16:32-S128", "pentium4", ""))
+,("i686-unknown-linux-musl", ("e-m:e-p:32:32-f64:32:64-f80:32-n8:16:32-S128", "pentium4", ""))
+,("i686-unknown-linux", ("e-m:e-p:32:32-f64:32:64-f80:32-n8:16:32-S128", "pentium4", ""))
,("x86_64-unknown-linux-gnu", ("e-m:e-i64:64-f80:128-n8:16:32:64-S128", "x86-64", ""))
,("x86_64-unknown-linux-musl", ("e-m:e-i64:64-f80:128-n8:16:32:64-S128", "x86-64", ""))
,("x86_64-unknown-linux", ("e-m:e-i64:64-f80:128-n8:16:32:64-S128", "x86-64", ""))
=====================================
testsuite/driver/perf_notes.py
=====================================
@@ -76,8 +76,7 @@ PerfStat = NamedTuple('PerfStat', [('test_env', TestEnv),
# A baseline recovered form stored metrics.
Baseline = NamedTuple('Baseline', [('perfStat', PerfStat),
- ('commit', GitHash),
- ('commitDepth', int)])
+ ('commit', GitHash)])
class MetricChange(Enum):
# The metric appears to have no baseline and is presumably a new test.
@@ -402,7 +401,8 @@ def baseline_metric(commit: GitHash,
name: TestName,
test_env: TestEnv,
metric: MetricName,
- way: WayName
+ way: WayName,
+ baseline_ref: Optional[GitRef]
) -> Optional[Baseline]:
# For performance reasons (in order to avoid calling commit_hash), we assert
# commit is already a commit hash.
@@ -411,6 +411,8 @@ def baseline_metric(commit: GitHash,
# Get all recent commit hashes.
commit_hashes = baseline_commit_log(commit)
+ baseline_commit = commit_hash(baseline_ref) if baseline_ref else None
+
def has_expected_change(commit: GitHash) -> bool:
return get_allowed_perf_changes(commit).get(name) is not None
@@ -418,11 +420,18 @@ def baseline_metric(commit: GitHash,
def find_baseline(namespace: NoteNamespace,
test_env: TestEnv
) -> Optional[Baseline]:
+ if baseline_commit is not None:
+ current_metric = get_commit_metric(namespace, baseline_commit, test_env, name, metric, way)
+ if current_metric is not None:
+ return Baseline(current_metric, baseline_commit)
+ else:
+ return None
+
for depth, current_commit in list(enumerate(commit_hashes))[1:]:
# Check for a metric on this commit.
current_metric = get_commit_metric(namespace, current_commit, test_env, name, metric, way)
if current_metric is not None:
- return Baseline(current_metric, current_commit, depth)
+ return Baseline(current_metric, current_commit)
# Stop if there is an expected change at this commit. In that case
# metrics on ancestor commits will not be a valid baseline.
@@ -552,7 +561,7 @@ def check_stats_change(actual: PerfStat,
result = passed()
if not change_allowed:
error = str(change) + ' from ' + baseline.perfStat.test_env + \
- ' baseline @ HEAD~' + str(baseline.commitDepth)
+ ' baseline @ %s' % baseline.commit
print(actual.metric, error + ':')
result = failBecause('stat ' + error, tag='stat')
=====================================
testsuite/driver/runtests.py
=====================================
@@ -27,7 +27,7 @@ from testutil import getStdout, Watcher, str_warn, str_info
from testglobals import getConfig, ghc_env, getTestRun, TestConfig, \
TestOptions, brokens, PerfMetric
from my_typing import TestName
-from perf_notes import MetricChange, inside_git_repo, is_worktree_dirty, format_perf_stat
+from perf_notes import MetricChange, GitRef, inside_git_repo, is_worktree_dirty, format_perf_stat
from junit import junit
import term_color
from term_color import Color, colored
@@ -70,6 +70,7 @@ parser.add_argument("--verbose", type=int, choices=[0,1,2,3,4,5], help="verbose
parser.add_argument("--junit", type=argparse.FileType('wb'), help="output testsuite summary in JUnit format")
parser.add_argument("--broken-test", action="append", default=[], help="a test name to mark as broken for this run")
parser.add_argument("--test-env", default='local', help="Override default chosen test-env.")
+parser.add_argument("--perf-baseline", type=GitRef, metavar='COMMIT', help="Baseline commit for performance comparsons.")
perf_group.add_argument("--skip-perf-tests", action="store_true", help="skip performance tests")
perf_group.add_argument("--only-perf-tests", action="store_true", help="Only do performance tests")
@@ -101,6 +102,7 @@ config.metrics_file = args.metrics_file
hasMetricsFile = config.metrics_file is not None
config.summary_file = args.summary_file
config.no_print_summary = args.no_print_summary
+config.baseline_commit = args.perf_baseline
if args.only:
config.only = args.only
@@ -351,8 +353,8 @@ def tabulate_metrics(metrics: List[PerfMetric]) -> None:
rel = 100 * (val1 - val0) / val0
print("{space:24} {herald:40} {value:15.3f} [{direction}, {rel:2.1f}%]".format(
space = "",
- herald = "(baseline @ HEAD~{depth})".format(
- depth = metric.baseline.commitDepth),
+ herald = "(baseline @ {commit})".format(
+ commit = metric.baseline.commit),
value = val0,
direction = metric.change,
rel = rel
@@ -422,6 +424,8 @@ else:
# Dump metrics data.
print("\nPerformance Metrics (test environment: {}):\n".format(config.test_env))
+ if config.baseline_commit:
+ print('Performance baseline: %s\n' % config.baseline_commit)
if any(t.metrics):
tabulate_metrics(t.metrics)
else:
@@ -477,19 +481,19 @@ else:
summary(t, sys.stdout, config.no_print_summary, config.supports_colors)
# Write perf stats if any exist or if a metrics file is specified.
- stats = [stat for (_, stat, __) in t.metrics]
+ stats_metrics = [stat for (_, stat, __) in t.metrics] # type: List[PerfStat]
if hasMetricsFile:
- print('Appending ' + str(len(stats)) + ' stats to file: ' + config.metrics_file)
+ print('Appending ' + str(len(stats_metrics)) + ' stats to file: ' + config.metrics_file)
with open(config.metrics_file, 'a') as f:
- f.write("\n" + Perf.format_perf_stat(stats))
- elif inside_git_repo() and any(stats):
+ f.write("\n" + Perf.format_perf_stat(stats_metrics))
+ elif inside_git_repo() and any(stats_metrics):
if is_worktree_dirty():
print()
print(str_warn('Performance Metrics NOT Saved') + \
' working tree is dirty. Commit changes or use ' + \
'--metrics-file to save metrics to a file.')
else:
- Perf.append_perf_stat(stats)
+ Perf.append_perf_stat(stats_metrics)
# Write summary
if config.summary_file:
=====================================
testsuite/driver/testglobals.py
=====================================
@@ -4,7 +4,7 @@
from my_typing import *
from pathlib import Path
-from perf_notes import MetricChange, PerfStat, Baseline, MetricOracles
+from perf_notes import MetricChange, PerfStat, Baseline, MetricOracles, GitRef
from datetime import datetime
# -----------------------------------------------------------------------------
@@ -163,6 +163,9 @@ class TestConfig:
# run.
self.broken_tests = set() # type: Set[TestName]
+ # Baseline commit for performane metric comparisons.
+ self.baseline_commit = None # type: Optional[GitRef]
+
# Should we skip performance tests
self.skip_perf_tests = False
=====================================
testsuite/driver/testlib.py
=====================================
@@ -477,7 +477,8 @@ def _collect_stats(name: TestName, opts, metrics, deviation, is_compiler_stats_t
metric = '{}/{}'.format(tag, metric_name)
def baselineByWay(way, target_commit, metric=metric):
return Perf.baseline_metric( \
- target_commit, name, config.test_env, metric, way)
+ target_commit, name, config.test_env, metric, way, \
+ config.baseline_commit )
opts.stats_range_fields[metric] = MetricOracles(baseline=baselineByWay,
deviation=deviation)
=====================================
testsuite/mk/test.mk
=====================================
@@ -60,7 +60,7 @@ TEST_HC_OPTS += -Werror=compat
# removing this line.
TEST_HC_OPTS += -dno-debug-output
-TEST_HC_OPTS_INTERACTIVE = $(TEST_HC_OPTS) --interactive -v0 -ignore-dot-ghci -fno-ghci-history +RTS --io-manager=native -RTS
+TEST_HC_OPTS_INTERACTIVE = $(TEST_HC_OPTS) --interactive -v0 -ignore-dot-ghci -fno-ghci-history
RUNTEST_OPTS =
@@ -232,6 +232,10 @@ ifneq "$(VERBOSE)" ""
RUNTEST_OPTS += --verbose=$(VERBOSE)
endif
+ifneq "$(PERF_TEST_BASELINE_COMMIT)" ""
+RUNTEST_OPTS += --perf-baseline=$(PERF_TEST_BASELINE_COMMIT)
+endif
+
ifeq "$(SKIP_PERF_TESTS)" "YES"
RUNTEST_OPTS += --skip-perf-tests
endif
=====================================
testsuite/tests/codeGen/should_compile/T18291.hs
=====================================
@@ -0,0 +1,7 @@
+{-# LANGUAGE MagicHash #-}
+module T18291 where
+
+import GHC.Magic
+
+hi :: Int
+hi = runRW# $ \_ -> 42
=====================================
testsuite/tests/codeGen/should_compile/all.T
=====================================
@@ -91,6 +91,7 @@ test('T17648', normal, makefile_test, [])
test('T17904', normal, compile, ['-O'])
test('T18227A', normal, compile, [''])
test('T18227B', normal, compile, [''])
+test('T18291', normal, compile, ['-O0'])
test('T15570',
when(unregisterised(), skip),
compile, ['-Wno-overflowed-literals'])
=====================================
utils/llvm-targets/gen-data-layout.sh
=====================================
@@ -59,6 +59,9 @@ TARGETS=(
"i386-unknown-linux-gnu"
"i386-unknown-linux-musl"
"i386-unknown-linux"
+ "i686-unknown-linux-gnu"
+ "i686-unknown-linux-musl"
+ "i686-unknown-linux"
"x86_64-unknown-linux-gnu"
"x86_64-unknown-linux-musl"
"x86_64-unknown-linux"
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e340997e91828df27af37667f4f8fcbcd4b65e32...2330b4b9709ca4f20cb029bc39a0c7c6a33d73b0
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e340997e91828df27af37667f4f8fcbcd4b65e32...2330b4b9709ca4f20cb029bc39a0c7c6a33d73b0
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/20200818/54618faf/attachment-0001.html>
More information about the ghc-commits
mailing list