[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: testsuite: extend size performance tests with gzip (fixes #25046)
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Tue Aug 6 21:26:55 UTC 2024
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
eb1cb536 by Serge S. Gulin at 2024-08-06T08:54:55+00:00
testsuite: extend size performance tests with gzip (fixes #25046)
The main purpose is to create tests for minimal app (hello world and its variations, i.e. unicode used) distribution size metric.
Many platforms support distribution in compressed form via gzip. It would be nice to collect information on how much size is taken by the executional bundle for each platform at minimal edge case.
2 groups of tests are added:
1. We extend javascript backend size tests with gzip-enabled versions for all cases where an optimizing compiler is used (for now it is google closure compiler).
2. We add trivial hello world tests with gzip-enabled versions for all other platforms at CI pipeline where no external optimizing compiler is used.
- - - - -
6860b4de by Rodrigo Mesquita at 2024-08-06T17:26:23-04:00
ghc-internal: @since for backtraceDesired
Fixes point 1 in #25052
- - - - -
f3391cf8 by Rodrigo Mesquita at 2024-08-06T17:26:23-04:00
ghc-internal: No trailing whitespace in exceptions
Fixes #25052
- - - - -
6436517b by Andreas Klebinger at 2024-08-06T17:26:23-04:00
Add since annotation for -fkeep-auto-rules.
This partially addresses #25082.
- - - - -
210c2442 by Andreas Klebinger at 2024-08-06T17:26:23-04:00
Mention `-fkeep-auto-rules` in release notes.
It was added earlier but hadn't appeared in any release notes yet.
Partially addresses #25082.
- - - - -
d1146a82 by Sylvain Henry at 2024-08-06T17:26:37-04:00
Cmm: don't perform unsound optimizations on 32-bit compiler hosts
- beef61351b240967b49169d27a9a19565cf3c4af enabled the use of
MO_Add/MO_Sub for 64-bit operations in the C and LLVM backends
- 6755d833af8c21bbad6585144b10e20ac4a0a1ab did the same for the x86 NCG
backend
However we store some literal values as `Int` in the compiler. As a
result, some Cmm optimizations transformed target 64-bit literals into
compiler `Int`. If the compiler is 32-bit, this leads to computing with
wrong literals (see #24893 and #24700).
This patch disables these Cmm optimizations for 32-bit compilers. This
is unsatisfying (optimizations shouldn't be compiler-word-size
dependent) but it fixes the bug and it makes the patch easy to backport.
A proper fix would be much more invasive but it shall be implemented in
the future.
Co-authored-by: amesgen <amesgen at amesgen.de>
- - - - -
752c29be by Vladislav Zavialov at 2024-08-06T17:26:37-04:00
docs: Update info on RequiredTypeArguments
Add a section on "types in terms" that were implemented in 8b2f70a202
and remove the now outdated suggestion of using `type` for them.
- - - - -
0bc89d33 by Sylvain Henry at 2024-08-06T17:26:40-04:00
JS: fix minor typo in base's jsbits
- - - - -
22 changed files:
- compiler/GHC/Cmm/Opt.hs
- docs/users_guide/9.12.1-notes.rst
- docs/users_guide/exts/required_type_arguments.rst
- docs/users_guide/using-optimisation.rst
- libraries/ghc-internal/jsbits/base.js
- libraries/ghc-internal/src/GHC/Internal/Exception/Type.hs
- testsuite/driver/testlib.py
- + testsuite/tests/codeGen/should_run/T24700.hs
- + testsuite/tests/codeGen/should_run/T24700.stdin
- + testsuite/tests/codeGen/should_run/T24700.stdout
- + testsuite/tests/codeGen/should_run/T24893.hs
- + testsuite/tests/codeGen/should_run/T24893.stdout
- testsuite/tests/codeGen/should_run/all.T
- testsuite/tests/driver/T13914/T13914.stdout
- + testsuite/tests/exceptions/T25052.hs
- + testsuite/tests/exceptions/T25052.stdout
- + testsuite/tests/exceptions/all.T
- + testsuite/tests/perf/size/Makefile
- testsuite/tests/perf/size/all.T
- testsuite/tests/perf/size/javascript/Makefile
- − testsuite/tests/perf/size/javascript/T24602_perf_size.hs
- testsuite/tests/perf/size/javascript/all.T
Changes:
=====================================
compiler/GHC/Cmm/Opt.hs
=====================================
@@ -237,23 +237,33 @@ cmmMachOpFoldM _ MO_Add{} [ CmmMachOp op at MO_Add{} [pic, CmmLit lit]
= Just $! CmmMachOp op [pic, CmmLit $ cmmOffsetLit lit off ]
where off = fromIntegral (narrowS rep n)
--- Make a RegOff if we can
+-- Make a RegOff if we can. We don't perform this optimization if rep is greater
+-- than the host word size because we use an Int to store the offset. See
+-- #24893 and #24700. This should be fixed to ensure that optimizations don't
+-- depend on the compiler host platform.
cmmMachOpFoldM _ (MO_Add _) [CmmReg reg, CmmLit (CmmInt n rep)]
+ | validOffsetRep rep
= Just $! cmmRegOff reg (fromIntegral (narrowS rep n))
cmmMachOpFoldM _ (MO_Add _) [CmmRegOff reg off, CmmLit (CmmInt n rep)]
+ | validOffsetRep rep
= Just $! cmmRegOff reg (off + fromIntegral (narrowS rep n))
cmmMachOpFoldM _ (MO_Sub _) [CmmReg reg, CmmLit (CmmInt n rep)]
+ | validOffsetRep rep
= Just $! cmmRegOff reg (- fromIntegral (narrowS rep n))
cmmMachOpFoldM _ (MO_Sub _) [CmmRegOff reg off, CmmLit (CmmInt n rep)]
+ | validOffsetRep rep
= Just $! cmmRegOff reg (off - fromIntegral (narrowS rep n))
-- Fold label(+/-)offset into a CmmLit where possible
cmmMachOpFoldM _ (MO_Add _) [CmmLit lit, CmmLit (CmmInt i rep)]
+ | validOffsetRep rep
= Just $! CmmLit (cmmOffsetLit lit (fromIntegral (narrowU rep i)))
cmmMachOpFoldM _ (MO_Add _) [CmmLit (CmmInt i rep), CmmLit lit]
+ | validOffsetRep rep
= Just $! CmmLit (cmmOffsetLit lit (fromIntegral (narrowU rep i)))
cmmMachOpFoldM _ (MO_Sub _) [CmmLit lit, CmmLit (CmmInt i rep)]
+ | validOffsetRep rep
= Just $! CmmLit (cmmOffsetLit lit (fromIntegral (negate (narrowU rep i))))
@@ -409,6 +419,13 @@ cmmMachOpFoldM platform mop [x, (CmmLit (CmmInt n _))]
cmmMachOpFoldM _ _ _ = Nothing
+-- | Check that a literal width is compatible with the host word size used to
+-- store offsets. This should be fixed properly (using larger types to store
+-- literal offsets). See #24893
+validOffsetRep :: Width -> Bool
+validOffsetRep rep = widthInBits rep <= finiteBitSize (undefined :: Int)
+
+
{- Note [Comparison operators]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If we have
=====================================
docs/users_guide/9.12.1-notes.rst
=====================================
@@ -109,6 +109,10 @@ Compiler
This enables people to write their own custom assertion functions.
See :ref:`assertions`.
+- The flag :ghc-flag:`-fkeep-auto-rules` that forces GHC to keep auto generated
+ specialization rules was added. It was actually added ghc-9.10.1 already but
+ mistakenly not mentioned in the 9.10.1 changelog.
+
- Fixed a bug that caused GHC to panic when using the aarch64 ncg and -fregs-graph
on certain programs. (#24941)
=====================================
docs/users_guide/exts/required_type_arguments.rst
=====================================
@@ -262,15 +262,36 @@ Outside a required type argument, it is illegal to use ``type``:
r4 = type Int -- illegal use of ‘type’
-Finally, there are types that require the ``type`` keyword only due to
-limitations of the current implementation::
+Types in terms
+~~~~~~~~~~~~~~
- a1 = f (type (Int -> Bool)) -- function type
- a2 = f (type (Read T => T)) -- constrained type
- a3 = f (type (forall a. a)) -- universally quantified type
- a4 = f (type (forall a. Read a => String -> a)) -- a combination of the above
+**Since:** GHC 9.12
-This restriction will be relaxed in a future release of GHC.
+:extension:`RequiredTypeArguments` extends the grammar of term-level
+expressions with syntax that is typically found only in types:
+
+* function types: ``a -> b``, ``a ⊸ b``, ``a %m -> b``
+* constrained types: ``ctx => t``
+* universally quantified types: ``forall tvs. t``, ``forall tvs -> t``
+
+These so-called "types in terms" make it possible to pass any types as required
+type arguments::
+
+ a1 = f (Int -> Bool) -- function type
+ a2 = f (Int %1 -> String) -- linear function type
+ a3 = f (Read T => T) -- constrained type
+ a4 = f (forall a. a) -- universally quantified type
+ a5 = f (forall a. Read a => String -> a) -- a combination of the above
+
+A few limitations apply:
+
+* The ``*`` syntax of :extension:`StarIsType` is not available due to a
+ conflict with the multiplication operator.
+ What to do instead: use ``Type`` from the ``Data.Kind`` module.
+
+* The ``'`` syntax of :extension:`DataKinds` is not available due to a conflict
+ with :extension:`TemplateHaskell` name quotation.
+ What to do instead: simply omit the ``'``.
Effect on implicit quantification
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
=====================================
docs/users_guide/using-optimisation.rst
=====================================
@@ -664,10 +664,11 @@ as such you shouldn't need to set any of them explicitly. A flag
:category:
:default: off
+ :since: 9.10.1
The type-class specialiser and call-pattern specialisation both
generate so-called "auto" RULES. These rules are usually exposed
- to importing modules in the interface file. But an auto rule is the
+ to importing modules in the interface file. But when an auto rule is the
sole reason for keeping a function alive, both the rule and the function
are discarded, by default. That reduces code bloat, but risks the same
function being specialised again in an importing module.
=====================================
libraries/ghc-internal/jsbits/base.js
=====================================
@@ -285,7 +285,7 @@ function h$rename(old_path, old_path_off, new_path, new_path_off) {
#ifndef GHCJS_BROWSER
if (h$isNode()) {
try {
- fs.renameSync(h$decodeUtf8z(old_path, old_path_off), h$decodeUtf8z(new_path, new_path_off));
+ h$fs.renameSync(h$decodeUtf8z(old_path, old_path_off), h$decodeUtf8z(new_path, new_path_off));
return 0;
} catch(e) {
h$setErrno(e);
@@ -318,7 +318,7 @@ function h$realpath(path,off,resolved,resolved_off) {
#ifndef GHCJS_BROWSER
if (h$isNode()) {
try {
- var rp = h$encodeUtf8(fs.realpathSync(h$decodeUtf8z(path,off)));
+ var rp = h$encodeUtf8(h$fs.realpathSync(h$decodeUtf8z(path,off)));
if (resolved !== null) {
h$copyMutableByteArray(rp, 0, resolved, resolved_off, Math.min(resolved.len - resolved_off, rp.len));
RETURN_UBX_TUP2(resolved, resolved_off);
@@ -1023,7 +1023,7 @@ function h$opendir(path) {
throw "h$opendir unsupported";
}
- const d = fs.opendirSync(h$decodeUtf8z(path,0));
+ const d = h$fs.opendirSync(h$decodeUtf8z(path,0));
RETURN_UBX_TUP2(d,0);
}
=====================================
libraries/ghc-internal/src/GHC/Internal/Exception/Type.hs
=====================================
@@ -45,6 +45,7 @@ module GHC.Internal.Exception.Type
, underflowException
) where
+import GHC.Internal.Data.OldList (intersperse)
import GHC.Internal.Data.Maybe
import GHC.Internal.Data.Typeable (Typeable, TypeRep, cast)
import qualified GHC.Internal.Data.Typeable as Typeable
@@ -196,6 +197,7 @@ class (Typeable e, Show e) => Exception e where
displayException :: e -> String
displayException = show
+ -- | @since base-4.20.0.0
backtraceDesired :: e -> Bool
backtraceDesired _ = True
@@ -212,11 +214,14 @@ instance Exception SomeException where
fromException = Just
backtraceDesired (SomeException e) = backtraceDesired e
displayException (SomeException e) =
- displayException e
- ++ displayTypeInfo (Typeable.typeOf e)
- ++ "\n\n"
- ++ (displayContext ?exceptionContext)
+ case displayContext ?exceptionContext of
+ "" -> msg
+ dc -> msg ++ "\n\n" ++ dc
where
+ msg =
+ displayException e
+ ++ displayTypeInfo (Typeable.typeOf e)
+
displayTypeInfo :: TypeRep -> String
displayTypeInfo rep =
mconcat
@@ -231,10 +236,9 @@ instance Exception SomeException where
tyCon = Typeable.typeRepTyCon rep
displayContext :: ExceptionContext -> String
-displayContext (ExceptionContext anns0) = go anns0
+displayContext (ExceptionContext anns0) = mconcat $ intersperse "\n" $ map go anns0
where
- go (SomeExceptionAnnotation ann : anns) = displayExceptionAnnotation ann ++ "\n" ++ go anns
- go [] = ""
+ go (SomeExceptionAnnotation ann) = displayExceptionAnnotation ann
newtype NoBacktrace e = NoBacktrace e
deriving (Show)
=====================================
testsuite/driver/testlib.py
=====================================
@@ -1426,9 +1426,24 @@ async def test_common_work(name: TestName, opts,
if needsTargetWrapper():
opts.skip = True
elif func in [makefile_test, run_command]:
- # makefile tests aren't necessarily runtime or compile-time
+ # Note [Makefile tests are supposed to be run in all ways]
+ # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ # Makefile tests aren't necessarily runtime or compile-time
# specific. Assume we can run them in all ways. See #16042 for what
# happened previously.
+ #
+ # For example, the WASM test environment requires a target wrapper to run tests
+ # which is why Makefile tests are skipped by default. For cases where the
+ # target wrapper is actually not needed we can trigger Makefile tests to run
+ # by using something like `pre_cmd('$MAKE -s --no-print-directory...`.
+ # Examples of this can be found throughout the code.
+ #
+ # Additionally, it is useful to set `multimod_compile` as the running mode
+ # because it provides enough flexibility to specify source names to compile
+ # without wasting time on running.
+ #
+ # `ignore_stdout` and `ignore_stderr` could also be helpful in cases where
+ # all you need is to compare the exit code with 0.
all_ways = config.compile_ways + config.run_ways
if needsTargetWrapper():
opts.skip = True
=====================================
testsuite/tests/codeGen/should_run/T24700.hs
=====================================
@@ -0,0 +1,5 @@
+import Data.Int
+
+main = do
+ input <- getLine
+ print (read input - 3000000000 :: Int64)
=====================================
testsuite/tests/codeGen/should_run/T24700.stdin
=====================================
@@ -0,0 +1 @@
+0
=====================================
testsuite/tests/codeGen/should_run/T24700.stdout
=====================================
@@ -0,0 +1 @@
+-3000000000
=====================================
testsuite/tests/codeGen/should_run/T24893.hs
=====================================
@@ -0,0 +1,8 @@
+import Data.Word
+
+main :: IO ()
+main = print $ 0x8000000000000000 + zero
+
+zero :: Word64
+zero = 0
+{-# NOINLINE zero #-}
=====================================
testsuite/tests/codeGen/should_run/T24893.stdout
=====================================
@@ -0,0 +1 @@
+9223372036854775808
=====================================
testsuite/tests/codeGen/should_run/all.T
=====================================
@@ -248,3 +248,5 @@ test('T24664a', normal, compile_and_run, ['-O'])
test('T24664b', normal, compile_and_run, ['-O'])
test('CtzClz0', normal, compile_and_run, [''])
test('T23034', req_c, compile_and_run, ['-O2 T23034_c.c'])
+test('T24700', normal, compile_and_run, ['-O'])
+test('T24893', normal, compile_and_run, ['-O'])
=====================================
testsuite/tests/driver/T13914/T13914.stdout
=====================================
@@ -17,7 +17,6 @@ HasCallStack backtrace:
throwIO, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:453:5 in ghc-internal:GHC.Internal.IO.Exception
assert, called at main.hs:3:8 in main:Main
-
With -fignore-asserts
[1 of 2] Compiling Main ( main.hs, main.o ) [Optimisation flags changed]
[2 of 2] Linking main [Objects changed]
=====================================
testsuite/tests/exceptions/T25052.hs
=====================================
@@ -0,0 +1,8 @@
+import Control.Exception
+
+main :: IO ()
+main = do
+ let msg = "no trailing whitespace"
+ fail msg `catch` \(e :: SomeException) -> do
+ putStrLn (displayException e)
+
=====================================
testsuite/tests/exceptions/T25052.stdout
=====================================
@@ -0,0 +1,5 @@
+user error (no trailing whitespace)
+
+Package: ghc-internal
+Module: GHC.Internal.IO.Exception
+Type: IOException
=====================================
testsuite/tests/exceptions/all.T
=====================================
@@ -0,0 +1,2 @@
+test('T25052', normal, compile_and_run, [''])
+
=====================================
testsuite/tests/perf/size/Makefile
=====================================
@@ -0,0 +1,11 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+size_hello_artifact_gzip:
+ '$(TEST_HC)' $(TEST_HC_OPTS) ./size_hello_artifact.hs -v0 -fforce-recomp
+ gzip --best "./size_hello_artifact$(exe_extension_from_python)"
+
+size_hello_unicode_gzip:
+ '$(TEST_HC)' $(TEST_HC_OPTS) ./size_hello_unicode.hs -v0 -fforce-recomp
+ gzip --best "./size_hello_unicode$(exe_extension_from_python)"
=====================================
testsuite/tests/perf/size/all.T
=====================================
@@ -3,8 +3,20 @@ test('size_hello_obj', [collect_size(5, 'size_hello_obj.o')], compile, [''])
test('size_hello_artifact', [collect_size(5, 'size_hello_artifact' + exe_extension())],
compile_artifact, [''])
+test('size_hello_artifact_gzip', [extra_files(['./size_hello_artifact.hs']),
+ collect_size(5, 'size_hello_artifact' + exe_extension() + '.gz'),
+ # See Note [Makefile tests are supposed to be run in all ways] in testsuite/driver/testlib.py
+ pre_cmd('$MAKE -s --no-print-directory size_hello_artifact_gzip' + ' exe_extension_from_python="' + exe_extension() + '"'), ignore_stdout, ignore_stderr],
+ multimod_compile, ['size_hello_artifact', ''])
+
test('size_hello_unicode', [collect_size(5, 'size_hello_unicode' + exe_extension())], compile_artifact, [''])
+test('size_hello_unicode_gzip', [extra_files(['./size_hello_unicode.hs']),
+ collect_size(5, 'size_hello_unicode' + exe_extension() + '.gz'),
+ # See Note [Makefile tests are supposed to be run in all ways] in testsuite/driver/testlib.py
+ pre_cmd('$MAKE -s --no-print-directory size_hello_unicode_gzip' + ' exe_extension_from_python="' + exe_extension() + '"'), ignore_stdout, ignore_stderr],
+ multimod_compile, ['size_hello_unicode', ''])
+
size_acceptance_threshold = 100
test('array_dir' ,[collect_size_ghc_pkg(size_acceptance_threshold , 'array')] , static_stats , [] )
=====================================
testsuite/tests/perf/size/javascript/Makefile
=====================================
@@ -3,7 +3,7 @@ include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/test.mk
T24602_perf_size:
- '$(TEST_HC)' $(TEST_HC_OPTS) ./T24602_perf_size.hs -v0 -fforce-recomp
+ '$(TEST_HC)' $(TEST_HC_OPTS) ./size_hello_artifact.hs -v0 -fforce-recomp
google-closure-compiler \
--platform java \
--warning_level QUIET \
@@ -11,5 +11,23 @@ T24602_perf_size:
--assume_function_wrapper \
--compilation_level ADVANCED_OPTIMIZATIONS \
--emit_use_strict \
- --js_output_file ./T24602_perf_size.jsexe/all.min.js \
- ./T24602_perf_size.jsexe/all.js ./T24602_perf_size.jsexe/all.externs.js
+ --js_output_file ./size_hello_artifact.jsexe/all.min.js \
+ ./size_hello_artifact.jsexe/all.js ./size_hello_artifact.jsexe/all.externs.js
+
+T25046_perf_size_gzip: T24602_perf_size
+ gzip --best ./size_hello_artifact.jsexe/all.min.js
+
+T25046_perf_size_unicode:
+ '$(TEST_HC)' $(TEST_HC_OPTS) ./size_hello_unicode.hs -v0 -fforce-recomp
+ google-closure-compiler \
+ --platform java \
+ --warning_level QUIET \
+ --isolation_mode IIFE \
+ --assume_function_wrapper \
+ --compilation_level ADVANCED_OPTIMIZATIONS \
+ --emit_use_strict \
+ --js_output_file ./size_hello_unicode.jsexe/all.min.js \
+ ./size_hello_unicode.jsexe/all.js ./size_hello_unicode.jsexe/all.externs.js
+
+T25046_perf_size_unicode_gzip: T25046_perf_size_unicode
+ gzip --best ./size_hello_unicode.jsexe/all.min.js
=====================================
testsuite/tests/perf/size/javascript/T24602_perf_size.hs deleted
=====================================
@@ -1,3 +0,0 @@
-module Main where
-
-main = print "Hello, JavaScript!"
=====================================
testsuite/tests/perf/size/javascript/all.T
=====================================
@@ -1,4 +1,7 @@
# These are JavaScript-specific tests based on Google Closure Compiler
setTestOpts(when(not(js_arch()),skip))
-test('T24602_perf_size', [collect_size(5, './T24602_perf_size.jsexe/all.min.js')], makefile_test, ['T24602_perf_size'])
+test('T24602_perf_size', [extra_files(['../size_hello_artifact.hs']), collect_size(5, './size_hello_artifact.jsexe/all.min.js')], makefile_test, ['T24602_perf_size'])
+test('T25046_perf_size_gzip', [extra_files(['../size_hello_artifact.hs']), collect_size(5, './size_hello_artifact.jsexe/all.min.js.gz')], makefile_test, ['T25046_perf_size_gzip'])
+test('T25046_perf_size_unicode', [extra_files(['../size_hello_unicode.hs']), collect_size(5, './size_hello_unicode.jsexe/all.min.js')], makefile_test, ['T25046_perf_size_unicode'])
+test('T25046_perf_size_unicode_gzip', [extra_files(['../size_hello_unicode.hs']), collect_size(5, './size_hello_unicode.jsexe/all.min.js.gz')], makefile_test, ['T25046_perf_size_unicode_gzip'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2bdc5ef4bb4bfcf618bd8b902b5e71785bc075cb...0bc89d3333bf7e324722722dae2cbb03fe65b70f
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2bdc5ef4bb4bfcf618bd8b902b5e71785bc075cb...0bc89d3333bf7e324722722dae2cbb03fe65b70f
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/20240806/c869235d/attachment-0001.html>
More information about the ghc-commits
mailing list